Improved test for exceptions.

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))))
+            ))))