Re-named "lux/control/concurrency/process" to "thread".

7 files changed, 152 insertions, 57 deletions

diff --git a/stdlib/source/test/lux/control.lux b/stdlib/source/test/lux/control.lux
index 50e737e98..14d75527f 100644
--- a/stdlib/source/test/lux/control.lux
+++ b/stdlib/source/test/lux/control.lux
@@ -3,14 +3,14 @@
    ["_" test (#+ Test)]]
   ["." / #_
    ["#." concatenative]
-   [concurrency
-    ["#." actor]
-    ["#." atom]
-    ["#." frp]
-    ["#." process]
-    ["#." promise]
-    ["#." semaphore]
-    ["#." stm]]
+   ["#." concurrency #_
+    ["#/." actor]
+    ["#/." atom]
+    ["#/." frp]
+    ["#/." thread]
+    ["#/." promise]
+    ["#/." semaphore]
+    ["#/." stm]]
    ["#." continuation]
    ["#." exception]
    ["#." function
@@ -44,13 +44,13 @@
 (def: concurrency
   Test
   ($_ _.and
-      /actor.test
-      /atom.test
-      /frp.test
-      /process.test
-      /promise.test
-      /semaphore.test
-      /stm.test
+      /concurrency/actor.test
+      /concurrency/atom.test
+      /concurrency/frp.test
+      /concurrency/thread.test
+      /concurrency/promise.test
+      /concurrency/semaphore.test
+      /concurrency/stm.test
       ))
 
 (def: function
diff --git a/stdlib/source/test/lux/control/concurrency/process.lux b/stdlib/source/test/lux/control/concurrency/thread.lux
index 6d59672ca..6d59672ca 100644
--- a/stdlib/source/test/lux/control/concurrency/process.lux
+++ b/stdlib/source/test/lux/control/concurrency/thread.lux
diff --git a/stdlib/source/test/lux/control/security/policy.lux b/stdlib/source/test/lux/control/security/policy.lux
index 4a4f8409a..4885b52eb 100644
--- a/stdlib/source/test/lux/control/security/policy.lux
+++ b/stdlib/source/test/lux/control/security/policy.lux
@@ -20,7 +20,7 @@
    [math
     ["." random]]]
   {1
-   ["." / (#+ Context Privacy Can-Conceal Can-Reveal Privilege Private with-policy)]})
+   ["." / (#+ Context Privacy Can-Conceal Can-Reveal Privilege Private)]})
 
 (def: (injection can-conceal)
   (All [label]
@@ -48,7 +48,7 @@
 
 (def: (policy _)
   (Ex [%] (-> Any (Policy %)))
-  (with-policy
+  (/.with-policy
     (: (Context Privacy Policy)
        (function (_ (^@ privilege (^open "%@.")))
          (structure
@@ -72,8 +72,7 @@
   Test
   (<| (_.covering /._)
       (_.with-cover [/.Policy
-                     /.Can-Upgrade /.Can-Downgrade
-                     /.can-upgrade /.can-downgrade])
+                     /.Can-Upgrade /.Can-Downgrade])
       (do random.monad
         [#let [policy-0 (policy [])]
          raw-password (random.ascii 10)
diff --git a/stdlib/source/test/lux/data/collection/queue/priority.lux b/stdlib/source/test/lux/data/collection/queue/priority.lux
index 555214148..073ce2c8d 100644
--- a/stdlib/source/test/lux/data/collection/queue/priority.lux
+++ b/stdlib/source/test/lux/data/collection/queue/priority.lux
@@ -1,56 +1,92 @@
 (.module:
   [lux #*
-   ["%" data/text/format (#+ format)]
    ["_" test (#+ Test)]
    [abstract
     ["." monad (#+ do)]]
    [data
-    ["." maybe]
+    ["." maybe ("#@." functor)]
+    ["." bit ("#@." equivalence)]
     [number
      ["n" nat]]]
    [math
-    ["r" random (#+ Random)]]]
+    ["." random (#+ Random)]]]
   {1
    ["." / (#+ Queue)]})
 
-(def: #export (queue size)
+(def: #export (random size)
   (-> Nat (Random (Queue Nat)))
-  (do {! r.monad}
-    [inputs (r.list size r.nat)]
+  (do {! random.monad}
+    [inputs (random.list size random.nat)]
     (monad.fold ! (function (_ head tail)
                     (do !
-                      [priority r.nat]
+                      [priority random.nat]
                       (wrap (/.push priority head tail))))
                 /.empty
                 inputs)))
 
 (def: #export test
   Test
-  (<| (_.context (%.name (name-of /.Queue)))
-      (do {! r.monad}
-        [size (|> r.nat (:: ! map (n.% 100)))
-         sample (..queue size)
-         non-member-priority r.nat
-         non-member (|> r.nat (r.filter (|>> (/.member? n.equivalence sample) not)))]
+  (<| (_.covering /._)
+      (_.with-cover [/.Queue])
+      (do {! random.monad}
+        [size (:: ! map (n.% 100) random.nat)
+         sample (..random size)
+         non-member-priority random.nat
+         non-member (random.filter (|>> (/.member? n.equivalence sample) not)
+                                   random.nat)
+
+         max-member random.nat
+         min-member random.nat]
         ($_ _.and
-            (_.test "I can query the size of a queue (and empty queues have size 0)."
-                    (n.= size (/.size sample)))
-            (_.test "Enqueueing and dequeing affects the size of queues."
-                    (and (n.= (inc size)
-                              (/.size (/.push non-member-priority non-member sample)))
-                         (or (n.= 0 (/.size sample))
-                             (n.= (dec size)
-                                  (/.size (/.pop sample))))))
-            (_.test "I can query whether an element belongs to a queue."
-                    (and (and (not (/.member? n.equivalence sample non-member))
-                              (/.member? n.equivalence
-                                         (/.push non-member-priority non-member sample)
-                                         non-member))
-                         (or (n.= 0 (/.size sample))
-                             (and (/.member? n.equivalence
-                                             sample
-                                             (maybe.assume (/.peek sample)))
-                                  (not (/.member? n.equivalence
-                                                  (/.pop sample)
-                                                  (maybe.assume (/.peek sample))))))))
+            (_.cover [/.size]
+                     (n.= size (/.size sample)))
+            (_.cover [/.empty?]
+                     (bit@= (n.= 0 (/.size sample))
+                            (/.empty? sample)))
+            (_.cover [/.empty]
+                     (/.empty? /.empty))
+            (_.cover [/.peek]
+                     (case (/.peek sample)
+                       (#.Some first)
+                       (n.> 0 (/.size sample))
+                       
+                       #.None
+                       (/.empty? sample)))
+            (_.cover [/.member?]
+                     (case (/.peek sample)
+                       (#.Some first)
+                       (/.member? n.equivalence sample first)
+                       
+                       #.None
+                       (/.empty? sample)))
+            (_.cover [/.push]
+                     (let [sample+ (/.push non-member-priority non-member sample)]
+                       (and (not (/.member? n.equivalence sample non-member))
+                            (n.= (inc (/.size sample))
+                                 (/.size sample+))
+                            (/.member? n.equivalence sample+ non-member))))
+            (_.cover [/.pop]
+                     (let [sample- (/.pop sample)]
+                       (or (and (/.empty? sample)
+                                (/.empty? sample-))
+                           (n.= (dec (/.size sample))
+                                (/.size sample-)))))
+            (_.with-cover [/.Priority]
+              ($_ _.and
+                  (_.cover [/.max]
+                           (|> /.empty
+                               (/.push /.min min-member)
+                               (/.push /.max max-member)
+                               /.peek
+                               (maybe@map (n.= max-member))
+                               (maybe.default false)))
+                  (_.cover [/.min]
+                           (|> /.empty
+                               (/.push /.max max-member)
+                               (/.push /.min min-member)
+                               /.pop
+                               /.peek
+                               (maybe@map (n.= min-member))
+                               (maybe.default false)))
+                  ))
             ))))
diff --git a/stdlib/source/test/lux/type/check.lux b/stdlib/source/test/lux/type/check.lux
index ccd44ed89..3936c7a65 100644
--- a/stdlib/source/test/lux/type/check.lux
+++ b/stdlib/source/test/lux/type/check.lux
@@ -36,7 +36,7 @@
     (let [(^open "R@.") r.monad
           pairG (r.and (type' num-vars)
                        (type' num-vars))
-          quantifiedG (r.and (R@wrap (list)) (type' (n.+ 2 num-vars)))
+          quantifiedG (r.and (R@wrap (list)) (type' (inc num-vars)))
           random-pair (r.either (r.either (R@map (|>> #.Sum) pairG)
                                           (R@map (|>> #.Product) pairG))
                                 (r.either (R@map (|>> #.Function) pairG)
@@ -45,7 +45,7 @@
                                               (R@map (|>> #.Ex) r.nat))]
                       (case num-vars
                         0 random-id
-                        _ (r.either (R@map (|>> (n.% num-vars) #.Parameter) r.nat)
+                        _ (r.either (R@map (|>> (n.% num-vars) (n.* 2) inc #.Parameter) r.nat)
                                     random-id)))
           random-quantified (r.either (R@map (|>> #.UnivQ) quantifiedG)
                                       (R@map (|>> #.ExQ) quantifiedG))]
@@ -108,7 +108,7 @@
   (<| (_.context (%.name (name-of /._)))
       ($_ _.and
           (do r.monad
-            [sample (|> ..type (r.filter valid-type?))]
+            [sample (r.filter ..valid-type? ..type)]
             ($_ _.and
                 (_.test "Any is the super-type of everything."
                         (/.checks? Any sample))
@@ -159,7 +159,7 @@
              nameL gen-short
              nameR (|> gen-short (r.filter (|>> (text@= nameL) not)))
              paramL ..type
-             paramR (|> ..type (r.filter (|>> (/.checks? paramL) not)))]
+             paramR (r.filter (|>> (/.checks? paramL) not) ..type)]
             ($_ _.and
                 (_.test "Primitive types match when they have the same name and the same parameters."
                         (/.checks? (#.Primitive nameL (list paramL))
diff --git a/stdlib/source/test/lux/world.lux b/stdlib/source/test/lux/world.lux
index e46eecda3..c5b0ecc59 100644
--- a/stdlib/source/test/lux/world.lux
+++ b/stdlib/source/test/lux/world.lux
@@ -2,10 +2,12 @@
   [lux #*
    ["_" test (#+ Test)]]
   ["." / #_
-   ["#." file]])
+   ["#." file]
+   ["#." shell]])
 
 (def: #export test
   Test
   ($_ _.and
       /file.test
+      /shell.test
       ))
diff --git a/stdlib/source/test/lux/world/shell.lux b/stdlib/source/test/lux/world/shell.lux
new file mode 100644
index 000000000..f98fc6a17
--- /dev/null
+++ b/stdlib/source/test/lux/world/shell.lux
@@ -0,0 +1,58 @@
+(.module:
+  [lux #*
+   ["_" test (#+ Test)]
+   [abstract
+    [monad (#+ do)]]
+   [control
+    ["." try (#+ Try)]
+    ["." exception (#+ exception:)]]
+   [data
+    [number
+     ["n" nat]
+     ["i" int]]
+    [collection
+     ["." list]]]]
+  {1
+   ["." /]}
+  {[1 #spec]
+   ["$." /]})
+
+(exception: dead)
+
+(def: (simulation [environment command arguments])
+  (-> [/.Environment /.Command (List /.Argument)]
+      (/.Simulation Bit))
+  (structure
+   (def: (on-read dead?)
+     (if dead?
+       (exception.throw ..dead [])
+       (do try.monad
+         [to-echo (try.from-maybe (list.head arguments))]
+         (wrap [dead? to-echo]))))
+   
+   (def: (on-error dead?)
+     (if dead?
+       (exception.throw ..dead [])
+       (exception.return [dead? ""])))
+   
+   (def: (on-write message dead?)
+     (if dead?
+       (exception.throw ..dead [])
+       (#try.Success dead?)))
+
+   (def: (on-destroy dead?)
+     (if dead?
+       (exception.throw ..dead [])
+       (#try.Success true)))
+
+   (def: (on-await dead?)
+     (if dead?
+       (exception.throw ..dead [])
+       (#try.Success [true /.normal])))))
+
+(def: #export test
+  Test
+  (<| (_.covering /._)
+      (_.with-cover [/.mock /.Simulation]
+        ($/.spec (/.mock (|>> ..simulation #try.Success)
+                         false)))))