From 893c76ad530ca0e81cd84602543c3114407f4592 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 9 Dec 2020 20:42:37 -0400 Subject: Added support for "Commons Clause" to Licentia. --- stdlib/source/test/licentia.lux | 121 ++++++++++-------- stdlib/source/test/lux/control/io.lux | 6 +- stdlib/source/test/lux/data/number/frac.lux | 40 ++++-- stdlib/source/test/lux/data/number/int.lux | 9 +- stdlib/source/test/lux/data/number/nat.lux | 139 ++++++++++++++++----- .../language/lux/phase/extension/analysis/lux.lux | 2 - stdlib/source/test/lux/world.lux | 6 +- stdlib/source/test/lux/world/environment.lux | 31 ----- stdlib/source/test/lux/world/program.lux | 39 ++++++ stdlib/source/test/lux/world/shell.lux | 3 +- 10 files changed, 259 insertions(+), 137 deletions(-) delete mode 100644 stdlib/source/test/lux/world/environment.lux create mode 100644 stdlib/source/test/lux/world/program.lux (limited to 'stdlib/source/test') 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 [ ($_ _.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 } - (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 [] - [(<| (_.context (%.name (name-of ))) - ($monoid.spec /.equivalence 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 [ ] + [(_.with-cover [ ] + ($monoid.spec /.equivalence random.nat))] + + [/.+ /.addition] + [/.* /.multiplication] + + [/.min /.minimum] + [/.max /.maximum] + )) + (~~ (template [] + [(_.with-cover [] + ($codec.spec /.equivalence random.nat))] + + [/.binary] [/.octal] [/.decimal] [/.hex] + )) + ))) - [/.addition] [/.multiplication] [/.minimum] [/.maximum] - )) - (~~ (template [] - [(<| (_.context (%.name (name-of /.binary))) - ($codec.spec /.equivalence 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] ["$." /]}) -- cgit v1.2.3