diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/test/aedifex.lux | 2 | ||||
| -rw-r--r-- | stdlib/source/test/aedifex/hash.lux | 95 | ||||
| -rw-r--r-- | stdlib/source/test/lux/data/binary.lux | 8 | ||||
| -rw-r--r-- | stdlib/source/test/lux/data/collection/bits.lux | 128 | ||||
| -rw-r--r-- | stdlib/source/test/lux/macro/code.lux | 6 | ||||
| -rw-r--r-- | stdlib/source/test/lux/target/jvm.lux | 4 |
6 files changed, 175 insertions, 68 deletions
diff --git a/stdlib/source/test/aedifex.lux b/stdlib/source/test/aedifex.lux index 48ecc9189..c496eb88b 100644 --- a/stdlib/source/test/aedifex.lux +++ b/stdlib/source/test/aedifex.lux @@ -10,6 +10,7 @@ ["#." profile] ["#." project] ["#." cli] + ["#." hash] ["#." parser]]) (def: test @@ -19,6 +20,7 @@ /profile.test /project.test /cli.test + /hash.test /parser.test )) diff --git a/stdlib/source/test/aedifex/hash.lux b/stdlib/source/test/aedifex/hash.lux new file mode 100644 index 000000000..21e318be6 --- /dev/null +++ b/stdlib/source/test/aedifex/hash.lux @@ -0,0 +1,95 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)] + {[0 #spec] + [/ + ["$." equivalence] + ["$." codec]]}] + [control + ["." try] + ["." exception]] + [data + ["." binary (#+ Binary)] + [number + ["n" nat]] + [text + ["%" format (#+ format)]]] + [math + ["." random (#+ Random)]]] + {#program + ["." /]} + [test + [lux + [data + ["_." binary]]]]) + +(def: (random hash) + (All [h] + (-> (-> Binary (/.Hash h)) + (Random (/.Hash h)))) + (do {@ random.monad} + [size (:: @ map (n.% 100) random.nat)] + (:: @ map hash (_binary.random size)))) + +(def: #export test + Test + (<| (_.covering /._) + (_.with-cover [/.Hash /.SHA-1 /.MD5]) + (`` ($_ _.and + (_.with-cover [/.equivalence] + ($_ _.and + ($equivalence.spec /.equivalence (..random /.sha1)) + ($equivalence.spec /.equivalence (..random /.md5)) + )) + (_.with-cover [/.data] + ($_ _.and + (~~ (template [<hash> <constructor> <exception>] + [(do random.monad + [expected (..random <hash>)] + (_.cover [<hash> <constructor> <exception>] + (and (case (<constructor> (/.data expected)) + (#try.Success actual) + (:: /.equivalence = expected actual) + + (#try.Failure error) + false) + (case (<constructor> (:: binary.monoid compose + (/.data expected) + (/.data expected))) + (#try.Success actual) + false + + (#try.Failure error) + (exception.match? <exception> error)))))] + + [/.sha1 /.as-sha1 /.not-a-sha1] + [/.md5 /.as-md5 /.not-a-md5] + )))) + (~~ (template [<codec> <hash>] + [(_.with-cover [<codec>] + ($codec.spec /.equivalence <codec> (..random <hash>)))] + + [/.sha1-codec /.sha1] + [/.md5-codec /.md5] + )) + (_.with-cover [/.not-a-hash] + ($_ _.and + (~~ (template [<codec> <hash>] + [(do random.monad + [expected (..random <hash>)] + (_.cover [<codec>] + (case (:: <codec> decode + (format (:: <codec> encode expected) + "AABBCC")) + (#try.Success actual) + false + + (#try.Failure error) + (exception.match? /.not-a-hash error))))] + + [/.sha1-codec /.sha1] + [/.md5-codec /.md5] + )))) + )))) diff --git a/stdlib/source/test/lux/data/binary.lux b/stdlib/source/test/lux/data/binary.lux index 17f773206..c011df720 100644 --- a/stdlib/source/test/lux/data/binary.lux +++ b/stdlib/source/test/lux/data/binary.lux @@ -31,7 +31,7 @@ (#try.Success output) output)) -(def: #export (binary size) +(def: #export (random size) (-> Nat (Random Binary)) (let [output (/.create size)] (loop [idx 0] @@ -80,7 +80,7 @@ (do {@ random.monad} [#let [gen-size (|> random.nat (:: @ map (|>> (n.% 100) (n.max 8))))] size gen-size - sample (..binary size) + sample (..random size) value random.nat #let [gen-idx (|> random.nat (:: @ map (n.% size)))] [from to] (random.and gen-idx gen-idx) @@ -88,9 +88,9 @@ (_.with-cover [/.Binary] ($_ _.and (_.with-cover [/.equivalence] - ($equivalence.spec /.equivalence (..binary size))) + ($equivalence.spec /.equivalence (..random size))) (_.with-cover [/.monoid] - ($monoid.spec /.equivalence /.monoid (..binary size))) + ($monoid.spec /.equivalence /.monoid (..random size))) (_.cover [/.fold] (n.= (:: list.fold fold n.+ 0 (..as-list sample)) (/.fold n.+ 0 sample))) diff --git a/stdlib/source/test/lux/data/collection/bits.lux b/stdlib/source/test/lux/data/collection/bits.lux index 59d7e3443..166ced163 100644 --- a/stdlib/source/test/lux/data/collection/bits.lux +++ b/stdlib/source/test/lux/data/collection/bits.lux @@ -1,6 +1,5 @@ (.module: [lux #* - ["%" data/text/format (#+ format)] ["_" test (#+ Test)] [abstract [monad (#+ do)] @@ -12,74 +11,85 @@ [number ["n" nat]]] [math - ["r" random (#+ Random)]]] + ["." random (#+ Random)]]] {1 ["." / (#+ Bits)]}) (def: (size min max) (-> Nat Nat (Random Nat)) - (|> r.nat - (:: r.monad map (|>> (n.% max) (n.max min))))) + (|> random.nat + (:: random.monad map (|>> (n.% (inc max)) (n.max min))))) -(def: #export bits +(def: #export random (Random Bits) - (do {@ r.monad} - [size (size 1 1,000) - idx (|> r.nat (:: @ map (n.% size)))] - (wrap (|> /.empty (/.set idx))))) + (do {@ random.monad} + [size (:: @ map (n.% 1,000) random.nat)] + (case size + 0 (wrap /.empty) + _ (do {@ random.monad} + [idx (|> random.nat (:: @ map (n.% size)))] + (wrap (/.set idx /.empty)))))) (def: #export test Test - (<| (_.context (%.name (name-of /._))) + (<| (_.covering /._) + (_.with-cover [/.Bits]) ($_ _.and - ($equivalence.spec /.equivalence ..bits) - (do {@ r.monad} - [size (size 1 1,000) - idx (|> r.nat (:: @ map (n.% size))) - sample bits] + (_.with-cover [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + + (do random.monad + [sample ..random] + (_.cover [/.empty? /.size] + (if (/.empty? sample) + (n.= 0 (/.size sample)) + (n.> 0 (/.size sample))))) + (_.cover [/.empty] + (/.empty? /.empty)) + + (do {@ random.monad} + [size (:: @ map (|>> (n.% 1,000) inc) random.nat) + idx (:: @ map (n.% size) random.nat) + sample ..random] ($_ _.and - (_.test "Can set individual bits." - (and (|> /.empty (/.get idx) not) - (|> /.empty (/.set idx) (/.get idx)))) - (_.test "Can clear individual bits." - (|> /.empty (/.set idx) (/.clear idx) (/.get idx) not)) - (_.test "Can flip individual bits." - (and (|> /.empty (/.flip idx) (/.get idx)) - (|> /.empty (/.flip idx) (/.flip idx) (/.get idx) not))) - (_.test "Bits (only) grow when (and as much as) necessary." - (and (n.= 0 (/.capacity /.empty)) - (|> /.empty (/.set idx) /.capacity - (n.- idx) - (predicate.unite (n.>= 0) - (n.< /.chunk-size))))) - (_.test "Bits (must) shrink when (and as much as) possible." - (let [grown (/.flip idx /.empty)] - (and (n.> 0 (/.capacity grown)) - (is? /.empty (/.flip idx grown))))) - (_.test "Intersection can be detected when there are set bits in common." - (and (not (/.intersects? /.empty - /.empty)) - (/.intersects? (/.set idx /.empty) - (/.set idx /.empty)) - (not (/.intersects? (/.set (inc idx) /.empty) - (/.set idx /.empty))))) - (_.test "Cannot intersect with one's opposite." - (not (/.intersects? sample (/.not sample)))) - (_.test "'and' with oneself changes nothing" - (:: /.equivalence = sample (/.and sample sample))) - (_.test "'and' with one's opposite yields the empty bit-set." - (is? /.empty (/.and sample (/.not sample)))) - - (_.test "'or' with one's opposite fully saturates a bit-set." - (n.= (/.size (/.or sample (/.not sample))) - (/.capacity sample))) - (_.test "'xor' with oneself yields the empty bit-set." - (is? /.empty (/.xor sample sample))) - (_.test "'xor' with one's opposite fully saturates a bit-set." - (n.= (/.size (/.xor sample (/.not sample))) - (/.capacity sample))) - (_.test "Double negation results in original bit-set." - (:: /.equivalence = sample (/.not (/.not sample)))) - (_.test "Negation does not affect the empty bit-set." - (is? /.empty (/.not /.empty))) + (_.cover [/.get /.set] + (and (|> /.empty (/.get idx) not) + (|> /.empty (/.set idx) (/.get idx)))) + (_.cover [/.clear] + (|> /.empty (/.set idx) (/.clear idx) (/.get idx) not)) + (_.cover [/.flip] + (and (|> /.empty (/.flip idx) (/.get idx)) + (|> /.empty (/.flip idx) (/.flip idx) (/.get idx) not))) + (_.cover [/.Chunk /.capacity /.chunk-size] + (and (n.= 0 (/.capacity /.empty)) + (|> /.empty (/.set idx) /.capacity + (n.- idx) + (predicate.unite (n.>= 0) + (n.< /.chunk-size))) + (let [grown (/.flip idx /.empty)] + (and (n.> 0 (/.capacity grown)) + (is? /.empty (/.flip idx grown)))))) + (_.cover [/.intersects?] + (and (not (/.intersects? /.empty + /.empty)) + (/.intersects? (/.set idx /.empty) + (/.set idx /.empty)) + (not (/.intersects? (/.set (inc idx) /.empty) + (/.set idx /.empty))) + (not (/.intersects? sample (/.not sample))))) + (_.cover [/.not] + (and (not (:: /.equivalence = sample (/.not sample))) + (:: /.equivalence = sample (/.not (/.not sample))) + (is? /.empty (/.not /.empty)))) + (_.cover [/.xor] + (and (is? /.empty (/.xor sample sample)) + (n.= (/.size (/.xor sample (/.not sample))) + (/.capacity sample)))) + (_.cover [/.or] + (and (:: /.equivalence = sample (/.or sample sample)) + (n.= (/.size (/.or sample (/.not sample))) + (/.capacity sample)))) + (_.cover [/.and] + (and (:: /.equivalence = sample (/.and sample sample)) + (is? /.empty (/.and sample (/.not sample))))) ))))) diff --git a/stdlib/source/test/lux/macro/code.lux b/stdlib/source/test/lux/macro/code.lux index 717d4be94..9b85a557c 100644 --- a/stdlib/source/test/lux/macro/code.lux +++ b/stdlib/source/test/lux/macro/code.lux @@ -119,13 +119,13 @@ ($_ _.and (_.with-cover [/.equivalence] ($equivalence.spec /.equivalence ..random)) - (_.with-cover [/.to-text] + (_.with-cover [/.format] (`` ($_ _.and (~~ (template [<coverage> <random> <tag>] [(do {@ random.monad} [expected <random>] (_.cover [<coverage>] - (and (case (..read (/.to-text (<coverage> expected))) + (and (case (..read (/.format (<coverage> expected))) (#try.Success actual) (:: /.equivalence = actual @@ -152,7 +152,7 @@ [(do {@ random.monad} [expected <random>] (_.cover [<coverage>] - (and (case (..read (/.to-text (<coverage> expected))) + (and (case (..read (/.format (<coverage> expected))) (#try.Success actual) (:: /.equivalence = actual diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux index 7df1cdd07..4eefd9e03 100644 --- a/stdlib/source/test/lux/target/jvm.lux +++ b/stdlib/source/test/lux/target/jvm.lux @@ -982,7 +982,7 @@ @.jvm (|>> (:coerce java/lang/Long) "jvm object cast" ("jvm long =" ("jvm object cast" (:coerce java/lang/Long expected))))})))) (_.context "float" - (array (/.newarray /instruction.t-float) $Float::random $Float::literal [/.fastore /.faload $Float::wrap] + (array (/.newarray /instruction.t-float) ..valid-float $Float::literal [/.fastore /.faload $Float::wrap] (function (_ expected) (for {@.old (|>> (:coerce java/lang/Float) ("jvm feq" expected)) @@ -990,7 +990,7 @@ @.jvm (|>> (:coerce java/lang/Float) "jvm object cast" ("jvm float =" ("jvm object cast" (:coerce java/lang/Float expected))))})))) (_.context "double" - (array (/.newarray /instruction.t-double) $Double::random $Double::literal [/.dastore /.daload $Double::wrap] + (array (/.newarray /instruction.t-double) ..valid-double $Double::literal [/.dastore /.daload $Double::wrap] (function (_ expected) (for {@.old (|>> (:coerce java/lang/Double) ("jvm deq" expected)) |