diff options
Diffstat (limited to '')
24 files changed, 342 insertions, 288 deletions
diff --git a/stdlib/source/test/aedifex.lux b/stdlib/source/test/aedifex.lux index 704faffbb..2f46df228 100644 --- a/stdlib/source/test/aedifex.lux +++ b/stdlib/source/test/aedifex.lux @@ -31,8 +31,7 @@ ["#." pom] ["#." repository] ["#." runtime] - ["#." metadata #_ - ["#/." artifact]]]) + ["#." metadata]]) (def: test Test @@ -61,7 +60,7 @@ /pom.test /repository.test /runtime.test - /metadata/artifact.test + /metadata.test )) (program: args diff --git a/stdlib/source/test/aedifex/metadata.lux b/stdlib/source/test/aedifex/metadata.lux new file mode 100644 index 000000000..5b8b47b00 --- /dev/null +++ b/stdlib/source/test/aedifex/metadata.lux @@ -0,0 +1,32 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)]] + [data + ["." text]] + [math + ["." random]]] + ["." / #_ + ["#." artifact] + [// + ["@." artifact]]] + {#program + ["." /]}) + +(def: #export test + Test + (<| (_.covering /._) + ($_ _.and + (<| (_.for [/.file]) + (do random.monad + [sample @artifact.random] + ($_ _.and + (_.cover [/.for-project] + (text.ends-with? /.file (/.for-project sample))) + (_.cover [/.for-version] + (text.ends-with? /.file (/.for-version sample))) + ))) + + /artifact.test + ))) diff --git a/stdlib/source/test/aedifex/repository.lux b/stdlib/source/test/aedifex/repository.lux index 4da17a059..ff669d687 100644 --- a/stdlib/source/test/aedifex/repository.lux +++ b/stdlib/source/test/aedifex/repository.lux @@ -2,14 +2,15 @@ [lux #* ["_" test (#+ Test)] [abstract - ["." hash (#+ Hash)] - ["." equivalence (#+ Equivalence)] + [equivalence (#+ Equivalence)] + [hash (#+ Hash)] ["." monad (#+ do)]] [control ["." io] ["." try] ["." exception (#+ exception:)]] [data + ["." product] ["." binary (#+ Binary)] ["." text ["%" format (#+ format)]] @@ -34,7 +35,7 @@ (def: identity-equivalence (Equivalence Identity) - (equivalence.product text.equivalence + (product.equivalence text.equivalence text.equivalence)) (def: artifact @@ -43,7 +44,7 @@ (def: item-hash (Hash [Artifact Extension]) - (hash.product //artifact.hash + (product.hash //artifact.hash text.hash)) (exception: (not-found {artifact Artifact} diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index 7e138d33b..7b85a6ff4 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -1,16 +1,17 @@ (.module: ["/" lux #* + ["@" target] [abstract [monad (#+ do)] [predicate (#+ Predicate)]] [control ["." io (#+ io)] - [function - [mixin (#+)]] [parser [cli (#+ program:)]]] [data ["." name] + [text + ["%" format (#+ format)]] [number ["." i64] ["n" nat] @@ -19,109 +20,8 @@ ["f" frac]]] ["." math] ["_" test (#+ Test)] - ## These modules do not need to be tested. - [type - [variance (#+)]] - [locale (#+) - [language (#+)] - [territory (#+)]] - ["%" data/text/format (#+ format)] [math - ["." random (#+ Random) ("#\." functor)]] - ## TODO: Test these modules - ## [data - ## [format - ## [css (#+)] - ## [markdown (#+)]]] - - ["@" target - ## [js (#+)] - ## [python (#+)] - ## [lua (#+)] - ## [ruby (#+)] - ## [php (#+)] - ## [common-lisp (#+)] - ## [scheme (#+)] - ] - - ## [tool - ## [compiler - ## [language - ## [lux - ## [phase - ## [generation - ## [jvm (#+)] - ## [js (#+)] - ## ## [python (#+)] - ## ## [lua (#+)] - ## ## [ruby (#+)] - ## ## [php (#+)] - ## ## [common-lisp (#+)] - ## ## [scheme (#+)] - ## ] - ## [extension - ## [generation - ## [jvm (#+)] - ## [js (#+)] - ## ## [python (#+)] - ## ## [lua (#+)] - ## ## [ruby (#+)] - ## ]] - ## ]]]]] - - ## [control - ## ["._" predicate] - ## [function - ## ["._" contract]] - ## [monad - ## ["._" free]] - ## [parser - ## [type (#+)]]] - ## [data - ## ["._" env] - ## ["._" trace] - ## ["._" store] - ## [format - ## ["._" context] - ## ["._" html] - ## ["._" css] - ## ["._" binary]] - ## [collection - ## [tree - ## [rose - ## ["._" parser]]] - ## [dictionary - ## ["._" plist]] - ## [set - ## ["._" multi]]] - ## [text - ## ["._" buffer]]] - ## ["._" macro] - ## [type - ## ["._" unit] - ## ["._" refinement] - ## ["._" quotient]] - ## [world - ## ["._" environment] - ## ["._" console]] - ## [compiler - ## ["._" cli] - ## ["._" default - ## ["._" evaluation] - ## [phase - ## ["._" generation] - ## [extension - ## ["._" directive]]] - ## ["._default" cache]] - ## [meta - ## ["._meta" io - ## ["._meta_io" context] - ## ["._meta_io" archive]] - ## ["._meta" archive] - ## ["._meta" cache]]] - ## ["._" interpreter - ## ["._interpreter" type]] - ] + ["." random (#+ Random) ("#\." functor)]]] ## TODO: Must have 100% coverage on tests. ["." / #_ ["#." abstract] diff --git a/stdlib/source/test/lux/abstract.lux b/stdlib/source/test/lux/abstract.lux index b31c10617..9fd3986b8 100644 --- a/stdlib/source/test/lux/abstract.lux +++ b/stdlib/source/test/lux/abstract.lux @@ -8,7 +8,6 @@ ["#/." cofree]] ["#." enum] ["#." equivalence] - ["#." hash] ["#." fold] ["#." functor ["#/." contravariant]] @@ -47,7 +46,6 @@ /codec.test /enum.test /equivalence.test - /hash.test /fold.test /interval.test /monoid.test diff --git a/stdlib/source/test/lux/abstract/codec.lux b/stdlib/source/test/lux/abstract/codec.lux index da9a7b438..8c68f4cc6 100644 --- a/stdlib/source/test/lux/abstract/codec.lux +++ b/stdlib/source/test/lux/abstract/codec.lux @@ -24,7 +24,7 @@ (|>> #json.Boolean [field] list - (json.object))) + json.object)) (def: decode (json.get-boolean field))))) diff --git a/stdlib/source/test/lux/abstract/equivalence.lux b/stdlib/source/test/lux/abstract/equivalence.lux index 95f62218c..3009c289f 100644 --- a/stdlib/source/test/lux/abstract/equivalence.lux +++ b/stdlib/source/test/lux/abstract/equivalence.lux @@ -39,24 +39,6 @@ ($_ _.and (_.for [/.functor] ($contravariant.spec equivalence n.equivalence /.functor)) - (_.cover [/.sum] - (let [equivalence (/.sum n.equivalence i.equivalence)] - (and (bit\= (\ n.equivalence = leftN leftN) - (\ equivalence = (#.Left leftN) (#.Left leftN))) - (bit\= (\ n.equivalence = leftN rightN) - (\ equivalence = (#.Left leftN) (#.Left rightN))) - (bit\= (\ i.equivalence = leftI leftI) - (\ equivalence = (#.Right leftI) (#.Right leftI))) - (bit\= (\ i.equivalence = leftI rightI) - (\ equivalence = (#.Right leftI) (#.Right rightI)))))) - (_.cover [/.product] - (let [equivalence (/.product n.equivalence i.equivalence)] - (and (bit\= (and (\ n.equivalence = leftN leftN) - (\ i.equivalence = leftI leftI)) - (\ equivalence = [leftN leftI] [leftN leftI])) - (bit\= (and (\ n.equivalence = leftN rightN) - (\ i.equivalence = leftI rightI)) - (\ equivalence = [leftN leftI] [rightN rightI]))))) (_.cover [/.rec] (let [equivalence (: (Equivalence (List Nat)) (/.rec (function (_ equivalence) diff --git a/stdlib/source/test/lux/abstract/hash.lux b/stdlib/source/test/lux/abstract/hash.lux deleted file mode 100644 index d829d489e..000000000 --- a/stdlib/source/test/lux/abstract/hash.lux +++ /dev/null @@ -1,37 +0,0 @@ -(.module: - [lux #* - ["_" test (#+ Test)] - [abstract - [monad (#+ do)] - {[0 #spec] - [/ - [functor - ["$." contravariant]]]}] - [data - [number - ["n" nat] - ["i" int]]] - [math - ["." random (#+ Random)]]] - {1 - ["." /]}) - -(def: #export test - Test - (do random.monad - [left random.int - right random.nat] - (<| (_.covering /._) - ($_ _.and - (_.cover [/.sum] - (let [hash (/.sum i.hash n.hash)] - (and (n.= (\ i.hash hash left) - (\ hash hash (#.Left left))) - (n.= (\ n.hash hash right) - (\ hash hash (#.Right right)))))) - (_.cover [/.product] - (let [hash (/.product i.hash n.hash)] - (n.= (n.+ (\ i.hash hash left) - (\ n.hash hash right)) - (\ hash hash [left right])))) - )))) diff --git a/stdlib/source/test/lux/control/concurrency/promise.lux b/stdlib/source/test/lux/control/concurrency/promise.lux index 04dd1c220..51908a257 100644 --- a/stdlib/source/test/lux/control/concurrency/promise.lux +++ b/stdlib/source/test/lux/control/concurrency/promise.lux @@ -108,10 +108,10 @@ (i.>= (.int to-wait) (duration.to-millis (instant.span pre post))))))) (wrap (do /.monad - [?left (/.or (/.delay 100 leftE) - (/.delay 200 dummy)) - ?right (/.or (/.delay 200 dummy) - (/.delay 100 rightE))] + [?left (/.or (wrap leftE) + (/.delay to-wait dummy)) + ?right (/.or (/.delay to-wait dummy) + (wrap rightE))] (_.cover' [/.or] (case [?left ?right] [(#.Left leftA) (#.Right rightA)] @@ -121,10 +121,10 @@ _ false)))) (wrap (do /.monad - [leftA (/.either (/.delay 100 leftE) - (/.delay 200 dummy)) - rightA (/.either (/.delay 200 dummy) - (/.delay 100 rightE))] + [leftA (/.either (wrap leftE) + (/.delay to-wait dummy)) + rightA (/.either (/.delay to-wait dummy) + (wrap rightE))] (_.cover' [/.either] (n.= (n.+ leftE rightE) (n.+ leftA rightA))))) diff --git a/stdlib/source/test/lux/control/parser/analysis.lux b/stdlib/source/test/lux/control/parser/analysis.lux index d3e966715..e089fb4d2 100644 --- a/stdlib/source/test/lux/control/parser/analysis.lux +++ b/stdlib/source/test/lux/control/parser/analysis.lux @@ -23,8 +23,7 @@ ["." random (#+ Random)]] [tool [compiler - [reference (#+ Constant) - [variable (#+)]] + [reference (#+ Constant)] [language [lux ["." analysis]]]]]] diff --git a/stdlib/source/test/lux/control/security/policy.lux b/stdlib/source/test/lux/control/security/policy.lux index 647526b6c..b907e8e54 100644 --- a/stdlib/source/test/lux/control/security/policy.lux +++ b/stdlib/source/test/lux/control/security/policy.lux @@ -2,7 +2,6 @@ [lux #* ["_" test (#+ Test)] [abstract - [equivalence (#+)] [hash (#+ Hash)] [monad (#+ do)] {[0 #spec] diff --git a/stdlib/source/test/lux/data/collection/dictionary.lux b/stdlib/source/test/lux/data/collection/dictionary.lux index e5f37d5de..2080e387a 100644 --- a/stdlib/source/test/lux/data/collection/dictionary.lux +++ b/stdlib/source/test/lux/data/collection/dictionary.lux @@ -4,7 +4,6 @@ [abstract [hash (#+ Hash)] [monad (#+ do)] - ["." equivalence] {[0 #spec] [/ ["$." equivalence] @@ -13,6 +12,7 @@ ["." try] ["." exception]] [data + ["." product] ["." maybe] [number ["n" nat]] @@ -62,7 +62,7 @@ (is? hash (/.key-hash (/.new hash))))) (_.cover [/.entries /.keys /.values] - (\ (list.equivalence (equivalence.product n.equivalence n.equivalence)) = + (\ (list.equivalence (product.equivalence n.equivalence n.equivalence)) = (/.entries dict) (list.zip/2 (/.keys dict) (/.values dict)))) diff --git a/stdlib/source/test/lux/data/collection/list.lux b/stdlib/source/test/lux/data/collection/list.lux index 792feeabc..ffde9bcf4 100644 --- a/stdlib/source/test/lux/data/collection/list.lux +++ b/stdlib/source/test/lux/data/collection/list.lux @@ -4,7 +4,6 @@ [abstract [monad (#+ do)] ["." enum] - ["." equivalence] {[0 #spec] [/ ["$." equivalence] @@ -315,10 +314,10 @@ (and size-of-smaller-list! can-extract-values!))) (_.cover [/.zip] - (and (\ (/.equivalence (equivalence.product n.equivalence n.equivalence)) = + (and (\ (/.equivalence (product.equivalence n.equivalence n.equivalence)) = (/.zip/2 sample/0 sample/1) ((/.zip 2) sample/0 sample/1)) - (\ (/.equivalence ($_ equivalence.product n.equivalence n.equivalence n.equivalence)) = + (\ (/.equivalence ($_ product.equivalence n.equivalence n.equivalence n.equivalence)) = (/.zip/3 sample/0 sample/1 sample/2) ((/.zip 3) sample/0 sample/1 sample/2)))) diff --git a/stdlib/source/test/lux/data/collection/sequence.lux b/stdlib/source/test/lux/data/collection/sequence.lux index e24e30c58..b21741752 100644 --- a/stdlib/source/test/lux/data/collection/sequence.lux +++ b/stdlib/source/test/lux/data/collection/sequence.lux @@ -2,8 +2,6 @@ [lux #* ["_" test (#+ Test)] [abstract - [comonad (#+)] - [functor (#+)] [monad (#+ do)] [equivalence (#+ Equivalence)] ["." enum] diff --git a/stdlib/source/test/lux/data/format/json.lux b/stdlib/source/test/lux/data/format/json.lux index 61ba93d30..09f608543 100644 --- a/stdlib/source/test/lux/data/format/json.lux +++ b/stdlib/source/test/lux/data/format/json.lux @@ -31,7 +31,7 @@ {1 ["." / (#+ JSON) ("\." equivalence)]}) -(def: #export json +(def: #export random (Random /.JSON) (random.rec (function (_ recur) @@ -67,12 +67,12 @@ (_.for [/.JSON]) (`` ($_ _.and (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..json)) + ($equivalence.spec /.equivalence ..random)) (_.for [/.codec] - ($codec.spec /.equivalence /.codec ..json)) + ($codec.spec /.equivalence /.codec ..random)) (do random.monad - [sample ..json] + [sample ..random] (_.cover [/.Null /.null?] (\ bit.equivalence = (/.null? sample) @@ -80,7 +80,7 @@ #/.Null true _ false)))) (do random.monad - [expected ..json] + [expected ..random] (_.cover [/.format] (|> expected /.format @@ -147,8 +147,8 @@ [/.Boolean /.get-boolean #/.Boolean random.bit bit.equivalence] [/.Number /.get-number #/.Number random.safe-frac frac.equivalence] [/.String /.get-string #/.String (random.ascii/alpha 1) text.equivalence] - [/.Array /.get-array #/.Array (random.row 3 ..json) (row.equivalence /.equivalence)] - [/.Object /.get-object #/.Object (random.dictionary text.hash 3 (random.ascii/alpha 1) ..json) (dictionary.equivalence /.equivalence)] + [/.Array /.get-array #/.Array (random.row 3 ..random) (row.equivalence /.equivalence)] + [/.Object /.get-object #/.Object (random.dictionary text.hash 3 (random.ascii/alpha 1) ..random) (dictionary.equivalence /.equivalence)] )) (with-expansions [<boolean> (boolean) <number> (number) diff --git a/stdlib/source/test/lux/data/format/xml.lux b/stdlib/source/test/lux/data/format/xml.lux index a263b2a82..e95b843d2 100644 --- a/stdlib/source/test/lux/data/format/xml.lux +++ b/stdlib/source/test/lux/data/format/xml.lux @@ -55,16 +55,16 @@ (random.and (..text 0 10) (..text 1 10))) -(def: #export xml +(def: #export random (Random XML) - (random.rec (function (_ xml) + (random.rec (function (_ random) (random.or (..text 1 10) (do random.monad [size (..size 0 2)] ($_ random.and ..identifier (random.dictionary name.hash size ..identifier (..text 0 10)) - (random.list size xml))))))) + (random.list size random))))))) (def: #export test Test @@ -72,9 +72,9 @@ (_.for [/.XML]) ($_ _.and (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..xml)) + ($equivalence.spec /.equivalence ..random)) (_.for [/.codec] - ($codec.spec /.equivalence /.codec ..xml)) + ($codec.spec /.equivalence /.codec ..random)) (do {! random.monad} [(^@ identifier [namespace name]) ..identifier] diff --git a/stdlib/source/test/lux/data/name.lux b/stdlib/source/test/lux/data/name.lux index 904c14668..dd5238aa4 100644 --- a/stdlib/source/test/lux/data/name.lux +++ b/stdlib/source/test/lux/data/name.lux @@ -24,7 +24,7 @@ (random.filter (|>> (text.contains? ".") not) (random.unicode size))) -(def: #export (name module-size short-size) +(def: #export (random module-size short-size) (-> Nat Nat (Random Name)) (random.and (..part module-size) (..part short-size))) @@ -36,19 +36,19 @@ [## First Name sizeM1 (|> random.nat (\ ! map (n.% 100))) sizeS1 (|> random.nat (\ ! map (|>> (n.% 100) (n.max 1)))) - (^@ name1 [module1 short1]) (..name sizeM1 sizeS1) + (^@ name1 [module1 short1]) (..random sizeM1 sizeS1) ## Second Name sizeM2 (|> random.nat (\ ! map (n.% 100))) sizeS2 (|> random.nat (\ ! map (|>> (n.% 100) (n.max 1)))) - (^@ name2 [module2 short2]) (..name sizeM2 sizeS2)] + (^@ name2 [module2 short2]) (..random sizeM2 sizeS2)] (_.for [.Name] ($_ _.and (_.for [/.equivalence] - ($equivalence.spec /.equivalence (..name sizeM1 sizeS1))) + ($equivalence.spec /.equivalence (..random sizeM1 sizeS1))) (_.for [/.order] - ($order.spec /.order (..name sizeM1 sizeS1))) + ($order.spec /.order (..random sizeM1 sizeS1))) (_.for [/.codec] - (_.and ($codec.spec /.equivalence /.codec (..name sizeM1 sizeS1)) + (_.and ($codec.spec /.equivalence /.codec (..random sizeM1 sizeS1)) (let [(^open "/\.") /.codec] (_.test "Encoding an name without a module component results in text equal to the short of the name." (if (text.empty? module1) diff --git a/stdlib/source/test/lux/data/product.lux b/stdlib/source/test/lux/data/product.lux index 6e15c90b8..3c61091bb 100644 --- a/stdlib/source/test/lux/data/product.lux +++ b/stdlib/source/test/lux/data/product.lux @@ -28,6 +28,14 @@ (_.for [/.equivalence] ($equivalence.spec (/.equivalence n.equivalence i.equivalence) (random.and random.nat random.int))) + (do random.monad + [left random.int + right random.nat] + (_.cover [/.hash] + (let [hash (/.hash i.hash n.hash)] + (n.= (n.+ (\ i.hash hash left) + (\ n.hash hash right)) + (\ hash hash [left right]))))) (<| (_.cover [/.left]) (n.= expected (/.left [expected dummy]))) diff --git a/stdlib/source/test/lux/data/sum.lux b/stdlib/source/test/lux/data/sum.lux index 8dadcf272..7fbf816a1 100644 --- a/stdlib/source/test/lux/data/sum.lux +++ b/stdlib/source/test/lux/data/sum.lux @@ -11,7 +11,8 @@ [data ["." text] [number - ["n" nat]] + ["n" nat] + ["i" int]] [collection ["." list ("#\." functor)]]] [math @@ -25,75 +26,84 @@ (_.for [.|]) (do {! random.monad} [expected random.nat - shift random.nat]) - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec (/.equivalence n.equivalence n.equivalence) - (random.or random.nat random.nat))) + shift random.nat] + ($_ _.and + (_.for [/.equivalence] + ($equivalence.spec (/.equivalence n.equivalence n.equivalence) + (random.or random.nat random.nat))) + (do random.monad + [left random.int + right random.nat] + (_.cover [/.hash] + (let [hash (/.hash i.hash n.hash)] + (and (n.= (\ i.hash hash left) + (\ hash hash (#.Left left))) + (n.= (\ n.hash hash right) + (\ hash hash (#.Right right))))))) - (_.cover [/.left] - (|> (/.left expected) - (: (| Nat Nat)) - (case> (0 #0 actual) (n.= expected actual) - _ false))) - (_.cover [/.right] - (|> (/.right expected) - (: (| Nat Nat)) - (case> (0 #1 actual) (n.= expected actual) - _ false))) - (_.cover [/.either] - (and (|> (/.left expected) - (: (| Nat Nat)) - (/.either (n.+ shift) (n.- shift)) - (n.= (n.+ shift expected))) - (|> (/.right expected) - (: (| Nat Nat)) - (/.either (n.+ shift) (n.- shift)) - (n.= (n.- shift expected))))) - (_.cover [/.each] - (and (|> (/.left expected) - (: (| Nat Nat)) - (/.each (n.+ shift) (n.- shift)) - (case> (0 #0 actual) (n.= (n.+ shift expected) actual) _ false)) - (|> (/.right expected) - (: (| Nat Nat)) - (/.each (n.+ shift) (n.- shift)) - (case> (0 #1 actual) (n.= (n.- shift expected) actual) _ false)))) - (do ! - [size (\ ! map (n.% 5) random.nat) - expected (random.list size random.nat)] - ($_ _.and - (_.cover [/.lefts] - (let [actual (: (List (| Nat Nat)) - (list\map /.left expected))] - (and (\ (list.equivalence n.equivalence) = - expected - (/.lefts actual)) - (\ (list.equivalence n.equivalence) = - (list) - (/.rights actual))))) - (_.cover [/.rights] - (let [actual (: (List (| Nat Nat)) - (list\map /.right expected))] - (and (\ (list.equivalence n.equivalence) = - expected - (/.rights actual)) - (\ (list.equivalence n.equivalence) = - (list) - (/.lefts actual))))) - (_.cover [/.partition] - (let [[lefts rights] (|> expected - (list\map (function (_ value) - (if (n.even? value) - (/.left value) - (/.right value)))) - (: (List (| Nat Nat))) - /.partition)] - (and (\ (list.equivalence n.equivalence) = - (list.filter n.even? expected) - lefts) - (\ (list.equivalence n.equivalence) = - (list.filter (|>> n.even? not) expected) - rights)))) - )) - ))) + (_.cover [/.left] + (|> (/.left expected) + (: (| Nat Nat)) + (case> (0 #0 actual) (n.= expected actual) + _ false))) + (_.cover [/.right] + (|> (/.right expected) + (: (| Nat Nat)) + (case> (0 #1 actual) (n.= expected actual) + _ false))) + (_.cover [/.either] + (and (|> (/.left expected) + (: (| Nat Nat)) + (/.either (n.+ shift) (n.- shift)) + (n.= (n.+ shift expected))) + (|> (/.right expected) + (: (| Nat Nat)) + (/.either (n.+ shift) (n.- shift)) + (n.= (n.- shift expected))))) + (_.cover [/.each] + (and (|> (/.left expected) + (: (| Nat Nat)) + (/.each (n.+ shift) (n.- shift)) + (case> (0 #0 actual) (n.= (n.+ shift expected) actual) _ false)) + (|> (/.right expected) + (: (| Nat Nat)) + (/.each (n.+ shift) (n.- shift)) + (case> (0 #1 actual) (n.= (n.- shift expected) actual) _ false)))) + (do ! + [size (\ ! map (n.% 5) random.nat) + expected (random.list size random.nat)] + ($_ _.and + (_.cover [/.lefts] + (let [actual (: (List (| Nat Nat)) + (list\map /.left expected))] + (and (\ (list.equivalence n.equivalence) = + expected + (/.lefts actual)) + (\ (list.equivalence n.equivalence) = + (list) + (/.rights actual))))) + (_.cover [/.rights] + (let [actual (: (List (| Nat Nat)) + (list\map /.right expected))] + (and (\ (list.equivalence n.equivalence) = + expected + (/.rights actual)) + (\ (list.equivalence n.equivalence) = + (list) + (/.lefts actual))))) + (_.cover [/.partition] + (let [[lefts rights] (|> expected + (list\map (function (_ value) + (if (n.even? value) + (/.left value) + (/.right value)))) + (: (List (| Nat Nat))) + /.partition)] + (and (\ (list.equivalence n.equivalence) = + (list.filter n.even? expected) + lefts) + (\ (list.equivalence n.equivalence) = + (list.filter (|>> n.even? not) expected) + rights)))) + )) + )))) diff --git a/stdlib/source/test/lux/data/text.lux b/stdlib/source/test/lux/data/text.lux index 2dcd2bfa8..2cf0e2cfd 100644 --- a/stdlib/source/test/lux/data/text.lux +++ b/stdlib/source/test/lux/data/text.lux @@ -22,6 +22,7 @@ ["." / #_ ["#." buffer] ["#." encoding] + ["#." format] ["#." regex]] {1 ["." /]}) @@ -299,5 +300,6 @@ /buffer.test /encoding.test + /format.test /regex.test ))) diff --git a/stdlib/source/test/lux/data/text/format.lux b/stdlib/source/test/lux/data/text/format.lux new file mode 100644 index 000000000..a8004f919 --- /dev/null +++ b/stdlib/source/test/lux/data/text/format.lux @@ -0,0 +1,163 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)] + [equivalence (#+ Equivalence)] + [functor + {[0 #spec] + [/ + ["$." contravariant]]}]] + [control + ["." try]] + [data + ["." text ("#\." equivalence)] + ["." bit] + ["." name] + [number + ["." nat] + ["." int] + ["." rev] + ["." frac] + ["." ratio]] + [format + ["." xml] + ["." json]] + [collection + ["." list ("#\." functor)]]] + [time + ["." instant] + ["." duration] + ["." date]] + [math + ["." random (#+ Random) ("#\." monad)] + ["." modular]] + [macro + ["." code]] + [meta + ["." location]] + ["." type]] + ["$." /// #_ + [format + ["#." xml] + ["#." json]] + ["#." name] + [// + ["#." type] + [macro + ["#." code]]]] + {1 + ["." /]}) + +(structure: (equivalence example) + (All [a] (-> a (Equivalence (/.Format a)))) + + (def: (= reference subject) + (text\= (reference example) (subject example)))) + +(def: random-contravariant + (Random (Ex [a] [(/.Format a) + (Random a)])) + ($_ random.either + (random\wrap [/.bit random.bit]) + (random\wrap [/.nat random.nat]) + (random\wrap [/.int random.int]) + (random\wrap [/.rev random.rev]) + (random\wrap [/.frac random.frac]) + )) + +(def: #export test + Test + (<| (_.covering /._) + (_.for [/.Format]) + (`` ($_ _.and + (_.for [/.functor] + (do random.monad + [[format random] ..random-contravariant + example random] + ($contravariant.spec (..equivalence example) + format + /.functor))) + + (do random.monad + [left (random.unicode 5) + mid (random.unicode 5) + right (random.unicode 5)] + (_.cover [/.format] + (text\= (/.format left mid right) + ($_ "lux text concat" left mid right)))) + (~~ (template [<format> <codec> <random>] + [(do random.monad + [sample <random>] + (_.cover [<format>] + (text\= (\ <codec> encode sample) + (<format> sample))))] + + [/.bit bit.codec random.bit] + [/.nat nat.decimal random.nat] + [/.int int.decimal random.int] + [/.rev rev.decimal random.rev] + [/.frac frac.decimal random.frac] + [/.ratio ratio.codec random.ratio] + [/.name name.codec ($///name.random 5 5)] + [/.xml xml.codec $///xml.random] + [/.json json.codec $///json.random] + [/.instant instant.codec random.instant] + [/.duration duration.codec random.duration] + [/.date date.codec random.date] + + [/.nat/2 nat.binary random.nat] + [/.nat/8 nat.octal random.nat] + [/.nat/10 nat.decimal random.nat] + [/.nat/16 nat.hex random.nat] + + [/.int/2 int.binary random.int] + [/.int/8 int.octal random.int] + [/.int/10 int.decimal random.int] + [/.int/16 int.hex random.int] + + [/.rev/2 rev.binary random.rev] + [/.rev/8 rev.octal random.rev] + [/.rev/10 rev.decimal random.rev] + [/.rev/16 rev.hex random.rev] + + [/.frac/2 frac.binary random.frac] + [/.frac/8 frac.octal random.frac] + [/.frac/10 frac.decimal random.frac] + [/.frac/16 frac.hex random.frac] + )) + (~~ (template [<format> <alias> <random>] + [(do random.monad + [sample <random>] + (_.cover [<format>] + (text\= (<alias> sample) + (<format> sample))))] + + [/.text text.encode (random.unicode 5)] + [/.code code.format $///code.random] + [/.type type.format $///type.random] + [/.location location.format + ($_ random.and + (random.unicode 5) + random.nat + random.nat)] + )) + (do random.monad + [members (random.list 5 random.nat)] + (_.cover [/.list] + (text\= (/.list /.nat members) + (|> members + (list\map /.nat) + (text.join-with " ") + list + (/.list (|>>)))))) + (do {! random.monad} + [modulus (random.one (|>> modular.from-int + try.to-maybe) + random.int) + sample (\ ! map (modular.mod modulus) + random.int)] + (_.cover [/.mod] + (text\= (\ (modular.codec modulus) encode sample) + (/.mod sample)))) + )))) diff --git a/stdlib/source/test/lux/macro/syntax/common.lux b/stdlib/source/test/lux/macro/syntax/common.lux index d25fff149..998671dd5 100644 --- a/stdlib/source/test/lux/macro/syntax/common.lux +++ b/stdlib/source/test/lux/macro/syntax/common.lux @@ -5,13 +5,14 @@ ["." random (#+ Random)]] [abstract [monad (#+ do)] - ["." equivalence (#+ Equivalence)]] + [equivalence (#+ Equivalence)]] [control [pipe (#+ case>)] ["." try] ["<>" parser ["<c>" code]]] [data + ["." product] ["." bit ("#\." equivalence)] ["." name] ["." text] @@ -31,7 +32,7 @@ (def: annotations-equivalence (Equivalence /.Annotations) (list.equivalence - (equivalence.product name.equivalence + (product.equivalence name.equivalence code.equivalence))) (def: random-text @@ -111,7 +112,7 @@ /writer.declaration list (<c>.run /reader.declaration) (case> (#try.Success actual) - (let [equivalence (equivalence.product text.equivalence + (let [equivalence (product.equivalence text.equivalence (list.equivalence text.equivalence))] (\ equivalence = expected actual)) @@ -126,7 +127,7 @@ /writer.typed-input list (<c>.run /reader.typed-input) (case> (#try.Success actual) - (let [equivalence (equivalence.product code.equivalence code.equivalence)] + (let [equivalence (product.equivalence code.equivalence code.equivalence)] (\ equivalence = expected actual)) (#try.Failure error) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/variable.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/variable.lux index 225578071..5a18e6d40 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/variable.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/variable.lux @@ -23,7 +23,7 @@ ["." analysis] ["." synthesis (#+ Side Member Path Synthesis)] [/// - [reference (#+) + [reference ["." variable]]]]]}) (template: (!expect <pattern> <value>) diff --git a/stdlib/source/test/lux/type.lux b/stdlib/source/test/lux/type.lux index 08a4033c5..239e77434 100644 --- a/stdlib/source/test/lux/type.lux +++ b/stdlib/source/test/lux/type.lux @@ -30,7 +30,7 @@ (r.Random Name) (r.and ..short ..short)) -(def: #export type +(def: #export random (r.Random Type) (let [(^open "R\.") r.monad] (r.rec (function (_ recur) @@ -56,7 +56,7 @@ (<| (_.context (%.name (name-of /._))) ($_ _.and (do r.monad - [sample ..type] + [sample ..random] (_.test "Every type is equal to itself." (\ /.equivalence = sample sample))) (_.test "Can apply quantified types (universal and existential quantification)." @@ -85,7 +85,7 @@ (/.un-name aliased)))))) (do {! r.monad} [size (|> r.nat (\ ! map (n.% 3))) - members (|> ..type + members (|> ..random (r.filter (function (_ type) (case type (^or (#.Sum _) (#.Product _)) @@ -111,8 +111,8 @@ ))) (do {! r.monad} [size (|> r.nat (\ ! map (n.% 3))) - members (M.seq ! (list.repeat size ..type)) - extra (|> ..type + members (M.seq ! (list.repeat size ..random)) + extra (|> ..random (r.filter (function (_ type) (case type (^or (#.Function _) (#.Apply _)) @@ -134,7 +134,7 @@ )) (do {! r.monad} [size (|> r.nat (\ ! map (n.% 3))) - extra (|> ..type + extra (|> ..random (r.filter (function (_ type) (case type (^or (#.UnivQ _) (#.ExQ _)) |