diff options
Diffstat (limited to 'stdlib/source/test/lux/data')
-rw-r--r-- | stdlib/source/test/lux/data/collection/set.lux | 136 | ||||
-rw-r--r-- | stdlib/source/test/lux/data/format/json.lux | 6 | ||||
-rw-r--r-- | stdlib/source/test/lux/data/format/tar.lux | 28 | ||||
-rw-r--r-- | stdlib/source/test/lux/data/format/xml.lux | 8 | ||||
-rw-r--r-- | stdlib/source/test/lux/data/name.lux | 10 | ||||
-rw-r--r-- | stdlib/source/test/lux/data/number.lux | 29 | ||||
-rw-r--r-- | stdlib/source/test/lux/data/number/rev.lux | 18 | ||||
-rw-r--r-- | stdlib/source/test/lux/data/sum.lux | 6 | ||||
-rw-r--r-- | stdlib/source/test/lux/data/text.lux | 22 |
9 files changed, 175 insertions, 88 deletions
diff --git a/stdlib/source/test/lux/data/collection/set.lux b/stdlib/source/test/lux/data/collection/set.lux index 993082e79..93549712f 100644 --- a/stdlib/source/test/lux/data/collection/set.lux +++ b/stdlib/source/test/lux/data/collection/set.lux @@ -9,66 +9,108 @@ ["$." equivalence] ["$." monoid]]}] [data + ["." bit ("#@." equivalence)] [number ["n" nat]] [collection ["." list]]] [math - ["r" random]]] + ["." random (#+ Random)]]] {1 ["." /]}) (def: gen-nat - (r.Random Nat) - (|> r.nat - (:: r.monad map (n.% 100)))) + (Random Nat) + (:: random.monad map (n.% 100) + random.nat)) (def: #export test Test - (<| (_.context (%.name (name-of /.Set))) - (do r.monad - [size gen-nat] + (<| (_.covering /._) + (_.with-cover [/.Set]) + (let [(^open "/@.") /.equivalence]) + (do random.monad + [size ..gen-nat] ($_ _.and - ($equivalence.spec /.equivalence (r.set n.hash size r.nat)) - ($monoid.spec /.equivalence (/.monoid n.hash) (r.set n.hash size r.nat)) + (_.with-cover [/.equivalence] + ($equivalence.spec /.equivalence (random.set n.hash size random.nat))) + (_.with-cover [/.monoid] + ($monoid.spec /.equivalence (/.monoid n.hash) (random.set n.hash size random.nat))) - (do r.monad - [sizeL gen-nat - sizeR gen-nat - setL (r.set n.hash sizeL gen-nat) - setR (r.set n.hash sizeR gen-nat) - non-member (|> gen-nat - (r.filter (|>> (/.member? setL) not))) - #let [(^open "/@.") /.equivalence]] + (do random.monad + [sizeL ..gen-nat + sizeR ..gen-nat + setL (random.set n.hash sizeL random.nat) + setR (random.set n.hash sizeR random.nat) + non-memberL (random.filter (|>> (/.member? setL) not) + random.nat)] ($_ _.and - (_.test "I can query the size of a set." - (and (n.= sizeL (/.size setL)) - (n.= sizeR (/.size setR)))) - (_.test "Converting sets to/from lists can't change their values." - (|> setL - /.to-list (/.from-list n.hash) - (/@= setL))) - (_.test "Every set is a sub-set of the union of itself with another." - (let [setLR (/.union setL setR)] - (and (/.sub? setLR setL) - (/.sub? setLR setR)))) - (_.test "Every set is a super-set of the intersection of itself with another." - (let [setLR (/.intersection setL setR)] - (and (/.super? setLR setL) - (/.super? setLR setR)))) - (_.test "Union with the empty set leaves a set unchanged." - (/@= setL - (/.union (/.new n.hash) - setL))) - (_.test "Intersection with the empty set results in the empty set." - (let [empty-set (/.new n.hash)] - (/@= empty-set - (/.intersection empty-set setL)))) - (_.test "After substracting a set A from another B, no member of A can be a member of B." - (let [sub (/.difference setR setL)] - (not (list.any? (/.member? sub) (/.to-list setR))))) - (_.test "Every member of a set must be identifiable." - (and (not (/.member? setL non-member)) - (/.member? (/.add non-member setL) non-member) - (not (/.member? (/.remove non-member (/.add non-member setL)) non-member)))) + (_.cover [/.size] + (n.= sizeL (/.size setL))) + (_.cover [/.empty?] + (bit@= (/.empty? setL) + (n.= 0 (/.size setL)))) + (_.cover [/.to-list /.from-list] + (|> setL /.to-list (/.from-list n.hash) (/@= setL))) + (_.cover [/.member?] + (and (list.every? (/.member? setL) (/.to-list setL)) + (not (/.member? setL non-memberL)))) + (_.cover [/.add] + (let [before-addition! + (not (/.member? setL non-memberL)) + + after-addition! + (/.member? (/.add non-memberL setL) non-memberL) + + size-increase! + (n.= (inc (/.size setL)) + (/.size (/.add non-memberL setL)))] + (and before-addition! + after-addition!))) + (_.cover [/.remove] + (let [symmetry! + (|> setL + (/.add non-memberL) + (/.remove non-memberL) + (/@= setL)) + + idempotency! + (|> setL + (/.remove non-memberL) + (/@= setL))] + (and symmetry! + idempotency!))) + (_.cover [/.union /.sub?] + (let [setLR (/.union setL setR) + + sets-are-subs-of-their-unions! + (and (/.sub? setLR setL) + (/.sub? setLR setR)) + + union-with-empty-set! + (|> setL + (/.union (/.new n.hash)) + (/@= setL))] + (and sets-are-subs-of-their-unions! + union-with-empty-set!))) + (_.cover [/.intersection /.super?] + (let [setLR (/.intersection setL setR) + + sets-are-supers-of-their-intersections! + (and (/.super? setLR setL) + (/.super? setLR setR)) + + intersection-with-empty-set! + (|> setL + (/.intersection (/.new n.hash)) + /.empty?)] + (and sets-are-supers-of-their-intersections! + intersection-with-empty-set!))) + (_.cover [/.difference] + (let [setL+R (/.union setR setL) + setL-R (/.difference setR setL+R)] + (and (list.every? (/.member? setL+R) (/.to-list setR)) + (not (list.any? (/.member? setL-R) (/.to-list setR)))))) + (_.cover [/.predicate] + (list.every? (/.predicate setL) (/.to-list setL))) )))))) diff --git a/stdlib/source/test/lux/data/format/json.lux b/stdlib/source/test/lux/data/format/json.lux index 548dbebdd..c1341aae0 100644 --- a/stdlib/source/test/lux/data/format/json.lux +++ b/stdlib/source/test/lux/data/format/json.lux @@ -47,10 +47,10 @@ (def: #export json (Random JSON) (r.rec (function (_ recur) - (do {@ r.monad} - [size (:: @ map (n.% 2) r.nat)] + (do {! r.monad} + [size (:: ! map (n.% 2) r.nat)] ($_ r.or - (:: @ wrap []) + (:: ! wrap []) r.bit r.safe-frac (r.unicode size) diff --git a/stdlib/source/test/lux/data/format/tar.lux b/stdlib/source/test/lux/data/format/tar.lux index 17f18e005..0e274a6e6 100644 --- a/stdlib/source/test/lux/data/format/tar.lux +++ b/stdlib/source/test/lux/data/format/tar.lux @@ -35,7 +35,7 @@ (def: path Test (_.with-cover [/.Path] - (do {@ random.monad} + (do {! random.monad} [expected (random.ascii/lower-alpha /.path-size) invalid (random.ascii/lower-alpha (inc /.path-size)) not-ascii (random.text (random.char (unicode.set [unicode.katakana (list)])) @@ -68,7 +68,7 @@ (def: name Test (_.with-cover [/.Name] - (do {@ random.monad} + (do {! random.monad} [expected (random.ascii/lower-alpha /.name-size) invalid (random.ascii/lower-alpha (inc /.name-size)) not-ascii (random.text (random.char (unicode.set [unicode.katakana (list)])) @@ -101,9 +101,9 @@ (def: small Test (_.with-cover [/.Small] - (do {@ random.monad} - [expected (|> random.nat (:: @ map (n.% /.small-limit))) - invalid (|> random.nat (:: @ map (n.max /.small-limit)))] + (do {! random.monad} + [expected (|> random.nat (:: ! map (n.% /.small-limit))) + invalid (|> random.nat (:: ! map (n.max /.small-limit)))] (`` ($_ _.and (_.cover [/.small /.from-small] (case (/.small expected) @@ -125,9 +125,9 @@ (def: big Test (_.with-cover [/.Big] - (do {@ random.monad} - [expected (|> random.nat (:: @ map (n.% /.big-limit))) - invalid (|> random.nat (:: @ map (n.max /.big-limit)))] + (do {! random.monad} + [expected (|> random.nat (:: ! map (n.% /.big-limit))) + invalid (|> random.nat (:: ! map (n.max /.big-limit)))] (`` ($_ _.and (_.cover [/.big /.from-big] (case (/.big expected) @@ -150,12 +150,12 @@ (def: entry Test - (do {@ random.monad} + (do {! random.monad} [expected-path (random.ascii/lower-alpha (dec /.path-size)) - expected-moment (:: @ map (|>> (n.% 1,0,00,00,00,00,000) .int instant.from-millis) + expected-moment (:: ! map (|>> (n.% 1,0,00,00,00,00,000) .int instant.from-millis) random.nat) chunk (random.ascii/lower-alpha chunk-size) - chunks (:: @ map (n.% 100) random.nat) + chunks (:: ! map (n.% 100) random.nat) #let [content (|> chunk (list.repeat chunks) (text.join-with "") @@ -218,7 +218,7 @@ (def: random-mode (Random /.Mode) - (do {@ random.monad} + (do {! random.monad} [] (random.either (random.either (random.either (wrap /.execute-by-other) (wrap /.write-by-other)) @@ -236,7 +236,7 @@ (def: mode Test (_.with-cover [/.Mode /.mode] - (do {@ random.monad} + (do {! random.monad} [path (random.ascii/lower-alpha 10) modes (random.list 4 ..random-mode) #let [expected-mode (list@fold /.and /.none modes)]] @@ -308,7 +308,7 @@ (def: ownership Test - (do {@ random.monad} + (do {! random.monad} [path (random.ascii/lower-alpha /.path-size) expected (random.ascii/lower-alpha /.name-size) invalid (random.ascii/lower-alpha (inc /.name-size)) diff --git a/stdlib/source/test/lux/data/format/xml.lux b/stdlib/source/test/lux/data/format/xml.lux index 6cf842827..e0a1a5c05 100644 --- a/stdlib/source/test/lux/data/format/xml.lux +++ b/stdlib/source/test/lux/data/format/xml.lux @@ -35,8 +35,8 @@ (def: char (Random Nat) - (do {@ r.monad} - [idx (|> r.nat (:: @ map (n.% (text.size char-range))))] + (do {! r.monad} + [idx (|> r.nat (:: ! map (n.% (text.size char-range))))] (wrap (maybe.assume (text.nth idx char-range))))) (def: (size bottom top) @@ -73,9 +73,9 @@ ($equivalence.spec /.equivalence ..xml) ($codec.spec /.equivalence /.codec ..xml) - (do {@ r.monad} + (do {! r.monad} [text (..text 1 10) - num-children (|> r.nat (:: @ map (n.% 5))) + num-children (|> r.nat (:: ! map (n.% 5))) children (r.list num-children (..text 1 10)) tag xml-identifier^ attribute xml-identifier^ diff --git a/stdlib/source/test/lux/data/name.lux b/stdlib/source/test/lux/data/name.lux index 836f75aa1..bf5c6e876 100644 --- a/stdlib/source/test/lux/data/name.lux +++ b/stdlib/source/test/lux/data/name.lux @@ -32,14 +32,14 @@ (def: #export test Test (<| (_.covering /._) - (do {@ random.monad} + (do {! random.monad} [## First Name - sizeM1 (|> random.nat (:: @ map (n.% 100))) - sizeS1 (|> random.nat (:: @ map (|>> (n.% 100) (n.max 1)))) + sizeM1 (|> random.nat (:: ! map (n.% 100))) + sizeS1 (|> random.nat (:: ! map (|>> (n.% 100) (n.max 1)))) (^@ name1 [module1 short1]) (..name sizeM1 sizeS1) ## Second Name - sizeM2 (|> random.nat (:: @ map (n.% 100))) - sizeS2 (|> random.nat (:: @ map (|>> (n.% 100) (n.max 1)))) + sizeM2 (|> random.nat (:: ! map (n.% 100))) + sizeS2 (|> random.nat (:: ! map (|>> (n.% 100) (n.max 1)))) (^@ name2 [module2 short2]) (..name sizeM2 sizeS2)] (_.with-cover [.Name] ($_ _.and diff --git a/stdlib/source/test/lux/data/number.lux b/stdlib/source/test/lux/data/number.lux index 876cf4c4d..d8b0ad3bf 100644 --- a/stdlib/source/test/lux/data/number.lux +++ b/stdlib/source/test/lux/data/number.lux @@ -12,12 +12,38 @@ ["r" rev] ["f" frac]]]] {1 - ["." /]}) + ["." /]} + ["." / #_ + ["#." i8] + ["#." i16] + ["#." i32] + ["#." i64] + ["#." nat] + ["#." int] + ["#." rev] + ["#." frac] + ["#." ratio] + ["#." complex]]) (def: clean-commas (-> Text Text) (text.replace-all "," "")) +(def: sub + Test + ($_ _.and + /i8.test + /i16.test + /i32.test + /i64.test + /nat.test + /int.test + /rev.test + /frac.test + /ratio.test + /complex.test + )) + (def: #export test Test (<| (_.covering /._) @@ -85,4 +111,5 @@ [f.= f.hex "+dead.BEEF"] [f.= f.hex "-dead,BE.EF"] ))))) + ..sub ))) diff --git a/stdlib/source/test/lux/data/number/rev.lux b/stdlib/source/test/lux/data/number/rev.lux index dfb484fc8..90a29c6d3 100644 --- a/stdlib/source/test/lux/data/number/rev.lux +++ b/stdlib/source/test/lux/data/number/rev.lux @@ -48,4 +48,22 @@ (oct ".615,243")) (/.= (hex ".deadBEEF") (hex ".dead,BEEF")))) + (~~ (template [<half> <whole>] + [(_.cover [<half>] + (/.= <whole> + (/.+ <half> <half>)))] + + [/./2 .0] + [/./4 /./2] + [/./8 /./4] + [/./16 /./8] + [/./32 /./16] + [/./64 /./32] + [/./128 /./64] + [/./256 /./128] + [/./512 /./256] + [/./1024 /./512] + [/./2048 /./1024] + [/./4096 /./2048] + )) )))) diff --git a/stdlib/source/test/lux/data/sum.lux b/stdlib/source/test/lux/data/sum.lux index 3bbf65bc9..6a4130229 100644 --- a/stdlib/source/test/lux/data/sum.lux +++ b/stdlib/source/test/lux/data/sum.lux @@ -23,7 +23,7 @@ Test (<| (_.covering /._) (_.with-cover [.|]) - (do {@ random.monad} + (do {! random.monad} [expected random.nat shift random.nat]) ($_ _.and @@ -59,8 +59,8 @@ (: (| Nat Nat)) (/.each (n.+ shift) (n.- shift)) (case> (0 #1 actual) (n.= (n.- shift expected) actual) _ false)))) - (do @ - [size (:: @ map (n.% 5) random.nat) + (do ! + [size (:: ! map (n.% 5) random.nat) expected (random.list size random.nat)] ($_ _.and (_.cover [/.lefts] diff --git a/stdlib/source/test/lux/data/text.lux b/stdlib/source/test/lux/data/text.lux index 6fbee6ec5..5a6b2e4bb 100644 --- a/stdlib/source/test/lux/data/text.lux +++ b/stdlib/source/test/lux/data/text.lux @@ -29,8 +29,8 @@ (def: size Test - (do {@ random.monad} - [size (:: @ map (n.% 10) random.nat) + (do {! random.monad} + [size (:: ! map (n.% 10) random.nat) sample (random.unicode size)] ($_ _.and (_.cover [/.size] @@ -41,7 +41,7 @@ (def: affix Test - (do {@ random.monad} + (do {! random.monad} [inner (random.unicode 1) outer (random.filter (|>> (:: /.equivalence = inner) not) (random.unicode 1)) @@ -70,7 +70,7 @@ (def: index Test - (do {@ random.monad} + (do {! random.monad} [inner (random.unicode 1) outer (random.filter (|>> (:: /.equivalence = inner) not) (random.unicode 1)) @@ -154,11 +154,11 @@ (_.cover [/.line-feed] (:: /.equivalence = /.new-line /.line-feed)) ))) - (do {@ random.monad} - [size (:: @ map (|>> (n.% 10) inc) random.nat) + (do {! random.monad} + [size (:: ! map (|>> (n.% 10) inc) random.nat) characters (random.set /.hash size (random.ascii/alpha 1)) #let [sample (|> characters set.to-list /.concat)] - expected (:: @ map (n.% size) random.nat)] + expected (:: ! map (n.% size) random.nat)] (_.cover [/.nth] (case (/.nth expected sample) (#.Some char) @@ -186,8 +186,8 @@ (def: manipulation Test - (do {@ random.monad} - [size (:: @ map (|>> (n.% 10) (n.+ 2)) random.nat) + (do {! random.monad} + [size (:: ! map (|>> (n.% 10) (n.+ 2)) random.nat) characters (random.set /.hash size (random.ascii/alpha 1)) separator (random.filter (|>> (set.member? characters) not) (random.ascii/alpha 1)) @@ -274,13 +274,13 @@ _ #0))) )) - (do {@ random.monad} + (do {! random.monad} [sizeP bounded-size sizeL bounded-size #let [## The wider unicode charset includes control characters that ## can make text replacement work improperly. ## Because of that, I restrict the charset. - normal-char-gen (|> random.nat (:: @ map (|>> (n.% 128) (n.max 1))))] + normal-char-gen (|> random.nat (:: ! map (|>> (n.% 128) (n.max 1))))] sep1 (random.text normal-char-gen 1) sep2 (random.text normal-char-gen 1) #let [part-gen (|> (random.text normal-char-gen sizeP) |