aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/test')
-rw-r--r--stdlib/source/test/lux/abstract/functor.lux84
-rw-r--r--stdlib/source/test/lux/control/concatenative.lux272
-rw-r--r--stdlib/source/test/lux/control/try.lux9
3 files changed, 211 insertions, 154 deletions
diff --git a/stdlib/source/test/lux/abstract/functor.lux b/stdlib/source/test/lux/abstract/functor.lux
index 388a66ffc..0702f00ef 100644
--- a/stdlib/source/test/lux/abstract/functor.lux
+++ b/stdlib/source/test/lux/abstract/functor.lux
@@ -2,15 +2,19 @@
[lux #*
["_" test (#+ Test)]
["%" data/text/format (#+ format)]
- ["r" math/random]
[abstract
[equivalence (#+ Equivalence)]
[monad (#+ do)]]
[control
["." function]]
[data
+ ["." maybe]
[number
- ["n" nat]]]]
+ ["n" nat]]
+ [collection
+ ["." list]]]
+ [math
+ ["." random]]]
{1
["." / (#+ Functor)]})
@@ -24,8 +28,8 @@
(def: (identity injection comparison (^open "/@."))
(All [f] (-> (Injection f) (Comparison f) (Functor f) Test))
- (do r.monad
- [sample (:: @ map injection r.nat)]
+ (do random.monad
+ [sample (:: @ map injection random.nat)]
(_.test "Identity."
((comparison n.=)
(/@map function.identity sample)
@@ -33,9 +37,9 @@
(def: (homomorphism injection comparison (^open "/@."))
(All [f] (-> (Injection f) (Comparison f) (Functor f) Test))
- (do r.monad
- [sample r.nat
- increase (:: @ map n.+ r.nat)]
+ (do random.monad
+ [sample random.nat
+ increase (:: @ map n.+ random.nat)]
(_.test "Homomorphism."
((comparison n.=)
(/@map increase (injection sample))
@@ -43,10 +47,10 @@
(def: (composition injection comparison (^open "/@."))
(All [f] (-> (Injection f) (Comparison f) (Functor f) Test))
- (do r.monad
- [sample (:: @ map injection r.nat)
- increase (:: @ map n.+ r.nat)
- decrease (:: @ map n.- r.nat)]
+ (do random.monad
+ [sample (:: @ map injection random.nat)
+ increase (:: @ map n.+ random.nat)
+ decrease (:: @ map n.- random.nat)]
(_.test "Composition."
((comparison n.=)
(|> sample (/@map increase) (/@map decrease))
@@ -54,9 +58,55 @@
(def: #export (spec injection comparison functor)
(All [f] (-> (Injection f) (Comparison f) (Functor f) Test))
- (_.context (%.name (name-of /.Functor))
- ($_ _.and
- (..identity injection comparison functor)
- (..homomorphism injection comparison functor)
- (..composition injection comparison functor)
- )))
+ (<| (_.with-cover [/.Functor])
+ ($_ _.and
+ (..identity injection comparison functor)
+ (..homomorphism injection comparison functor)
+ (..composition injection comparison functor)
+ )))
+
+(def: #export test
+ Test
+ (do random.monad
+ [left random.nat
+ right random.nat
+ shift random.nat]
+ (<| (_.covering /._)
+ ($_ _.and
+ (_.cover [/.Or /.sum]
+ (and (case (:: (/.sum maybe.functor list.functor) map
+ (n.+ shift)
+ (#.Left (#.Some left)))
+ (#.Left (#.Some actual))
+ (n.= (n.+ shift left) actual)
+
+ _
+ false)
+ (case (:: (/.sum maybe.functor list.functor) map
+ (n.+ shift)
+ (#.Right (list right)))
+ (^ (#.Right (list actual)))
+ (n.= (n.+ shift right) actual)
+
+ _
+ false)))
+ (_.cover [/.And /.product]
+ (case (:: (/.product maybe.functor list.functor) map
+ (n.+ shift)
+ [(#.Some left) (list right)])
+ (^ [(#.Some actualL) (list actualR)])
+ (and (n.= (n.+ shift left) actualL)
+ (n.= (n.+ shift right) actualR))
+
+ _
+ false))
+ (_.cover [/.Then /.compose]
+ (case (:: (/.compose maybe.functor list.functor) map
+ (n.+ shift)
+ (#.Some (list left)))
+ (^ (#.Some (list actual)))
+ (n.= (n.+ shift left) actual)
+
+ _
+ false))
+ ))))
diff --git a/stdlib/source/test/lux/control/concatenative.lux b/stdlib/source/test/lux/control/concatenative.lux
index c649128b0..6701916fc 100644
--- a/stdlib/source/test/lux/control/concatenative.lux
+++ b/stdlib/source/test/lux/control/concatenative.lux
@@ -27,70 +27,70 @@
[sample random.nat
dummy random.nat]
(`` ($_ _.and
- (_.test (%.name (name-of /.push))
- (n.= sample
- (||> (/.push sample))))
- (_.test (%.name (name-of /.drop))
- (n.= sample
- (||> (/.push sample)
- (/.push dummy)
- /.drop)))
- (_.test (%.name (name-of /.nip))
- (n.= sample
- (||> (/.push dummy)
- (/.push sample)
- /.nip)))
- (_.test (%.name (name-of /.dup))
- (||> (/.push sample)
- /.dup
- /.n/=))
- (_.test (%.name (name-of /.swap))
- (n.= sample
- (||> (/.push sample)
- (/.push dummy)
- /.swap)))
- (_.test (%.name (name-of /.rotL))
- (n.= sample
- (||> (/.push sample)
- (/.push dummy)
- (/.push dummy)
- /.rotL)))
- (_.test (%.name (name-of /.rotR))
- (n.= sample
- (||> (/.push dummy)
- (/.push sample)
- (/.push dummy)
- /.rotR)))
- (_.test (%.name (name-of /.&&))
- (let [[left right] (||> (/.push sample)
- (/.push dummy)
- /.&&)]
- (and (n.= sample left)
- (n.= dummy right))))
+ (_.cover [/.push]
+ (n.= sample
+ (||> (/.push sample))))
+ (_.cover [/.drop]
+ (n.= sample
+ (||> (/.push sample)
+ (/.push dummy)
+ /.drop)))
+ (_.cover [/.nip]
+ (n.= sample
+ (||> (/.push dummy)
+ (/.push sample)
+ /.nip)))
+ (_.cover [/.dup]
+ (||> (/.push sample)
+ /.dup
+ /.n/=))
+ (_.cover [/.swap]
+ (n.= sample
+ (||> (/.push sample)
+ (/.push dummy)
+ /.swap)))
+ (_.cover [/.rotL]
+ (n.= sample
+ (||> (/.push sample)
+ (/.push dummy)
+ (/.push dummy)
+ /.rotL)))
+ (_.cover [/.rotR]
+ (n.= sample
+ (||> (/.push dummy)
+ (/.push sample)
+ (/.push dummy)
+ /.rotR)))
+ (_.cover [/.&&]
+ (let [[left right] (||> (/.push sample)
+ (/.push dummy)
+ /.&&)]
+ (and (n.= sample left)
+ (n.= dummy right))))
(~~ (template [<function> <tag>]
- [(_.test (%.name (name-of <function>))
- ((sum.equivalence n.= n.=)
- (<tag> sample)
- (||> (/.push sample)
- <function>)))]
+ [(_.cover [<function>]
+ ((sum.equivalence n.= n.=)
+ (<tag> sample)
+ (||> (/.push sample)
+ <function>)))]
[/.||L #.Left]
[/.||R #.Right]))
- (_.test (%.name (name-of /.dip))
- (n.= (inc sample)
- (||> (/.push sample)
- (/.push dummy)
- (/.push (/.apply/1 inc))
- /.dip
- /.drop)))
- (_.test (%.name (name-of /.dip/2))
- (n.= (inc sample)
- (||> (/.push sample)
- (/.push dummy)
- (/.push dummy)
- (/.push (/.apply/1 inc))
- /.dip/2
- /.drop /.drop)))
+ (_.cover [/.dip]
+ (n.= (inc sample)
+ (||> (/.push sample)
+ (/.push dummy)
+ (/.push (/.apply/1 inc))
+ /.dip
+ /.drop)))
+ (_.cover [/.dip/2]
+ (n.= (inc sample)
+ (||> (/.push sample)
+ (/.push dummy)
+ (/.push dummy)
+ (/.push (/.apply/1 inc))
+ /.dip/2
+ /.drop /.drop)))
))))
(template: (!numerical <=> <generator> <filter> <arithmetic> <order>)
@@ -102,19 +102,19 @@
subject <generator>]
(`` ($_ _.and
(~~ (template [<concatenative> <functional>]
- [(_.test (%.name (name-of <concatenative>))
- (<=> (<functional> parameter subject)
- (||> (/.push subject)
- (/.push parameter)
- <concatenative>)))]
+ [(_.cover [<concatenative>]
+ (<=> (<functional> parameter subject)
+ (||> (/.push subject)
+ (/.push parameter)
+ <concatenative>)))]
<arithmetic>'))
(~~ (template [<concatenative> <functional>]
- [(_.test (%.name (name-of <concatenative>))
- (bit@= (<functional> parameter subject)
- (||> (/.push subject)
- (/.push parameter)
- <concatenative>)))]
+ [(_.cover [<concatenative>]
+ (bit@= (<functional> parameter subject)
+ (||> (/.push subject)
+ (/.push parameter)
+ <concatenative>)))]
<order>'))
))))))
@@ -146,67 +146,67 @@
|inc| (/.apply/1 inc)
|test| (/.apply/1 (|>> (n.- start) (n.< distance)))]]
($_ _.and
- (_.test (%.name (name-of /.call))
- (n.= (inc sample)
- (||> (/.push sample)
- (/.push (/.apply/1 inc))
- /.call)))
- (_.test (%.name (name-of /.if))
- (n.= (if choice
- (inc sample)
- (dec sample))
- (||> (/.push sample)
- (/.push choice)
- (/.push (/.apply/1 inc))
- (/.push (/.apply/1 dec))
- /.if)))
- (_.test (%.name (name-of /.loop))
- (n.= (n.+ distance start)
- (||> (/.push start)
- (/.push (|>> |inc| /.dup |test|))
- /.loop)))
- (_.test (%.name (name-of /.while))
- (n.= (n.+ distance start)
- (||> (/.push start)
- (/.push (|>> /.dup |test|))
- (/.push |inc|)
- /.while)))
- (_.test (%.name (name-of /.do))
- (n.= (inc sample)
- (||> (/.push sample)
- (/.push (|>> (/.push false)))
- (/.push |inc|)
- /.do /.while)))
- (_.test (%.name (name-of /.compose))
- (n.= (inc (inc sample))
- (||> (/.push sample)
- (/.push |inc|)
- (/.push |inc|)
- /.compose
- /.call)))
- (_.test (%.name (name-of /.curry))
- (n.= (n.+ sample sample)
- (||> (/.push sample)
- (/.push sample)
- (/.push (/.apply/2 n.+))
- /.curry
- /.call)))
- (_.test (%.name (name-of /.when))
- (n.= (if choice
- (inc sample)
- sample)
- (||> (/.push sample)
- (/.push choice)
- (/.push (/.apply/1 inc))
- /.when)))
- (_.test (%.name (name-of /.?))
- (n.= (if choice
- (inc sample)
- (dec sample))
- (||> (/.push choice)
- (/.push (inc sample))
- (/.push (dec sample))
- /.?)))
+ (_.cover [/.call]
+ (n.= (inc sample)
+ (||> (/.push sample)
+ (/.push (/.apply/1 inc))
+ /.call)))
+ (_.cover [/.if]
+ (n.= (if choice
+ (inc sample)
+ (dec sample))
+ (||> (/.push sample)
+ (/.push choice)
+ (/.push (/.apply/1 inc))
+ (/.push (/.apply/1 dec))
+ /.if)))
+ (_.cover [/.loop]
+ (n.= (n.+ distance start)
+ (||> (/.push start)
+ (/.push (|>> |inc| /.dup |test|))
+ /.loop)))
+ (_.cover [/.while]
+ (n.= (n.+ distance start)
+ (||> (/.push start)
+ (/.push (|>> /.dup |test|))
+ (/.push |inc|)
+ /.while)))
+ (_.cover [/.do]
+ (n.= (inc sample)
+ (||> (/.push sample)
+ (/.push (|>> (/.push false)))
+ (/.push |inc|)
+ /.do /.while)))
+ (_.cover [/.compose]
+ (n.= (inc (inc sample))
+ (||> (/.push sample)
+ (/.push |inc|)
+ (/.push |inc|)
+ /.compose
+ /.call)))
+ (_.cover [/.curry]
+ (n.= (n.+ sample sample)
+ (||> (/.push sample)
+ (/.push sample)
+ (/.push (/.apply/2 n.+))
+ /.curry
+ /.call)))
+ (_.cover [/.when]
+ (n.= (if choice
+ (inc sample)
+ sample)
+ (||> (/.push sample)
+ (/.push choice)
+ (/.push (/.apply/1 inc))
+ /.when)))
+ (_.cover [/.?]
+ (n.= (if choice
+ (inc sample)
+ (dec sample))
+ (||> (/.push choice)
+ (/.push (inc sample))
+ (/.push (dec sample))
+ /.?)))
)))
(word: square
@@ -219,14 +219,14 @@
Test
(do random.monad
[sample random.nat]
- (_.test (%.name (name-of /.word:))
- (n.= (n.* sample sample)
- (||> (/.push sample)
- ..square)))))
+ (_.cover [/.word:]
+ (n.= (n.* sample sample)
+ (||> (/.push sample)
+ ..square)))))
(def: #export test
Test
- (<| (_.context (name.module (name-of /._)))
+ (<| (_.covering /._)
($_ _.and
..stack-shuffling
..numerical
diff --git a/stdlib/source/test/lux/control/try.lux b/stdlib/source/test/lux/control/try.lux
index ef090c1a9..997a810ba 100644
--- a/stdlib/source/test/lux/control/try.lux
+++ b/stdlib/source/test/lux/control/try.lux
@@ -72,6 +72,14 @@
(_.cover [/.assume]
(n.= expected
(/.assume (/.succeed expected))))
+ (_.cover [/.from-maybe]
+ (case [(/.from-maybe (#.Some expected))
+ (/.from-maybe #.None)]
+ [(#/.Success actual) (#/.Failure _)]
+ (n.= expected actual)
+
+ _
+ false))
(_.cover [/.to-maybe]
(case [(/.to-maybe (/.succeed expected))
(/.to-maybe (/.fail error))]
@@ -86,7 +94,6 @@
(n.= alternative
(/.default alternative (: (Try Nat)
(/.fail error))))))
-
(_.cover [/.with /.lift]
(let [lift (/.lift io.monad)]
(|> (do (/.with io.monad)
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-27 08:17:23 +0000