Added some testing machinery to measure the code coverage of tests.

3 files changed, 142 insertions, 109 deletions

diff --git a/stdlib/source/test/lux/abstract/apply.lux b/stdlib/source/test/lux/abstract/apply.lux
index 87c706f55..c53283233 100644
--- a/stdlib/source/test/lux/abstract/apply.lux
+++ b/stdlib/source/test/lux/abstract/apply.lux
@@ -3,72 +3,71 @@
    [abstract/monad (#+ do)]
    [data
     [number
-     ["n" nat]]
-    [text
-     ["%" format (#+ format)]]]
+     ["n" nat]]]
    [control
     ["." function]]
    [math
-    ["r" random]]
+    ["." random]]
    ["_" test (#+ Test)]]
   {1
    ["." / (#+ Apply)]}
   [//
    [functor (#+ Injection Comparison)]])
 
-(def: (identity injection comparison (^open "_;."))
+(def: (identity injection comparison (^open "_@."))
   (All [f] (-> (Injection f) (Comparison f) (Apply f) Test))
-  (do r.monad
-    [sample (:: @ map injection r.nat)]
+  (do random.monad
+    [sample (:: @ map injection random.nat)]
     (_.test "Identity."
             ((comparison n.=)
-             (_;apply (injection function.identity) sample)
+             (_@apply (injection function.identity) sample)
              sample))))
 
-(def: (homomorphism injection comparison (^open "_;."))
+(def: (homomorphism injection comparison (^open "_@."))
   (All [f] (-> (Injection f) (Comparison f) (Apply f) Test))
-  (do r.monad
-    [sample r.nat
-     increase (:: @ map n.+ r.nat)]
+  (do random.monad
+    [sample random.nat
+     increase (:: @ map n.+ random.nat)]
     (_.test "Homomorphism."
             ((comparison n.=)
-             (_;apply (injection increase) (injection sample))
+             (_@apply (injection increase) (injection sample))
              (injection (increase sample))))))
 
-(def: (interchange injection comparison (^open "_;."))
+(def: (interchange injection comparison (^open "_@."))
   (All [f] (-> (Injection f) (Comparison f) (Apply f) Test))
-  (do r.monad
-    [sample r.nat
-     increase (:: @ map n.+ r.nat)]
+  (do random.monad
+    [sample random.nat
+     increase (:: @ map n.+ random.nat)]
     (_.test "Interchange."
             ((comparison n.=)
-             (_;apply (injection increase) (injection sample))
-             (_;apply (injection (function (_ f) (f sample))) (injection increase))))))
+             (_@apply (injection increase) (injection sample))
+             (_@apply (injection (function (_ f) (f sample))) (injection increase))))))
 
-(def: (composition injection comparison (^open "_;."))
+(def: (composition injection comparison (^open "_@."))
   (All [f] (-> (Injection f) (Comparison f) (Apply f) Test))
-  (do r.monad
-    [sample r.nat
-     increase (:: @ map n.+ r.nat)
-     decrease (:: @ map n.- r.nat)]
+  (do random.monad
+    [sample random.nat
+     increase (:: @ map n.+ random.nat)
+     decrease (:: @ map n.- random.nat)]
     (_.test "Composition."
             ((comparison n.=)
-             (_$ _;apply
+             (_$ _@apply
                  (injection function.compose)
                  (injection increase)
                  (injection decrease)
                  (injection sample))
-             ($_ _;apply
+             ($_ _@apply
                  (injection increase)
                  (injection decrease)
                  (injection sample))))))
 
 (def: #export (spec injection comparison apply)
   (All [f] (-> (Injection f) (Comparison f) (Apply f) Test))
-  (_.context (%.name (name-of /.Apply))
-             ($_ _.and
-                 (..identity injection comparison apply)
-                 (..homomorphism injection comparison apply)
-                 (..interchange injection comparison apply)
-                 (..composition injection comparison apply)
-                 )))
+  (<| (_.covering /._)
+      (_.with-cover [/.Apply]
+        ($_ _.and
+            (..identity injection comparison apply)
+            (..homomorphism injection comparison apply)
+            (..interchange injection comparison apply)
+            (..composition injection comparison apply)
+            ))))
diff --git a/stdlib/source/test/lux/control/state.lux b/stdlib/source/test/lux/control/state.lux
index 1d9899539..cb7c94b83 100644
--- a/stdlib/source/test/lux/control/state.lux
+++ b/stdlib/source/test/lux/control/state.lux
@@ -34,26 +34,26 @@
     [state r.nat
      value r.nat]
     ($_ _.and
-        (_.test "Can get the state as a value."
-                (with-conditions [state state]
-                  /.get))
-        (_.test "Can replace the state."
-                (with-conditions [state value]
-                  (do /.monad
-                    [_ (/.put value)]
-                    /.get)))
-        (_.test "Can update the state."
-                (with-conditions [state (n.* value state)]
-                  (do /.monad
-                    [_ (/.update (n.* value))]
-                    /.get)))
-        (_.test "Can use the state."
-                (with-conditions [state (inc state)]
-                  (/.use inc)))
-        (_.test "Can use a temporary (local) state."
-                (with-conditions [state (n.* value state)]
-                  (/.local (n.* value)
-                           /.get)))
+        (_.cover [/.State /.get]
+                 (with-conditions [state state]
+                   /.get))
+        (_.cover [/.put]
+                 (with-conditions [state value]
+                   (do /.monad
+                     [_ (/.put value)]
+                     /.get)))
+        (_.cover [/.update]
+                 (with-conditions [state (n.* value state)]
+                   (do /.monad
+                     [_ (/.update (n.* value))]
+                     /.get)))
+        (_.cover [/.use]
+                 (with-conditions [state (inc state)]
+                   (/.use inc)))
+        (_.cover [/.local]
+                 (with-conditions [state (n.* value state)]
+                   (/.local (n.* value)
+                            /.get)))
         )))
 
 (def: (injection value)
@@ -72,9 +72,12 @@
     [state r.nat
      value r.nat]
     ($_ _.and
-        ($functor.spec ..injection (..comparison state) /.functor)
-        ($apply.spec ..injection (..comparison state) /.apply)
-        ($monad.spec ..injection (..comparison state) /.monad)
+        (_.with-cover [/.functor]
+          ($functor.spec ..injection (..comparison state) /.functor))
+        (_.with-cover [/.apply]
+          ($apply.spec ..injection (..comparison state) /.apply))
+        (_.with-cover [/.monad]
+          ($monad.spec ..injection (..comparison state) /.monad))
         )))
 
 (def: loops
@@ -85,18 +88,18 @@
                        [state /.get]
                        (wrap (n.< limit state)))]]
     ($_ _.and
-        (_.test "'while' will only execute if the condition is #1."
-                (|> (/.while condition (/.update inc))
-                    (/.run 0)
-                    (let> [state' output']
-                          (n.= limit state'))))
-        (_.test "'do-while' will execute at least once."
-                (|> (/.do-while condition (/.update inc))
-                    (/.run 0)
-                    (let> [state' output']
-                          (or (n.= limit state')
-                              (and (n.= 0 limit)
-                                   (n.= 1 state'))))))
+        (_.cover [/.while /.run]
+                 (|> (/.while condition (/.update inc))
+                     (/.run 0)
+                     (let> [state' output']
+                           (n.= limit state'))))
+        (_.cover [/.do-while]
+                 (|> (/.do-while condition (/.update inc))
+                     (/.run 0)
+                     (let> [state' output']
+                           (or (n.= limit state')
+                               (and (n.= 0 limit)
+                                    (n.= 1 state'))))))
         )))
 
 (def: monad-transformer
@@ -105,29 +108,25 @@
     [state r.nat
      left r.nat
      right r.nat]
-    (let [(^open "io;.") io.monad]
-      (_.test "Can add state functionality to any monad."
-              (|> (: (/.State' io.IO Nat Nat)
-                     (do (/.with io.monad)
-                       [a (/.lift io.monad (io;wrap left))
-                        b (wrap right)]
-                       (wrap (n.+ a b))))
-                  (/.run' state)
-                  io.run
-                  (let> [state' output']
-                        (and (n.= state state')
-                             (n.= (n.+ left right) output')))))
+    (let [(^open "io@.") io.monad]
+      (_.cover [/.State' /.with /.lift /.run']
+               (|> (: (/.State' io.IO Nat Nat)
+                      (do (/.with io.monad)
+                        [a (/.lift io.monad (io@wrap left))
+                         b (wrap right)]
+                        (wrap (n.+ a b))))
+                   (/.run' state)
+                   io.run
+                   (let> [state' output']
+                         (and (n.= state state')
+                              (n.= (n.+ left right) output')))))
       )))
 
 (def: #export test
   Test
-  (<| (_.context (%.name (name-of /.State)))
+  (<| (_.covering /._)
       ($_ _.and
-          (<| (_.context "Basics.")
-              ..basics)
-          (<| (_.context "Structures.")
-              ..structures)
-          (<| (_.context "Loops.")
-              ..loops)
-          (<| (_.context "Monad transformer.")
-              ..monad-transformer))))
+          ..basics
+          ..structures
+          ..loops
+          ..monad-transformer)))
diff --git a/stdlib/source/test/lux/control/thread.lux b/stdlib/source/test/lux/control/thread.lux
index 7d6ed0ceb..49e397d21 100644
--- a/stdlib/source/test/lux/control/thread.lux
+++ b/stdlib/source/test/lux/control/thread.lux
@@ -10,13 +10,13 @@
       ["$." monad]]}]
    [data
     [number
-     ["n" nat]]
-    [text
-     ["%" format (#+ format)]]]
+     ["n" nat]]]
    [math
-    ["r" random]]]
+    ["." random]]]
   {1
-   ["." / (#+ Thread)]})
+   ["." / (#+ Thread)
+    [//
+     ["." io]]]})
 
 (def: (injection value)
   (Injection (All [a !] (Thread ! a)))
@@ -29,20 +29,55 @@
 
 (def: #export test
   Test
-  (do r.monad
-    [original r.nat
-     factor r.nat]
-    (<| (_.context (%.name (name-of /.Thread)))
+  (do random.monad
+    [sample random.nat
+     factor random.nat]
+    (<| (_.covering /._)
         ($_ _.and
-            ($functor.spec ..injection ..comparison /.functor)
-            ($apply.spec ..injection ..comparison /.apply)
-            ($monad.spec ..injection ..comparison /.monad)
-            
-            (_.test "Can safely do mutation."
-                    (n.= (n.* factor original)
-                         (/.run (: (All [!] (Thread ! Nat))
-                                   (do /.monad
-                                     [box (/.box original)
-                                      old (/.update (n.* factor) box)]
-                                     (/.read box))))))
+            (_.with-cover [/.Thread]
+              ($_ _.and
+                  (_.cover [/.run]
+                           (n.= sample
+                                (|> sample
+                                    (:: /.monad wrap)
+                                    /.run)))
+                  (_.cover [/.io]
+                           (n.= sample
+                                (|> sample
+                                    (:: /.monad wrap)
+                                    /.io
+                                    io.run)))
+                  
+                  (_.with-cover [/.functor]
+                    ($functor.spec ..injection ..comparison /.functor))
+                  (_.with-cover [/.apply]
+                    ($apply.spec ..injection ..comparison /.apply))
+                  (_.with-cover [/.monad]
+                    ($monad.spec ..injection ..comparison /.monad))
+                  ))
+
+            (_.with-cover [/.Box /.box]
+              ($_ _.and
+                  (_.cover [/.read]
+                           (n.= sample
+                                (/.run (: (All [!] (Thread ! Nat))
+                                          (do /.monad
+                                            [box (/.box sample)]
+                                            (/.read box))))))
+
+                  (_.cover [/.write]
+                           (n.= factor
+                                (/.run (: (All [!] (Thread ! Nat))
+                                          (do /.monad
+                                            [box (/.box sample)
+                                             _ (/.write factor box)]
+                                            (/.read box))))))
+
+                  (_.cover [/.update]
+                           (n.= (n.* factor sample)
+                                (/.run (: (All [!] (Thread ! Nat))
+                                          (do /.monad
+                                            [box (/.box sample)
+                                             old (/.update (n.* factor) box)]
+                                            (/.read box))))))))
             ))))