aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--stdlib/source/lux/control/continuation.lux2
-rw-r--r--stdlib/source/lux/control/exception.lux24
-rw-r--r--stdlib/source/lux/data/collection/list.lux2
-rw-r--r--stdlib/source/test/lux/abstract/predicate.lux18
-rw-r--r--stdlib/source/test/lux/control/exception.lux123
5 files changed, 128 insertions, 41 deletions
diff --git a/stdlib/source/lux/control/continuation.lux b/stdlib/source/lux/control/continuation.lux
index cd8f6a131..5bfe690e3 100644
--- a/stdlib/source/lux/control/continuation.lux
+++ b/stdlib/source/lux/control/continuation.lux
@@ -17,7 +17,7 @@
(-> (-> i o) o))
(def: #export (continue next cont)
- {#.doc "Continues a thunk."}
+ {#.doc "Continues a continuation thunk."}
(All [i o] (-> (-> i o) (Cont i o) o))
(cont next))
diff --git a/stdlib/source/lux/control/exception.lux b/stdlib/source/lux/control/exception.lux
index 85236b6fa..53b770bcd 100644
--- a/stdlib/source/lux/control/exception.lux
+++ b/stdlib/source/lux/control/exception.lux
@@ -73,7 +73,7 @@
(def: #export (throw exception message)
{#.doc "Decorate an error message with an Exception and lift it into the error-handling context."}
- (All [e] (-> (Exception e) e Try))
+ (All [e a] (-> (Exception e) e (Try a)))
(#//.Failure (construct exception message)))
(def: #export (assert exception message test)
@@ -114,7 +114,7 @@
(def: header-separator ": ")
-(def: #export (report' entries)
+(def: (report' entries)
(-> (List [Text Text]) Text)
(let [largest-header-size (|> entries
(list@map (|>> product.left text.size))
@@ -136,15 +136,17 @@
(text.join-with text.new-line))))
(syntax: #export (report {entries (p.many (s.tuple (p.and s.any s.any)))})
- (wrap (list (` (report' (list (~+ (|> entries
- (list@map (function (_ [header message])
- (` [(~ header) (~ message)])))))))))))
+ (wrap (list (` ((~! report') (list (~+ (|> entries
+ (list@map (function (_ [header message])
+ (` [(~ header) (~ message)])))))))))))
(def: separator
- ($_ "lux text concat"
- text.new-line text.new-line
- (|> "-" (list.repeat 64) (text.join-with ""))
- text.new-line text.new-line))
+ (let [gap ($_ "lux text concat" text.new-line text.new-line)
+ horizontal-line (|> "-" (list.repeat 64) (text.join-with ""))]
+ ($_ "lux text concat"
+ gap
+ horizontal-line
+ gap)))
(def: (decorate prelude error)
(-> Text Text Text)
@@ -167,11 +169,11 @@
success
success))
-(def: #export (enumerate %entry)
+(def: #export (enumerate format)
(All [a]
(-> (-> a Text)
(-> (List a) Text)))
(|>> list.enumerate
(list@map (function (_ [index entry])
- ($_ text@compose (n@encode index) ": " (%entry entry))))
+ ($_ text@compose (n@encode index) ": " (format entry))))
(text.join-with text.new-line)))
diff --git a/stdlib/source/lux/data/collection/list.lux b/stdlib/source/lux/data/collection/list.lux
index dd8e3f09b..eaf7df755 100644
--- a/stdlib/source/lux/data/collection/list.lux
+++ b/stdlib/source/lux/data/collection/list.lux
@@ -210,7 +210,7 @@
(-> (-> a (Maybe b)) (List a) (List b)))
(case xs
#.Nil
- #.None
+ #.Nil
(#.Cons x xs')
(case (check x)
diff --git a/stdlib/source/test/lux/abstract/predicate.lux b/stdlib/source/test/lux/abstract/predicate.lux
index 946d8371e..fe942a044 100644
--- a/stdlib/source/test/lux/abstract/predicate.lux
+++ b/stdlib/source/test/lux/abstract/predicate.lux
@@ -4,6 +4,8 @@
[abstract
[equivalence (#+ Equivalence)]
[monad (#+ do)]]
+ [control
+ ["." function]]
[data
["." bit ("#@." equivalence)]
[text
@@ -17,12 +19,16 @@
{1
["." / (#+ Predicate)]})
+(def: (multiple? factor)
+ (-> Nat (/.Predicate Nat))
+ (case factor
+ 0 (function.constant false)
+ _ (|>> (n.% factor) (n.= 0))))
+
(def: #export test
Test
- (let [/2? (: (/.Predicate Nat)
- (|>> (n.% 2) (n.= 0)))
- /3? (: (/.Predicate Nat)
- (|>> (n.% 3) (n.= 0)))]
+ (let [/2? (multiple? 2)
+ /3? (multiple? 3)]
(<| (_.context (%.name (name-of /.Predicate)))
(do r.monad
[sample r.nat])
@@ -52,7 +58,9 @@
(bit@= (left sample)
(right sample)))))
generator (: (Random (/.Predicate Nat))
- (wrap /2?))]
+ (|> r.nat
+ (r.filter (|>> (n.= 0) not))
+ (:: @ map multiple?)))]
($_ _.and
(//monoid.spec equivalence /.union generator)
(//monoid.spec equivalence /.intersection generator)))
diff --git a/stdlib/source/test/lux/control/exception.lux b/stdlib/source/test/lux/control/exception.lux
index fde485472..5d0fa3d47 100644
--- a/stdlib/source/test/lux/control/exception.lux
+++ b/stdlib/source/test/lux/control/exception.lux
@@ -2,38 +2,115 @@
[lux #*
[abstract/monad (#+ do)]
[data
+ ["." name]
[number
["n" nat]]
- [text
+ ["." text ("#@." equivalence)
["%" format (#+ format)]]]
[math
- ["r" random]]
+ ["." random]]
["_" test (#+ Test)]]
{1
- ["." / (#+ exception:)]})
+ ["." / (#+ exception:)
+ [//
+ ["." try (#+ Try)]]]})
(exception: an-exception)
(exception: another-exception)
+(def: label "YOLO")
+(exception: (custom-exception {value Nat})
+ (/.report [label (%.nat value)]))
+
(def: #export test
- (do r.monad
- [right r.nat
- wrong (r.filter (|>> (n.= right) not) r.nat)]
- (<| (_.context (%.name (name-of /.Exception)))
+ Test
+ (do random.monad
+ [expected random.nat
+ wrong (|> random.nat (random.filter (|>> (n.= expected) not)))
+ assertion-succeeded? random.bit
+ #let [report-element (:: @ map %.nat random.nat)]
+ field0 report-element
+ value0 report-element
+ field1 report-element
+ value1 report-element]
+ (<| (_.context (name.module (name-of /._)))
($_ _.and
- (_.test "Can catch exceptions."
- (n.= right
- (|> (/.throw an-exception [])
- (/.catch an-exception (function (_ ex) right))
- (/.otherwise (function (_ ex) wrong)))))
- (_.test "Can catch multiple exceptions."
- (n.= right
- (|> (/.throw another-exception [])
- (/.catch an-exception (function (_ ex) wrong))
- (/.catch another-exception (function (_ ex) right))
- (/.otherwise (function (_ ex) wrong)))))
- (_.test "Can handle uncaught exceptions."
- (n.= right
- (|> (/.throw another-exception [])
- (/.catch an-exception (function (_ ex) wrong))
- (/.otherwise (function (_ ex) right)))))))))
+ (_.test (%.name (name-of /.return))
+ (case (/.return expected)
+ (#try.Success actual) (n.= expected actual)
+ (#try.Failure _) false))
+ (_.test (%.name (name-of /.throw))
+ (case (/.throw ..an-exception [])
+ (#try.Success _) false
+ (#try.Failure _) true))
+ (_.test (%.name (name-of /.construct))
+ (case (/.throw ..an-exception [])
+ (#try.Success _)
+ false
+
+ (#try.Failure message)
+ (text@= message (/.construct ..an-exception []))))
+ (_.test (%.name (name-of /.match?))
+ (/.match? ..an-exception
+ (/.construct ..an-exception [])))
+ (_.test (%.name (name-of /.assert))
+ (case (/.assert ..an-exception [] assertion-succeeded?)
+ (#try.Success _)
+ assertion-succeeded?
+
+ (#try.Failure message)
+ (and (not assertion-succeeded?)
+ (text@= message (/.construct ..an-exception [])))))
+ (_.test (%.name (name-of /.catch))
+ (and (n.= expected
+ (|> (/.throw ..an-exception [])
+ (/.catch ..an-exception (function (_ ex) expected))
+ (/.otherwise (function (_ ex) wrong))))
+ (n.= expected
+ (|> (/.throw ..another-exception [])
+ (/.catch ..an-exception (function (_ ex) wrong))
+ (/.catch ..another-exception (function (_ ex) expected))
+ (/.otherwise (function (_ ex) wrong))))))
+ (_.test (%.name (name-of /.otherwise))
+ (n.= expected
+ (|> (/.throw ..another-exception [])
+ (/.catch ..an-exception (function (_ ex) wrong))
+ (/.otherwise (function (_ ex) expected)))))
+ (_.test (%.name (name-of /.report))
+ (let [report (/.report [field0 value0]
+ [field1 value1])]
+ (and (text.contains? field0 report)
+ (text.contains? value0 report)
+ (text.contains? field1 report)
+ (text.contains? value1 report))))
+ (_.test (%.name (name-of /.enumerate))
+ (let [enumeration (/.enumerate %.text (list field0 value0 field1 value1))]
+ (and (text.contains? field0 enumeration)
+ (text.contains? value0 enumeration)
+ (text.contains? field1 enumeration)
+ (text.contains? value1 enumeration))))
+ (_.test (%.name (name-of /.with))
+ (and (case (/.with ..an-exception [] (#try.Success expected))
+ (#try.Success actual) (n.= expected actual)
+ (#try.Failure _) false)
+ (case (/.with ..an-exception [] (#try.Failure ""))
+ (#try.Success _) false
+ (#try.Failure message) (text@= message (/.construct ..an-exception [])))
+ (case (/.with ..an-exception []
+ (: (Try Nat)
+ (/.throw ..another-exception [])))
+ (#try.Success _)
+ false
+
+ (#try.Failure message)
+ (and (text.contains? (/.construct ..an-exception []) message)
+ (text.contains? (/.construct ..another-exception []) message)))))
+ (_.test (%.name (name-of /.exception:))
+ (case (/.throw ..custom-exception [expected])
+ (#try.Success _)
+ false
+
+ (#try.Failure message)
+ (and (text.contains? ..label message)
+ (text.contains? (%.nat expected) message))))
+ ))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-23 18:26:09 +0000