Added support for "Commons Clause" to Licentia.

10 files changed, 259 insertions, 137 deletions

diff --git a/stdlib/source/test/licentia.lux b/stdlib/source/test/licentia.lux
index 92b43b20c..af03062cb 100644
--- a/stdlib/source/test/licentia.lux
+++ b/stdlib/source/test/licentia.lux
@@ -1,9 +1,12 @@
 (.module:
   [lux #*
-   [cli (#+ program:)]
    ["_" test (#+ Test)]
-   [abstract/monad (#+ do)]
-   [io (#+ io)]
+   [abstract
+    [monad (#+ do)]]
+   [control
+    [io (#+ io)]
+    [parser
+     [cli (#+ program:)]]]
    [data
     ["." bit ("#\." equivalence)]
     ["." maybe ("#\." functor)]
@@ -13,7 +16,7 @@
     [collection
      ["." list ("#\." functor)]]]
    [math
-    ["r" random (#+ Random)]]]
+    ["." random (#+ Random)]]]
   {#program
    [/
     ["." license (#+ Identification
@@ -24,6 +27,7 @@
                      Extension
                      Entity Black-List
                      URL Attribution
+                     Addendum
                      License)
      ["." time (#+ Period)]
      ["." copyright]
@@ -37,108 +41,117 @@
      ["." commercial]
      ["." extension]
      ["." miscellaneous]
-     ["." black-list]]
+     ["." black-list]
+     ["." addendum]]
     ["." output]]})
 
 (def: period
   (Random (Period Nat))
-  (do {! r.monad}
-    [start (r.filter (|>> (n.= n\top) not)
-                     r.nat)
+  (do {! random.monad}
+    [start (random.filter (|>> (n.= n\top) not)
+                          random.nat)
      #let [wiggle-room (n.- start n\top)]
      end (\ ! map
             (|>> (n.% wiggle-room) (n.max 1))
-            r.nat)]
+            random.nat)]
     (wrap {#time.start start
            #time.end end})))
 
 (def: copyright-holder
   (Random copyright.Holder)
-  ($_ r.and
-      (r.ascii 10)
+  ($_ random.and
+      (random.ascii 10)
       ..period))
 
 (def: identification
   (Random Identification)
-  ($_ r.and
-      (r.ascii 10)
-      (r.ascii 10)))
+  ($_ random.and
+      (random.ascii 10)
+      (random.ascii 10)))
 
 (def: termination
   (Random Termination)
-  ($_ r.and
-      r.bit
-      r.nat
-      r.nat))
+  ($_ random.and
+      random.bit
+      random.nat
+      random.nat))
 
 (def: liability
   (Random Liability)
-  ($_ r.and
-      r.bit
-      r.bit))
+  ($_ random.and
+      random.bit
+      random.bit))
 
 (def: distribution
   (Random Distribution)
-  ($_ r.and
-      r.bit
-      r.bit))
+  ($_ random.and
+      random.bit
+      random.bit))
 
 (def: commercial
   (Random Commercial)
-  ($_ r.and
-      r.bit
-      r.bit
-      r.bit))
+  ($_ random.and
+      random.bit
+      random.bit
+      random.bit))
 
 (def: extension
   (Random Extension)
-  ($_ r.and
-      r.bit
-      r.bit
-      (r.maybe ..period)
-      r.bit))
+  ($_ random.and
+      random.bit
+      random.bit
+      (random.maybe ..period)
+      random.bit))
 
 (def: entity
   (Random Entity)
-  (r.ascii 10))
+  (random.ascii 10))
 
 (def: (variable-list max-size gen-element)
   (All [a] (-> Nat (Random a) (Random (List a))))
-  (do {! r.monad}
+  (do {! random.monad}
     [amount (\ ! map (n.% (n.max 1 max-size))
-               r.nat)]
-    (r.list amount gen-element)))
+               random.nat)]
+    (random.list amount gen-element)))
 
 (def: black-list
   (Random Black-List)
-  ($_ r.and
-      (r.maybe (r.ascii 10))
+  ($_ random.and
+      (random.maybe (random.ascii 10))
       (variable-list 10 ..entity)))
 
 (def: url
   (Random URL)
-  (r.ascii 10))
+  (random.ascii 10))
 
 (def: attribution
   (Random Attribution)
-  ($_ r.and
-      (r.ascii 10)
-      (r.maybe (r.ascii 10))
+  ($_ random.and
+      (random.ascii 10)
+      (random.maybe (random.ascii 10))
       ..url
-      (r.maybe ..url)))
+      (random.maybe ..url)))
+
+(def: addendum
+  (Random Addendum)
+  ($_ random.and
+      random.bit
+      ))
 
 (def: license
   (Random License)
-  ($_ r.and
-      (r.list 2 ..copyright-holder)
-      (r.maybe ..identification)
+  ($_ random.and
+      (random.list 2 ..copyright-holder)
+      (random.maybe ..identification)
       ..termination
       ..liability
       ..distribution
       ..commercial
       ..extension
       (variable-list 3 ..black-list)
-      (r.maybe attribution)))
+      (random.maybe attribution)
+      ..addendum
+      ))
 
 (type: (Concern a)
   (-> (-> Text Bit) a Test))
@@ -263,9 +276,17 @@
               (present? miscellaneous.export-restrictions))
       ))
 
+(def: (about-addendum present? value)
+  (Concern Addendum)
+  ($_ _.and
+      (_.test "Commons clause"
+              (bit\= (get@ #license.commons-clause? value)
+                     (present? addendum.commons-clause)))
+      ))
+
 (def: test
   Test
-  (do r.monad
+  (do random.monad
     [license ..license
      #let [writ (output.license license)
            present? (: (-> Text Bit)
@@ -337,6 +358,8 @@
 
         (..about-miscellaneous present?)
 
+        (..about-addendum present? (get@ #license.addendum license))
+
         (_.test "License ending footer is present."
                 (present? notice.end-of-license))
         )))
diff --git a/stdlib/source/test/lux/control/io.lux b/stdlib/source/test/lux/control/io.lux
index 4855e8c3f..596f29b11 100644
--- a/stdlib/source/test/lux/control/io.lux
+++ b/stdlib/source/test/lux/control/io.lux
@@ -45,8 +45,4 @@
             (_.cover [/.run /.io]
                      (n.= sample
                           (/.run (/.io sample))))
-            (_.cover [/.exit]
-                     ## The /.exit is not actually executed because it would immediately
-                     ## terminate the program/tests.
-                     (exec (/.exit exit-code)
-                       true))))))
+            ))))
diff --git a/stdlib/source/test/lux/data/number/frac.lux b/stdlib/source/test/lux/data/number/frac.lux
index 193b4a960..08fcef498 100644
--- a/stdlib/source/test/lux/data/number/frac.lux
+++ b/stdlib/source/test/lux/data/number/frac.lux
@@ -183,11 +183,19 @@
                                          (/.mod left right))))))
                 ))
           (with-expansions [<jvm> ($_ _.and
-                                      (do random.monad
-                                        [expected random.frac]
-                                        (_.cover [/.to-bits]
-                                                 (n.= (.nat (java/lang/Double::doubleToRawLongBits expected))
-                                                      (/.to-bits expected))))
+                                      (let [test (: (-> Frac Bit)
+                                                    (function (_ value)
+                                                      (n.= (.nat (java/lang/Double::doubleToRawLongBits value))
+                                                           (/.to-bits value))))]
+                                        (do random.monad
+                                          [sample random.frac]
+                                          (_.cover [/.to-bits]
+                                                   (and (test sample)
+                                                        (test /.biggest)
+                                                        (test /.smallest)
+                                                        (test /.not-a-number)
+                                                        (test /.positive-infinity)
+                                                        (test /.negative-infinity)))))
                                       (do random.monad
                                         [sample random.i64]
                                         (_.cover [/.from-bits]
@@ -199,13 +207,21 @@
                                       )]
             (for {@.old <jvm>
                   @.jvm <jvm>}
-                 (do random.monad
-                   [expected random.frac]
-                   (_.cover [/.to-bits /.from-bits]
-                            (let [actual (|> expected /.to-bits /.from-bits)]
-                              (or (/.= expected actual)
-                                  (and (/.not-a-number? expected)
-                                       (/.not-a-number? actual))))))))
+                 (let [test (: (-> Frac Bit)
+                               (function (_ expected)
+                                 (let [actual (|> expected /.to-bits /.from-bits)]
+                                   (or (/.= expected actual)
+                                       (and (/.not-a-number? expected)
+                                            (/.not-a-number? actual))))))]
+                   (do random.monad
+                     [sample random.frac]
+                     (_.cover [/.to-bits /.from-bits]
+                              (and (test sample)
+                                   (test /.biggest)
+                                   (test /.smallest)
+                                   (test /.not-a-number)
+                                   (test /.positive-infinity)
+                                   (test /.negative-infinity)))))))
           (do random.monad
             [expected random.safe-frac]
             (_.cover [/.negate]
diff --git a/stdlib/source/test/lux/data/number/int.lux b/stdlib/source/test/lux/data/number/int.lux
index 31b732b88..16c23246a 100644
--- a/stdlib/source/test/lux/data/number/int.lux
+++ b/stdlib/source/test/lux/data/number/int.lux
@@ -17,7 +17,7 @@
      ["f" frac]
      ["." i64 ("#\." hash)]]]
    [math
-    ["." random]]]
+    ["." random (#+ Random)]]]
   {1
    ["." /]})
 
@@ -53,8 +53,7 @@
 (def: predicate
   Test
   (do {! random.monad}
-    [sample random.int
-     shift (\ ! map /.abs random.int)]
+    [sample random.int]
     ($_ _.and
         (_.cover [/.negative?]
                  (bit\= (/.negative? sample)
@@ -132,7 +131,9 @@
                                          (/.mod left right))))))
                 ))
           (do {! random.monad}
-            [#let [random (\ ! map (/.% +1,000) random.int)]
+            [#let [random (|> random.int
+                              (\ ! map (/.% +1,000))
+                              (random.filter (|>> (/.= +0) not)))]
              left random
              right random]
             ($_ _.and
diff --git a/stdlib/source/test/lux/data/number/nat.lux b/stdlib/source/test/lux/data/number/nat.lux
index e07f584b1..6e027eab1 100644
--- a/stdlib/source/test/lux/data/number/nat.lux
+++ b/stdlib/source/test/lux/data/number/nat.lux
@@ -1,6 +1,5 @@
 (.module:
   [lux #*
-   ["%" data/text/format (#+ format)]
    ["_" test (#+ Test)]
    [abstract
     [monad (#+ do)]
@@ -12,38 +11,120 @@
       ["$." interval]
       ["$." monoid]
       ["$." codec]]}]
+   [data
+    ["." bit ("#\." equivalence)]
+    [number
+     ["f" frac]
+     ["." i64 ("#\." hash)]]]
    [math
-    ["r" random]]]
+    ["." random]]]
   {1
-   ["." /
-    //]})
+   ["." /]})
 
-(def: #export test
+(def: signature
   Test
-  (<| (_.context (%.name (name-of /._)))
-      (`` ($_ _.and
-              ($equivalence.spec /.equivalence r.nat)
-              ($order.spec /.order r.nat)
-              ($enum.spec /.enum r.nat)
-              ($interval.spec /.interval r.nat)
-              (~~ (template [<monoid>]
-                    [(<| (_.context (%.name (name-of <monoid>)))
-                         ($monoid.spec /.equivalence <monoid> r.nat))]
+  (`` ($_ _.and
+          (_.with-cover [/.equivalence /.=]
+            ($equivalence.spec /.equivalence random.nat))
+          (_.with-cover [/.order /.<]
+            ($order.spec /.order random.nat))
+          (_.with-cover [/.enum]
+            ($enum.spec /.enum random.nat))
+          (_.with-cover [/.interval]
+            ($interval.spec /.interval random.nat))
+          (~~ (template [<compose> <monoid>]
+                [(_.with-cover [<monoid> <compose>]
+                   ($monoid.spec /.equivalence <monoid> random.nat))]
+                
+                [/.+ /.addition]
+                [/.* /.multiplication]
+
+                [/.min /.minimum]
+                [/.max /.maximum]
+                ))
+          (~~ (template [<codec>]
+                [(_.with-cover [<codec>]
+                   ($codec.spec /.equivalence <codec> random.nat))]
+
+                [/.binary] [/.octal] [/.decimal] [/.hex]
+                ))
+          )))
 
-                    [/.addition] [/.multiplication] [/.minimum] [/.maximum]
-                    ))
-              (~~ (template [<codec>]
-                    [(<| (_.context (%.name (name-of /.binary)))
-                         ($codec.spec /.equivalence <codec> r.nat))]
+(def: predicate
+  Test
+  (do {! random.monad}
+    [sample random.nat]
+    ($_ _.and
+        (_.cover [/.even? /.odd?]
+                 (bit\= (/.even? sample)
+                        (not (/.odd? sample))))
+        )))
 
-                    [/.binary] [/.octal] [/.decimal] [/.hex]
-                    ))
+(def: #export test
+  Test
+  (<| (_.covering /._)
+      (_.with-cover [.Nat])
+      ($_ _.and
+          (do random.monad
+            [sample random.nat]
+            ($_ _.and
+                (_.cover [/.-]
+                         (and (/.= 0 (/.- sample sample))
+                              (/.= sample (/.- 0 sample))))
+                (_.cover [/./]
+                         (and (/.= 1 (/./ sample sample))
+                              (/.= sample (/./ 1 sample))))
+                ))
+          (do random.monad
+            [left random.nat
+             right random.nat]
+            ($_ _.and
+                (_.cover [/.>]
+                         (bit\= (/.> left right)
+                                (/.< right left)))
+                (_.cover [/.<= /.>=]
+                         (bit\= (/.<= left right)
+                                (/.>= right left)))
+                ))
+          (do random.monad
+            [left (random.filter (|>> (/.= 0) not)
+                                 random.nat)
+             right random.nat]
+            ($_ _.and
+                (_.cover [/.%]
+                         (let [rem (/.% left right)
+                               div (|> right (/.- rem) (/./ left))]
+                           (/.= right
+                                (|> div (/.* left) (/.+ rem)))))
+                (_.cover [/./%]
+                         (let [[div rem] (/./% left right)]
+                           (and (/.= div (/./ left right))
+                                (/.= rem (/.% left right)))))
+                ))
+          (do {! random.monad}
+            [#let [random (\ ! map (|>> (/.% 1,000) inc) random.nat)]
+             left random
+             right random]
+            ($_ _.and
+                (_.cover [/.gcd]
+                         (let [gcd (/.gcd left right)]
+                           (and (/.= 0 (/.% gcd left))
+                                (/.= 0 (/.% gcd right)))))
+                (_.cover [/.lcm]
+                         (let [lcm (/.lcm left right)]
+                           (and (/.= 0 (/.% left lcm))
+                                (/.= 0 (/.% right lcm)))))
+                ))
+          (do {! random.monad}
+            [expected (\ ! map (/.% 1,000,000) random.nat)]
+            (_.cover [/.frac]
+                     (|> expected /.frac f.nat (/.= expected))))
+          (do random.monad
+            [sample random.nat]
+            (_.cover [/.hash]
+                     (i64\= (i64\hash sample)
+                            (\ /.hash hash sample))))
 
-              (_.test "Alternate notations."
-                      (and (/.= (bin "11001001")
-                                (bin "11,00,10,01"))
-                           (/.= (oct "615243")
-                                (oct "615,243"))
-                           (/.= (hex "deadBEEF")
-                                (hex "dead,BEEF"))))
-              ))))
+          ..predicate
+          ..signature
+          )))
diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux
index dccabcea7..4041ceaba 100644
--- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux
+++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux
@@ -187,8 +187,6 @@
                 (check-success+ "lux io log" (list logC) Any))
         (_.test "Can throw a run-time error."
                 (check-success+ "lux io error" (list logC) Nothing))
-        (_.test "Can exit the program."
-                (check-success+ "lux io exit" (list exitC) Nothing))
         (_.test "Can query the current time (as milliseconds since epoch)."
                 (check-success+ "lux io current-time" (list) Int))
         )))
diff --git a/stdlib/source/test/lux/world.lux b/stdlib/source/test/lux/world.lux
index e7aa38aa1..0405ef7ee 100644
--- a/stdlib/source/test/lux/world.lux
+++ b/stdlib/source/test/lux/world.lux
@@ -2,16 +2,16 @@
   [lux #*
    ["_" test (#+ Test)]]
   ["." / #_
-   ["#." environment]
    ["#." file]
    ["#." shell]
-   ["#." console]])
+   ["#." console]
+   ["#." program]])
 
 (def: #export test
   Test
   ($_ _.and
-      /environment.test
       /file.test
       /shell.test
       /console.test
+      /program.test
       ))
diff --git a/stdlib/source/test/lux/world/environment.lux b/stdlib/source/test/lux/world/environment.lux
deleted file mode 100644
index 28bcfc377..000000000
--- a/stdlib/source/test/lux/world/environment.lux
+++ /dev/null
@@ -1,31 +0,0 @@
-(.module:
-  [lux #*
-   ["_" test (#+ Test)]
-   [abstract
-    [monad (#+ do)]]
-   [control
-    [concurrency
-     ["." promise]]]
-   [data
-    ["." text]
-    [collection
-     ["." dictionary]
-     ["." list]]]
-   [math
-    ["." random]]]
-  {1
-   ["." /]})
-
-(def: #export test
-  Test
-  (<| (_.covering /._)
-      (_.with-cover [/.Environment /.Property])
-      (do random.monad
-        [_ (wrap [])]
-        (wrap (do promise.monad
-                [environment (promise.future /.read)]
-                (_.cover' [/.read]
-                          (and (not (dictionary.empty? environment))
-                               (|> environment
-                                   dictionary.keys
-                                   (list.every? (|>> text.empty? not))))))))))
diff --git a/stdlib/source/test/lux/world/program.lux b/stdlib/source/test/lux/world/program.lux
new file mode 100644
index 000000000..5dcf6270a
--- /dev/null
+++ b/stdlib/source/test/lux/world/program.lux
@@ -0,0 +1,39 @@
+(.module:
+  [lux #*
+   ["_" test (#+ Test)]
+   [abstract
+    [monad (#+ do)]]
+   [control
+    [parser
+     [environment (#+ Environment)]]]
+   [data
+    ["." text]]
+   [math
+    ["." random (#+ Random)]]]
+  {1
+   ["." /
+    [//
+     [file (#+ Path)]]]}
+  {[1 #spec]
+   ["$." /]})
+
+(def: environment
+  (Random Environment)
+  (random.dictionary text.hash 5
+                     (random.ascii/alpha 5)
+                     (random.ascii/alpha 5)))
+
+(def: directory
+  (Random Path)
+  (random.ascii/alpha 5))
+
+(def: #export test
+  Test
+  (<| (_.covering /._)
+      (do random.monad
+        [environment ..environment
+         directory ..directory]
+        ($_ _.and
+            (_.with-cover [/.mock /.async]
+              ($/.spec (/.async (/.mock environment directory))))
+            ))))
diff --git a/stdlib/source/test/lux/world/shell.lux b/stdlib/source/test/lux/world/shell.lux
index e9d844141..cf349e225 100644
--- a/stdlib/source/test/lux/world/shell.lux
+++ b/stdlib/source/test/lux/world/shell.lux
@@ -13,7 +13,7 @@
     [security
      ["!" capability]]
     [parser
-     ["." environment]]]
+     ["." environment (#+ Environment)]]]
    [data
     ["." text ("#\." equivalence)]
     [number
@@ -26,7 +26,6 @@
   {1
    ["." /
     [//
-     [environment (#+ Environment)]
      [file (#+ Path)]]]}
   {[1 #spec]
    ["$." /]})