diff options
Diffstat (limited to 'stdlib/source/test')
| -rw-r--r-- | stdlib/source/test/aedifex/artifact.lux | 4 | ||||
| -rw-r--r-- | stdlib/source/test/aedifex/artifact/type.lux | 28 | ||||
| -rw-r--r-- | stdlib/source/test/lux/data/product.lux | 1 | ||||
| -rw-r--r-- | stdlib/source/test/lux/data/sum.lux | 1 | ||||
| -rw-r--r-- | stdlib/source/test/lux/data/text.lux | 352 | ||||
| -rw-r--r-- | stdlib/source/test/lux/target/jvm.lux | 21 |
6 files changed, 301 insertions, 106 deletions
diff --git a/stdlib/source/test/aedifex/artifact.lux b/stdlib/source/test/aedifex/artifact.lux index 1ba27d0b6..72715fdef 100644 --- a/stdlib/source/test/aedifex/artifact.lux +++ b/stdlib/source/test/aedifex/artifact.lux @@ -9,6 +9,8 @@ ["$." equivalence]]}] [math ["." random (#+ Random)]]] + ["." / #_ + ["#." type]] {#program ["." /]}) @@ -27,4 +29,6 @@ ($_ _.and (_.with-cover [/.equivalence] ($equivalence.spec /.equivalence ..random)) + + /type.test )))) diff --git a/stdlib/source/test/aedifex/artifact/type.lux b/stdlib/source/test/aedifex/artifact/type.lux new file mode 100644 index 000000000..fd815f19e --- /dev/null +++ b/stdlib/source/test/aedifex/artifact/type.lux @@ -0,0 +1,28 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)]] + [data + ["." text] + [number + ["n" nat]] + [collection + ["." set] + ["." list]]] + [math + ["." random (#+ Random)]]] + {#program + ["." /]}) + +(def: #export test + Test + (<| (_.covering /._) + (_.with-cover [/.Type] + ($_ _.and + (_.cover [/.lux-library /.jvm-library /.pom] + (let [options (list /.lux-library /.jvm-library /.pom) + uniques (set.from-list text.hash options)] + (n.= (list.size options) + (set.size uniques)))) + )))) diff --git a/stdlib/source/test/lux/data/product.lux b/stdlib/source/test/lux/data/product.lux index 20e62ef86..74057ad63 100644 --- a/stdlib/source/test/lux/data/product.lux +++ b/stdlib/source/test/lux/data/product.lux @@ -18,6 +18,7 @@ (def: #export test Test (<| (_.covering /._) + (_.with-cover [.&]) (do random.monad [expected random.nat shift random.nat diff --git a/stdlib/source/test/lux/data/sum.lux b/stdlib/source/test/lux/data/sum.lux index 972677361..3bbf65bc9 100644 --- a/stdlib/source/test/lux/data/sum.lux +++ b/stdlib/source/test/lux/data/sum.lux @@ -22,6 +22,7 @@ (def: #export test Test (<| (_.covering /._) + (_.with-cover [.|]) (do {@ random.monad} [expected random.nat shift random.nat]) diff --git a/stdlib/source/test/lux/data/text.lux b/stdlib/source/test/lux/data/text.lux index a1a0ec7b1..6fbee6ec5 100644 --- a/stdlib/source/test/lux/data/text.lux +++ b/stdlib/source/test/lux/data/text.lux @@ -1,137 +1,295 @@ (.module: - [lux #* - ["%" data/text/format (#+ format)] + [lux (#- char) ["_" test (#+ Test)] [abstract - [monad (#+ do Monad)] + [monad (#+ do)] {[0 #spec] [/ ["$." equivalence] - ["$." order]]}] + ["$." order] + ["$." monoid]]}] [control pipe] [data + ["." maybe] [number ["n" nat]] [collection - ["." list]]] + ["." list] + ["." set]]] [math - ["r" random]]] + ["." random]]] {1 ["." /]}) (def: bounded-size - (r.Random Nat) - (|> r.nat - (:: r.monad map (|>> (n.% 20) (n.+ 1))))) + (random.Random Nat) + (|> random.nat + (:: random.monad map (|>> (n.% 20) (n.+ 1))))) -(def: #export test +(def: size Test - (<| (_.context (%.name (name-of .Text))) - ($_ _.and - ($equivalence.spec /.equivalence (r.ascii 2)) - ($order.spec /.order (r.ascii 2)) + (do {@ random.monad} + [size (:: @ map (n.% 10) random.nat) + sample (random.unicode size)] + ($_ _.and + (_.cover [/.size] + (n.= size (/.size sample))) + (_.cover [/.empty?] + (or (/.empty? sample) + (not (n.= 0 size))))))) - (do {@ r.monad} - [size (:: @ map (n.% 10) r.nat) - sample (r.unicode size)] - ($_ _.and - (_.test "Can get the size of text." - (n.= size (/.size sample))) - (_.test "Text with size 0 is considered 'empty'." - (or (not (n.= 0 size)) - (/.empty? sample))))) - (do {@ r.monad} - [size bounded-size - idx (:: @ map (n.% size) r.nat) - sample (r.unicode size)] - (_.test "Character locations." - (|> sample - (/.nth idx) - (case> (^multi (#.Some char) - [(/.from-code char) char] - [[(/.index-of char sample) - (/.last-index-of char sample) - (/.index-of' char idx sample) - (/.last-index-of' char idx sample)] - [(#.Some io) (#.Some lio) - (#.Some io') (#.Some lio')]]) - (and (n.<= idx io) - (n.>= idx lio) +(def: affix + Test + (do {@ random.monad} + [inner (random.unicode 1) + outer (random.filter (|>> (:: /.equivalence = inner) not) + (random.unicode 1)) + left (random.unicode 1) + right (random.unicode 1) + #let [full (:: /.monoid compose inner outer) + fake-index (.nat -1)]] + (`` ($_ _.and + (~~ (template [<affix> <predicate>] + [(_.cover [<affix> <predicate>] + (<predicate> outer (<affix> outer inner)))] + + [/.prefix /.starts-with?] + [/.suffix /.ends-with?] + [/.enclose' /.encloses?] + )) + (_.cover [/.enclose] + (let [value (/.enclose [left right] inner)] + (and (/.starts-with? left value) + (/.ends-with? right value)))) + (_.cover [/.encode] + (let [sample (/.encode inner)] + (and (/.encloses? /.double-quote sample) + (/.contains? inner sample)))) + )))) + +(def: index + Test + (do {@ random.monad} + [inner (random.unicode 1) + outer (random.filter (|>> (:: /.equivalence = inner) not) + (random.unicode 1)) + #let [fake-index (.nat -1)]] + ($_ _.and + (_.cover [/.contains?] + (let [full (:: /.monoid compose inner outer)] + (and (/.contains? inner full) + (/.contains? outer full)))) + (_.cover [/.index-of] + (and (|> (/.index-of inner (:: /.monoid compose inner outer)) + (maybe.default fake-index) + (n.= 0)) + (|> (/.index-of outer (:: /.monoid compose inner outer)) + (maybe.default fake-index) + (n.= 1)))) + (_.cover [/.index-of'] + (let [full (:: /.monoid compose inner outer)] + (and (|> (/.index-of' inner 0 full) + (maybe.default fake-index) + (n.= 0)) + (|> (/.index-of' inner 1 full) + (maybe.default fake-index) + (n.= fake-index)) + + (|> (/.index-of' outer 0 full) + (maybe.default fake-index) + (n.= 1)) + (|> (/.index-of' outer 1 full) + (maybe.default fake-index) + (n.= 1)) + (|> (/.index-of' outer 2 full) + (maybe.default fake-index) + (n.= fake-index))))) + (_.cover [/.last-index-of] + (let [full ($_ (:: /.monoid compose) outer inner outer)] + (and (|> (/.last-index-of inner full) + (maybe.default fake-index) + (n.= 1)) + (|> (/.last-index-of outer full) + (maybe.default fake-index) + (n.= 2))))) + (_.cover [/.last-index-of'] + (let [full ($_ (:: /.monoid compose) outer inner outer)] + (and (|> (/.last-index-of' inner 0 full) + (maybe.default fake-index) + (n.= 1)) + (|> (/.last-index-of' inner 2 full) + (maybe.default fake-index) + (n.= fake-index)) + + (|> (/.last-index-of' outer 0 full) + (maybe.default fake-index) + (n.= 2)) + (|> (/.last-index-of' outer 2 full) + (maybe.default fake-index) + (n.= 2)) + (|> (/.last-index-of' outer 3 full) + (maybe.default fake-index) + (n.= fake-index))))) + ))) + +(def: char + Test + ($_ _.and + (_.with-cover [/.Char /.from-code] + (`` ($_ _.and + (~~ (template [<short> <long>] + [(_.cover [<short> <long>] + (:: /.equivalence = <short> <long>))] - (n.= idx io') - (n.>= idx lio') + [/.\0 /.null] + [/.\a /.alarm] + [/.\b /.back-space] + [/.\t /.tab] + [/.\n /.new-line] + [/.\v /.vertical-tab] + [/.\f /.form-feed] + [/.\r /.carriage-return] + [/.\'' /.double-quote])) + (_.cover [/.line-feed] + (:: /.equivalence = /.new-line /.line-feed)) + ))) + (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)] + (_.cover [/.nth] + (case (/.nth expected sample) + (#.Some char) + (case (/.index-of (/.from-code char) sample) + (#.Some actual) + (n.= expected actual) - (/.contains? char sample)) + _ + false) + + #.None + false))) + (_.cover [/.space /.space?] + (`` (and (~~ (template [<char>] + [(/.space? (`` (.char (~~ (static <char>)))))] + + [/.tab] + [/.vertical-tab] + [/.space] + [/.new-line] + [/.carriage-return] + [/.form-feed] + ))))) + )) - _ - #0 - )) - )) - (do r.monad +(def: manipulation + Test + (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)) + #let [with-no-separator (|> characters set.to-list /.concat)] + static (random.ascii/alpha 1) + #let [dynamic (random.filter (|>> (:: /.equivalence = static) not) + (random.ascii/alpha 1))] + pre dynamic + post dynamic] + ($_ _.and + (_.cover [/.concat] + (n.= (set.size characters) + (/.size (/.concat (set.to-list characters))))) + (_.cover [/.join-with /.split-all-with] + (and (|> (set.to-list characters) + (/.join-with separator) + (/.split-all-with separator) + (set.from-list /.hash) + (:: set.equivalence = characters)) + (:: /.equivalence = + (/.concat (set.to-list characters)) + (/.join-with "" (set.to-list characters))))) + (_.cover [/.replace-once] + (:: /.equivalence = + (:: /.monoid compose post static) + (/.replace-once pre post (:: /.monoid compose pre static)))) + (_.cover [/.split-with] + (case (/.split-with static ($_ (:: /.monoid compose) pre static post)) + (#.Some [left right]) + (and (:: /.equivalence = pre left) + (:: /.equivalence = post right)) + + #.None + false)) + ))) + +(def: #export test + Test + (<| (_.covering /._) + (_.with-cover [.Text]) + ($_ _.and + (_.with-cover [/.equivalence] + ($equivalence.spec /.equivalence (random.ascii 2))) + (_.with-cover [/.order] + ($order.spec /.order (random.ascii 2))) + (_.with-cover [/.monoid] + ($monoid.spec /.equivalence /.monoid (random.ascii 2))) + + ..size + ..affix + ..index + ..char + ..manipulation + + (do random.monad [sizeL bounded-size sizeR bounded-size - sampleL (r.unicode sizeL) - sampleR (r.unicode sizeR) + sampleL (random.unicode sizeL) + sampleR (random.unicode sizeR) + middle (random.unicode 1) #let [sample (/.concat (list sampleL sampleR)) (^open "/@.") /.equivalence]] ($_ _.and - (_.test "Can join text snippets." - (and (not (/@= sample - (/.join-with " " (list sampleL sampleR)))) - (/@= sample - (/.join-with "" (list sampleL sampleR))))) - (_.test "Can check sub-texts at the borders." - (and (/.starts-with? sampleL sample) - (/.ends-with? sampleR sample))) - (_.test "Can enclose text in another texts." - (/@= (/.enclose [sampleR sampleR] sampleL) - (/.enclose' sampleR sampleL))) - (_.test "Can split text." - (|> (/.split sizeL sample) - (case> (#.Right [_l _r]) - (and (/@= sampleL _l) - (/@= sampleR _r) - (/@= sample (/.concat (list _l _r)))) + (_.cover [/.split] + (|> (/.split sizeL sample) + (case> (#.Right [_l _r]) + (and (/@= sampleL _l) + (/@= sampleR _r) + (/@= sample (/.concat (list _l _r)))) - _ - #0))) - (_.test "Can clip text." - (|> [(/.clip 0 sizeL sample) - (/.clip sizeL (/.size sample) sample) - (/.clip' sizeL sample) - (/.clip' 0 sample)] - (case> [(#.Right _l) (#.Right _r) (#.Right _r') (#.Right _f)] - (and (/@= sampleL _l) - (/@= sampleR _r) - (/@= _r _r') - (/@= sample _f)) + _ + #0))) + (_.cover [/.clip /.clip'] + (|> [(/.clip 0 sizeL sample) + (/.clip sizeL (/.size sample) sample) + (/.clip' sizeL sample) + (/.clip' 0 sample)] + (case> [(#.Right _l) (#.Right _r) (#.Right _r') (#.Right _f)] + (and (/@= sampleL _l) + (/@= sampleR _r) + (/@= _r _r') + (/@= sample _f)) - _ - #0))) + _ + #0))) )) - (do {@ r.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 (|> r.nat (:: @ map (|>> (n.% 128) (n.max 1))))] - sep1 (r.text normal-char-gen 1) - sep2 (r.text normal-char-gen 1) - #let [part-gen (|> (r.text normal-char-gen sizeP) - (r.filter (|>> (/.contains? sep1) not)))] - parts (r.list sizeL part-gen) + 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) + (random.filter (|>> (/.contains? sep1) not)))] + parts (random.list sizeL part-gen) #let [sample1 (/.concat (list.interpose sep1 parts)) sample2 (/.concat (list.interpose sep2 parts)) (^open "/@.") /.equivalence]] - ($_ _.and - (_.test "Can split text multiple times through a separator." - (n.= (list.size parts) - (list.size (/.split-all-with sep1 sample1)))) - - (_.test "Can replace occurrences of a piece of text inside a larger text." - (/@= sample2 - (/.replace-all sep1 sep2 sample1))) - )) + (_.cover [/.replace-all] + (/@= sample2 + (/.replace-all sep1 sep2 sample1)))) ))) diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux index b9639a82f..e1c4dbfe3 100644 --- a/stdlib/source/test/lux/target/jvm.lux +++ b/stdlib/source/test/lux/target/jvm.lux @@ -237,6 +237,11 @@ #random ..$Float::random #literal ..$Float::literal}) +(def: valid-float + (Random java/lang/Float) + (random.filter (|>> host.float-to-double (:coerce Frac) f.not-a-number? not) + ..$Float::random)) + (def: $Double (/type.class "java.lang.Double" (list))) (def: $Double::wrap (/.invokestatic ..$Double "valueOf" (/type.method [(list /type.double) ..$Double (list)]))) (def: $Double::random (:coerce (Random java/lang/Double) random.frac)) @@ -678,10 +683,8 @@ comparison (: (-> (Bytecode Any) (-> java/lang/Double java/lang/Double Bit) (Random Bit)) (function (_ instruction standard) (do random.monad - [#let [valid-double (random.filter (|>> (:coerce Frac) f.not-a-number? not) - ..$Double::random)] - reference valid-double - subject valid-double + [reference ..valid-double + subject ..valid-double #let [expected (if (for {@.old ("jvm deq" reference subject) @@ -1184,15 +1187,15 @@ (let [test (!::= java/lang/Float "jvm feq" "jvm float =")] ($_ _.and (_.lift "FSTORE_0/FLOAD_0" - (store-and-load ..$Float::random ..$Float::literal ..$Float::wrap [(function.constant /.fstore-0) (function.constant /.fload-0)] test)) + (store-and-load ..valid-float ..$Float::literal ..$Float::wrap [(function.constant /.fstore-0) (function.constant /.fload-0)] test)) (_.lift "FSTORE_1/FLOAD_1" - (store-and-load ..$Float::random ..$Float::literal ..$Float::wrap [(function.constant /.fstore-1) (function.constant /.fload-1)] test)) + (store-and-load ..valid-float ..$Float::literal ..$Float::wrap [(function.constant /.fstore-1) (function.constant /.fload-1)] test)) (_.lift "FSTORE_2/FLOAD_2" - (store-and-load ..$Float::random ..$Float::literal ..$Float::wrap [(function.constant /.fstore-2) (function.constant /.fload-2)] test)) + (store-and-load ..valid-float ..$Float::literal ..$Float::wrap [(function.constant /.fstore-2) (function.constant /.fload-2)] test)) (_.lift "FSTORE_3/FLOAD_3" - (store-and-load ..$Float::random ..$Float::literal ..$Float::wrap [(function.constant /.fstore-3) (function.constant /.fload-3)] test)) + (store-and-load ..valid-float ..$Float::literal ..$Float::wrap [(function.constant /.fstore-3) (function.constant /.fload-3)] test)) (_.lift "FSTORE/FLOAD" - (store-and-load ..$Float::random ..$Float::literal ..$Float::wrap [/.fstore /.fload] test))))) + (store-and-load ..valid-float ..$Float::literal ..$Float::wrap [/.fstore /.fload] test))))) (<| (_.context "double") (let [test (!::= java/lang/Double "jvm deq" "jvm double =")] ($_ _.and |