aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test
diff options
context:
space:
mode:
authorEduardo Julian2020-10-12 20:22:31 -0400
committerEduardo Julian2020-10-12 20:22:31 -0400
commit00d5ccbc043960037f644d4ff09b6a46fd0093d0 (patch)
tree9515edc59fb511fa30e68c832d669654853ff702 /stdlib/source/test
parent5b222d040ee361dd4022e88488a6bcef3ca40a71 (diff)
Type-checking macros via the Macro' type from the standard library.
Diffstat (limited to '')
-rw-r--r--stdlib/source/test/aedifex/artifact.lux4
-rw-r--r--stdlib/source/test/aedifex/artifact/type.lux28
-rw-r--r--stdlib/source/test/lux/data/product.lux1
-rw-r--r--stdlib/source/test/lux/data/sum.lux1
-rw-r--r--stdlib/source/test/lux/data/text.lux352
-rw-r--r--stdlib/source/test/lux/target/jvm.lux21
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