Made test-running parallel again.

6 files changed, 253 insertions, 120 deletions

diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux
index c03076d26..c43c2abf4 100644
--- a/stdlib/source/test/lux.lux
+++ b/stdlib/source/test/lux.lux
@@ -13,7 +13,7 @@
       [predicate (#+ Predicate)]]
      [control
       ["." io (#+ io)]
-      ["." function
+      [function
        [mixin (#+)]]
       [parser
        [cli (#+ program:)]]]
@@ -49,28 +49,37 @@
       [php (#+)]
       [common-lisp (#+)]
       [scheme (#+)]]
-     [tool
-      [compiler
-       [phase
-        [generation
-         [jvm (#+)
-          <host-modules>]
-         [js (#+)
-          <host-modules>]
-         [python (#+)
-          <host-modules>]
-         [lua (#+)
-          <host-modules>]
-         [ruby (#+)
-          <host-modules>]
-         [php (#+)
-          <host-modules>]
-         [common-lisp (#+)
-          <host-modules>]
-         [scheme (#+)
-          <host-modules>]]]]]
+     ## [tool
+     ##  [compiler
+     ##   [language
+     ##    [lux
+     ##     [phase
+     ##      [generation
+     ##       [jvm (#+)
+     ##        <host-modules>]
+     ##       [js (#+)
+     ##        <host-modules>]
+     ##       [python (#+)
+     ##        <host-modules>]
+     ##       [lua (#+)
+     ##        <host-modules>]
+     ##       [ruby (#+)
+     ##        <host-modules>]
+     ##       ## [php (#+)
+     ##       ##  <host-modules>]
+     ##       ## [common-lisp (#+)
+     ##       ##  <host-modules>]
+     ##       ## [scheme (#+)
+     ##       ##  <host-modules>]
+     ##       ]
+     ##      [extension
+     ##       [generation
+     ##        [jvm (#+)]
+     ##        [js (#+)]
+     ##        [python (#+)]
+     ##        [lua (#+)]
+     ##        [ruby (#+)]]]]]]]]
      ## [control
-     ##  ["._" concatenative]
      ##  ["._" predicate]
      ##  [function
      ##   ["._" contract]]
@@ -131,7 +140,7 @@
      ["#." macro]
      ["#." math]
      ["#." time]
-     ["#." tool]
+     ## ["#." tool]
      ["#." type]
      ["#." world]
      ["#." host]
@@ -154,8 +163,6 @@
     ($_ _.and
         (_.test "Every value is identical to itself."
                 (is? self self))
-        (_.test "The identity function doesn't change values in any way."
-                (is? self (function.identity self)))
         (do @
           [other (random.unicode 1)]
           (_.test "Values created separately can't be identical."
@@ -357,27 +364,23 @@
                            ..templates)
                        (<| (_.context "Cross-platform support.")
                            ..cross-platform-support)))
-          (!bundle ($_ _.and
-                       /abstract.test
-                       /control.test
-                       /data.test
-                       /macro.test
-                       /math.test))
-          (!bundle ($_ _.and
-                       /time.test
-                       /tool.test
-                       /type.test
-                       /world.test))
-          (!bundle ($_ _.and
-                       /host.test
-                       /extension.test
-                       ($_ _.and
-                           /target/jvm.test)))
+          (_.in-parallel (list /abstract.test
+                               /control.test
+                               /data.test
+                               /macro.test
+                               /math.test
+                               /time.test
+                               ## /tool.test
+                               /type.test
+                               /world.test
+                               /host.test
+                               /extension.test
+                               /target/jvm.test
+                               ))
           )))
 
 (program: args
   (<| io
       _.run!
-      ## (_.times 100)
-      (_.seed 8070500311708372420)
+      (_.times 100)
       ..test))
diff --git a/stdlib/source/test/lux/abstract.lux b/stdlib/source/test/lux/abstract.lux
index 4becb6344..b9aa18c9c 100644
--- a/stdlib/source/test/lux/abstract.lux
+++ b/stdlib/source/test/lux/abstract.lux
@@ -9,6 +9,7 @@
    ["#." functor]
    ["#." interval]
    ["#." monad]
+   ["#." monoid]
    ["#." order]
    ["#." predicate]])
 
@@ -22,6 +23,7 @@
       /functor.test
       /interval.test
       /monad.test
+      /monoid.test
       /order.test
       /predicate.test
       ))
diff --git a/stdlib/source/test/lux/abstract/monoid.lux b/stdlib/source/test/lux/abstract/monoid.lux
index 5353e29cd..e1271ed2f 100644
--- a/stdlib/source/test/lux/abstract/monoid.lux
+++ b/stdlib/source/test/lux/abstract/monoid.lux
@@ -1,31 +1,55 @@
 (.module:
   [lux #*
-   ["%" data/text/format (#+ format)]
    ["_" test (#+ Test)]
-   [abstract/monad (#+ do)]
-   [math
-    ["." random (#+ Random)]]
+   [abstract
+    [monad (#+ do)]]
    [control
-    ["." function]]]
+    ["." function]]
+   [data
+    [number
+     ["." nat]
+     ["." int]]]
+   [math
+    ["." random (#+ Random)]]]
   {1
-   ["." / (#+ Monoid)
+   ["." /
     [//
      [equivalence (#+ Equivalence)]]]})
 
 (def: #export (spec (^open "/@.") (^open "/@.") gen-sample)
-  (All [a] (-> (Equivalence a) (Monoid a) (Random a) Test))
+  (All [a] (-> (Equivalence a) (/.Monoid a) (Random a) Test))
   (do random.monad
     [sample gen-sample
      left gen-sample
      mid gen-sample
      right gen-sample]
-    (<| (_.context (%.name (name-of /.Monoid)))
+    (<| (_.with-cover [/.Monoid])
         ($_ _.and
             (_.test "Left identity."
-                    (/@= sample (/@compose /@identity sample)))
+                    (/@= sample
+                         (/@compose /@identity sample)))
             (_.test "Right identity."
-                    (/@= sample (/@compose sample /@identity)))
+                    (/@= sample
+                         (/@compose sample /@identity)))
             (_.test "Associativity."
                     (/@= (/@compose left (/@compose mid right))
                          (/@compose (/@compose left mid) right)))
             ))))
+
+(def: #export test
+  Test
+  (do random.monad
+    [natL random.nat
+     natR random.nat
+     intL random.int
+     intR random.int]
+    (<| (_.covering /._)
+        ($_ _.and
+            (_.cover [/.compose]
+                     (let [[natLR intLR] (:: (/.compose nat.addition int.multiplication) compose
+                                             [natL intL] [natR intR])]
+                       (and (nat.= (:: nat.addition compose natL natR)
+                                   natLR)
+                            (int.= (:: int.multiplication compose intL intR)
+                                   intLR))))
+            ))))
diff --git a/stdlib/source/test/lux/control/concurrency/actor.lux b/stdlib/source/test/lux/control/concurrency/actor.lux
index 741b848cb..fe9362b07 100644
--- a/stdlib/source/test/lux/control/concurrency/actor.lux
+++ b/stdlib/source/test/lux/control/concurrency/actor.lux
@@ -91,7 +91,7 @@
                                                                         (promise.future (write cause)))}
                                                               write)
                                                _ (/.poison actor)]
-                                              (io.io (promise.poll read))))]
+                                              (promise.poll read)))]
                     (_.claim [/.poisoned]
                              (case result
                                (#.Some error)
diff --git a/stdlib/source/test/lux/control/concurrency/frp.lux b/stdlib/source/test/lux/control/concurrency/frp.lux
index 8752a195f..e6c8c179d 100644
--- a/stdlib/source/test/lux/control/concurrency/frp.lux
+++ b/stdlib/source/test/lux/control/concurrency/frp.lux
@@ -34,14 +34,17 @@
 (def: comparison
   (Comparison /.Channel)
   (function (_ == left right)
-    (case [(promise.poll left)
-           (promise.poll right)]
-      [(#.Some (#.Some [left _]))
-       (#.Some (#.Some [right _]))]
-      (== left right)
-      
-      _
-      false)))
+    (io.run
+     (do io.monad
+       [?left (promise.poll left)
+        ?right (promise.poll right)]
+       (wrap (case [?left ?right]
+               [(#.Some (#.Some [left _]))
+                (#.Some (#.Some [right _]))]
+               (== left right)
+               
+               _
+               false))))))
 
 (def: #export test
   Test
@@ -72,12 +75,15 @@
                                  _ (:: sink close)]
                                 (wrap channel)))
                          (#try.Success channel)
-                         (case (promise.poll channel)
-                           (#.Some (#.Some [actual _]))
-                           (n.= sample actual)
-                           
-                           _
-                           false)
+                         (io.run
+                          (do io.monad
+                            [?actual (promise.poll channel)]
+                            (wrap (case ?actual
+                                    (#.Some (#.Some [actual _]))
+                                    (n.= sample actual)
+                                    
+                                    _
+                                    false))))
                          
                          (#try.Failure error)
                          false))
diff --git a/stdlib/source/test/lux/control/concurrency/promise.lux b/stdlib/source/test/lux/control/concurrency/promise.lux
index 5b412e212..3e2d8982b 100644
--- a/stdlib/source/test/lux/control/concurrency/promise.lux
+++ b/stdlib/source/test/lux/control/concurrency/promise.lux
@@ -1,73 +1,171 @@
 (.module:
   [lux #*
    ["_" test (#+ Test)]
-   [abstract/monad (#+ do)]
+   [abstract
+    [monad (#+ do)]
+    {[0 #test]
+     [/
+      ["$." functor (#+ Injection Comparison)]
+      ["$." apply]
+      ["$." monad]]}]
    [control
-    pipe
+    [pipe (#+ case>)]
     ["." io]]
-   ["%" data/text/format (#+ format)]
+   [data
+    [number
+     ["n" nat]
+     ["i" int]]]
+   [time
+    ["." instant]
+    ["." duration]]
    [math
-    ["r" random]]]
+    ["." random]]]
   {1
-   ["." / ("#@." monad)]})
+   ["." /
+    [//
+     ["." atom (#+ Atom)]]]})
+
+(def: injection
+  (Injection /.Promise)
+  /.resolved)
+
+(def: comparison
+  (Comparison /.Promise)
+  (function (_ == left right)
+    (io.run
+     (do io.monad
+       [?left (/.poll left)
+        ?right (/.poll right)]
+       (wrap (case [?left ?right]
+               [(#.Some left)
+                (#.Some right)]
+               (== left right)
+               
+               _
+               false))))))
 
 (def: #export test
   Test
-  (do r.monad
-    [_ (wrap [])]
-    (<| (_.context (%.name (name-of /.Promise)))
+  (<| (_.covering /._)
+      (do random.monad
+        [to-wait (|> random.nat (:: @ map (|>> (n.% 100) (n.max 10))))
+         #let [extra-time (n.* 2 to-wait)]
+         expected random.nat
+         dummy random.nat
+         #let [not-dummy (|> random.nat (random.filter (|>> (n.= dummy) not)))]
+         leftE not-dummy
+         rightE not-dummy]
         ($_ _.and
+            (_.with-cover [/.functor]
+              ($functor.spec ..injection ..comparison /.functor))
+            (_.with-cover [/.apply]
+              ($apply.spec ..injection ..comparison /.apply))
+            (_.with-cover [/.monad]
+              ($monad.spec ..injection ..comparison /.monad))
+            
             (wrap (do /.monad
-                    [running? (/.future (io.io #1))]
-                    (_.assert "Can run IO actions in separate threads."
-                              running?)))
-
+                    [#let [[promise resolver] (: [(/.Promise Nat) (/.Resolver Nat)]
+                                                 (/.promise []))]
+                     resolved? (/.future (resolver expected))
+                     actual promise]
+                    (_.claim [/.Promise /.Resolver /.promise]
+                             (and resolved?
+                                  (n.= expected actual)))))
             (wrap (do /.monad
-                    [_ (/.wait 500)]
-                    (_.assert "Can wait for a specified amount of time."
-                              #1)))
-
+                    [actual (/.resolved expected)]
+                    (_.claim [/.resolved]
+                             (n.= expected actual))))
             (wrap (do /.monad
-                    [[left right] (/.and (/.future (io.io #1))
-                                         (/.future (io.io #0)))]
-                    (_.assert "Can combine promises sequentially."
-                              (and left (not right)))))
-
+                    [actual (/.future (io.io expected))]
+                    (_.claim [/.future]
+                             (n.= expected actual))))
             (wrap (do /.monad
-                    [?left (/.or (/.delay 100 #1)
-                                 (/.delay 200 #0))
-                     ?right (/.or (/.delay 200 #1)
-                                  (/.delay 100 #0))]
-                    (_.assert "Can combine promises alternatively."
-                              (case [?left ?right]
-                                [(#.Left #1) (#.Right #0)]
-                                #1
-
-                                _
-                                #0))))
-
+                    [pre (/.future instant.now)
+                     actual (/.schedule to-wait (io.io expected))
+                     post (/.future instant.now)]
+                    (_.claim [/.schedule]
+                             (and (n.= expected actual)
+                                  (i.>= (.int to-wait)
+                                        (duration.to-millis (instant.span pre post)))))))
             (wrap (do /.monad
-                    [?left (/.either (/.delay 100 #1)
-                                     (/.delay 200 #0))
-                     ?right (/.either (/.delay 200 #1)
-                                      (/.delay 100 #0))]
-                    (_.assert "Can combine promises alternatively [Part 2]."
-                              (and ?left (not ?right)))))
+                    [pre (/.future instant.now)
+                     _ (/.wait to-wait)
+                     post (/.future instant.now)]
+                    (_.claim [/.wait]
+                             (i.>= (.int to-wait)
+                                   (duration.to-millis (instant.span pre post))))))
+            (wrap (do /.monad
+                    [[leftA rightA] (/.and (/.future (io.io leftE))
+                                           (/.future (io.io rightE)))]
+                    (_.claim [/.and]
+                             (n.= (n.+ leftE rightE)
+                                  (n.+ leftA rightA)))))
+            (wrap (do /.monad
+                    [pre (/.future instant.now)
+                     actual (/.delay to-wait expected)
+                     post (/.future instant.now)]
+                    (_.claim [/.delay]
+                             (and (n.= expected actual)
+                                  (i.>= (.int to-wait)
+                                        (duration.to-millis (instant.span pre post)))))))
+            (wrap (do /.monad
+                    [?left (/.or (/.delay 10 leftE)
+                                 (/.delay 20 dummy))
+                     ?right (/.or (/.delay 20 dummy)
+                                  (/.delay 10 rightE))]
+                    (_.claim [/.or]
+                             (case [?left ?right]
+                               [(#.Left leftA) (#.Right rightA)]
+                               (n.= (n.+ leftE rightE)
+                                    (n.+ leftA rightA))
 
-            (_.test "Can poll a promise for its value."
-                    (and (|> (/.poll (/@wrap #1))
-                             (case> (#.Some #1) #1 _ #0))
-                         (|> (/.poll (/.delay 200 #1))
-                             (case> #.None #1 _ #0))))
+                               _
+                               false))))
+            (wrap (do /.monad
+                    [leftA (/.either (/.delay 10 leftE)
+                                     (/.delay 20 dummy))
+                     rightA (/.either (/.delay 20 dummy)
+                                      (/.delay 10 rightE))]
+                    (_.claim [/.either]
+                             (n.= (n.+ leftE rightE)
+                                  (n.+ leftA rightA)))))
+            (wrap (do /.monad
+                    [?actual (/.future (/.poll (/.resolved expected)))
+                     #let [[promise resolver] (: [(/.Promise Nat) (/.Resolver Nat)]
+                                                 (/.promise []))]
+                     ?never (/.future (/.poll promise))]
+                    (_.claim [/.poll]
+                             (case [?actual ?never]
+                               [(#.Some actual) #.None]
+                               (n.= expected actual)
 
+                               _
+                               false))))
+            (wrap (do /.monad
+                    [yep (/.future (/.resolved? (/.resolved expected)))
+                     #let [[promise resolver] (: [(/.Promise Nat) (/.Resolver Nat)]
+                                                 (/.promise []))]
+                     nope (/.future (/.resolved? promise))]
+                    (_.claim [/.resolved?]
+                             (and yep
+                                  (not nope)))))
             (wrap (do /.monad
-                    [?none (/.time-out 100 (/.delay 200 #1))
-                     ?some (/.time-out 200 (/.delay 100 #1))]
-                    (_.assert "Can establish maximum waiting times for promises to be fulfilled."
-                              (case [?none ?some]
-                                [#.None (#.Some #1)]
-                                #1
+                    [?none (/.time-out to-wait (/.delay extra-time dummy))
+                     ?actual (/.time-out extra-time (/.delay to-wait expected))]
+                    (_.claim [/.time-out]
+                             (case [?none ?actual]
+                               [#.None (#.Some actual)]
+                               (n.= expected actual)
 
-                                _
-                                #0))))
+                               _
+                               false))))
+            (wrap (do /.monad
+                    [#let [box (: (Atom Nat)
+                                  (atom.atom dummy))]
+                     _ (/.future (/.await (function (_ value)
+                                            (atom.write value box))
+                                          (/.resolved expected)))
+                     actual (/.future (atom.read box))]
+                    (_.claim [/.await]
+                             (n.= expected actual))))
             ))))