aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test
diff options
context:
space:
mode:
authorEduardo Julian2020-10-15 01:01:21 -0400
committerEduardo Julian2020-10-15 01:01:21 -0400
commitc006a5fe8e82f6fc7c8cdb9db0f44c06d229f34e (patch)
treef00af06ceb7cd77ab53aa214abb2e7383dc87500 /stdlib/source/test
parent440608bc32916329c9f3c0f2bd9a8d1152ed5da8 (diff)
Re-named "to-text" functions to "format".
Diffstat (limited to 'stdlib/source/test')
-rw-r--r--stdlib/source/test/aedifex.lux2
-rw-r--r--stdlib/source/test/aedifex/hash.lux95
-rw-r--r--stdlib/source/test/lux/data/binary.lux8
-rw-r--r--stdlib/source/test/lux/data/collection/bits.lux128
-rw-r--r--stdlib/source/test/lux/macro/code.lux6
-rw-r--r--stdlib/source/test/lux/target/jvm.lux4
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))