Improved test for exceptions.

2 files changed, 113 insertions, 28 deletions

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