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/apply.lux65
-rw-r--r--stdlib/source/test/lux/control/state.lux111
-rw-r--r--stdlib/source/test/lux/control/thread.lux75
3 files changed, 142 insertions, 109 deletions
diff --git a/stdlib/source/test/lux/abstract/apply.lux b/stdlib/source/test/lux/abstract/apply.lux
index 87c706f55..c53283233 100644
--- a/stdlib/source/test/lux/abstract/apply.lux
+++ b/stdlib/source/test/lux/abstract/apply.lux
@@ -3,72 +3,71 @@
[abstract/monad (#+ do)]
[data
[number
- ["n" nat]]
- [text
- ["%" format (#+ format)]]]
+ ["n" nat]]]
[control
["." function]]
[math
- ["r" random]]
+ ["." random]]
["_" test (#+ Test)]]
{1
["." / (#+ Apply)]}
[//
[functor (#+ Injection Comparison)]])
-(def: (identity injection comparison (^open "_;."))
+(def: (identity injection comparison (^open "_@."))
(All [f] (-> (Injection f) (Comparison f) (Apply f) Test))
- (do r.monad
- [sample (:: @ map injection r.nat)]
+ (do random.monad
+ [sample (:: @ map injection random.nat)]
(_.test "Identity."
((comparison n.=)
- (_;apply (injection function.identity) sample)
+ (_@apply (injection function.identity) sample)
sample))))
-(def: (homomorphism injection comparison (^open "_;."))
+(def: (homomorphism injection comparison (^open "_@."))
(All [f] (-> (Injection f) (Comparison f) (Apply 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.=)
- (_;apply (injection increase) (injection sample))
+ (_@apply (injection increase) (injection sample))
(injection (increase sample))))))
-(def: (interchange injection comparison (^open "_;."))
+(def: (interchange injection comparison (^open "_@."))
(All [f] (-> (Injection f) (Comparison f) (Apply 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 "Interchange."
((comparison n.=)
- (_;apply (injection increase) (injection sample))
- (_;apply (injection (function (_ f) (f sample))) (injection increase))))))
+ (_@apply (injection increase) (injection sample))
+ (_@apply (injection (function (_ f) (f sample))) (injection increase))))))
-(def: (composition injection comparison (^open "_;."))
+(def: (composition injection comparison (^open "_@."))
(All [f] (-> (Injection f) (Comparison f) (Apply f) Test))
- (do r.monad
- [sample r.nat
- increase (:: @ map n.+ r.nat)
- decrease (:: @ map n.- r.nat)]
+ (do random.monad
+ [sample random.nat
+ increase (:: @ map n.+ random.nat)
+ decrease (:: @ map n.- random.nat)]
(_.test "Composition."
((comparison n.=)
- (_$ _;apply
+ (_$ _@apply
(injection function.compose)
(injection increase)
(injection decrease)
(injection sample))
- ($_ _;apply
+ ($_ _@apply
(injection increase)
(injection decrease)
(injection sample))))))
(def: #export (spec injection comparison apply)
(All [f] (-> (Injection f) (Comparison f) (Apply f) Test))
- (_.context (%.name (name-of /.Apply))
- ($_ _.and
- (..identity injection comparison apply)
- (..homomorphism injection comparison apply)
- (..interchange injection comparison apply)
- (..composition injection comparison apply)
- )))
+ (<| (_.covering /._)
+ (_.with-cover [/.Apply]
+ ($_ _.and
+ (..identity injection comparison apply)
+ (..homomorphism injection comparison apply)
+ (..interchange injection comparison apply)
+ (..composition injection comparison apply)
+ ))))
diff --git a/stdlib/source/test/lux/control/state.lux b/stdlib/source/test/lux/control/state.lux
index 1d9899539..cb7c94b83 100644
--- a/stdlib/source/test/lux/control/state.lux
+++ b/stdlib/source/test/lux/control/state.lux
@@ -34,26 +34,26 @@
[state r.nat
value r.nat]
($_ _.and
- (_.test "Can get the state as a value."
- (with-conditions [state state]
- /.get))
- (_.test "Can replace the state."
- (with-conditions [state value]
- (do /.monad
- [_ (/.put value)]
- /.get)))
- (_.test "Can update the state."
- (with-conditions [state (n.* value state)]
- (do /.monad
- [_ (/.update (n.* value))]
- /.get)))
- (_.test "Can use the state."
- (with-conditions [state (inc state)]
- (/.use inc)))
- (_.test "Can use a temporary (local) state."
- (with-conditions [state (n.* value state)]
- (/.local (n.* value)
- /.get)))
+ (_.cover [/.State /.get]
+ (with-conditions [state state]
+ /.get))
+ (_.cover [/.put]
+ (with-conditions [state value]
+ (do /.monad
+ [_ (/.put value)]
+ /.get)))
+ (_.cover [/.update]
+ (with-conditions [state (n.* value state)]
+ (do /.monad
+ [_ (/.update (n.* value))]
+ /.get)))
+ (_.cover [/.use]
+ (with-conditions [state (inc state)]
+ (/.use inc)))
+ (_.cover [/.local]
+ (with-conditions [state (n.* value state)]
+ (/.local (n.* value)
+ /.get)))
)))
(def: (injection value)
@@ -72,9 +72,12 @@
[state r.nat
value r.nat]
($_ _.and
- ($functor.spec ..injection (..comparison state) /.functor)
- ($apply.spec ..injection (..comparison state) /.apply)
- ($monad.spec ..injection (..comparison state) /.monad)
+ (_.with-cover [/.functor]
+ ($functor.spec ..injection (..comparison state) /.functor))
+ (_.with-cover [/.apply]
+ ($apply.spec ..injection (..comparison state) /.apply))
+ (_.with-cover [/.monad]
+ ($monad.spec ..injection (..comparison state) /.monad))
)))
(def: loops
@@ -85,18 +88,18 @@
[state /.get]
(wrap (n.< limit state)))]]
($_ _.and
- (_.test "'while' will only execute if the condition is #1."
- (|> (/.while condition (/.update inc))
- (/.run 0)
- (let> [state' output']
- (n.= limit state'))))
- (_.test "'do-while' will execute at least once."
- (|> (/.do-while condition (/.update inc))
- (/.run 0)
- (let> [state' output']
- (or (n.= limit state')
- (and (n.= 0 limit)
- (n.= 1 state'))))))
+ (_.cover [/.while /.run]
+ (|> (/.while condition (/.update inc))
+ (/.run 0)
+ (let> [state' output']
+ (n.= limit state'))))
+ (_.cover [/.do-while]
+ (|> (/.do-while condition (/.update inc))
+ (/.run 0)
+ (let> [state' output']
+ (or (n.= limit state')
+ (and (n.= 0 limit)
+ (n.= 1 state'))))))
)))
(def: monad-transformer
@@ -105,29 +108,25 @@
[state r.nat
left r.nat
right r.nat]
- (let [(^open "io;.") io.monad]
- (_.test "Can add state functionality to any monad."
- (|> (: (/.State' io.IO Nat Nat)
- (do (/.with io.monad)
- [a (/.lift io.monad (io;wrap left))
- b (wrap right)]
- (wrap (n.+ a b))))
- (/.run' state)
- io.run
- (let> [state' output']
- (and (n.= state state')
- (n.= (n.+ left right) output')))))
+ (let [(^open "io@.") io.monad]
+ (_.cover [/.State' /.with /.lift /.run']
+ (|> (: (/.State' io.IO Nat Nat)
+ (do (/.with io.monad)
+ [a (/.lift io.monad (io@wrap left))
+ b (wrap right)]
+ (wrap (n.+ a b))))
+ (/.run' state)
+ io.run
+ (let> [state' output']
+ (and (n.= state state')
+ (n.= (n.+ left right) output')))))
)))
(def: #export test
Test
- (<| (_.context (%.name (name-of /.State)))
+ (<| (_.covering /._)
($_ _.and
- (<| (_.context "Basics.")
- ..basics)
- (<| (_.context "Structures.")
- ..structures)
- (<| (_.context "Loops.")
- ..loops)
- (<| (_.context "Monad transformer.")
- ..monad-transformer))))
+ ..basics
+ ..structures
+ ..loops
+ ..monad-transformer)))
diff --git a/stdlib/source/test/lux/control/thread.lux b/stdlib/source/test/lux/control/thread.lux
index 7d6ed0ceb..49e397d21 100644
--- a/stdlib/source/test/lux/control/thread.lux
+++ b/stdlib/source/test/lux/control/thread.lux
@@ -10,13 +10,13 @@
["$." monad]]}]
[data
[number
- ["n" nat]]
- [text
- ["%" format (#+ format)]]]
+ ["n" nat]]]
[math
- ["r" random]]]
+ ["." random]]]
{1
- ["." / (#+ Thread)]})
+ ["." / (#+ Thread)
+ [//
+ ["." io]]]})
(def: (injection value)
(Injection (All [a !] (Thread ! a)))
@@ -29,20 +29,55 @@
(def: #export test
Test
- (do r.monad
- [original r.nat
- factor r.nat]
- (<| (_.context (%.name (name-of /.Thread)))
+ (do random.monad
+ [sample random.nat
+ factor random.nat]
+ (<| (_.covering /._)
($_ _.and
- ($functor.spec ..injection ..comparison /.functor)
- ($apply.spec ..injection ..comparison /.apply)
- ($monad.spec ..injection ..comparison /.monad)
-
- (_.test "Can safely do mutation."
- (n.= (n.* factor original)
- (/.run (: (All [!] (Thread ! Nat))
- (do /.monad
- [box (/.box original)
- old (/.update (n.* factor) box)]
- (/.read box))))))
+ (_.with-cover [/.Thread]
+ ($_ _.and
+ (_.cover [/.run]
+ (n.= sample
+ (|> sample
+ (:: /.monad wrap)
+ /.run)))
+ (_.cover [/.io]
+ (n.= sample
+ (|> sample
+ (:: /.monad wrap)
+ /.io
+ io.run)))
+
+ (_.with-cover [/.functor]
+ ($functor.spec ..injection ..comparison /.functor))
+ (_.with-cover [/.apply]
+ ($apply.spec ..injection ..comparison /.apply))
+ (_.with-cover [/.monad]
+ ($monad.spec ..injection ..comparison /.monad))
+ ))
+
+ (_.with-cover [/.Box /.box]
+ ($_ _.and
+ (_.cover [/.read]
+ (n.= sample
+ (/.run (: (All [!] (Thread ! Nat))
+ (do /.monad
+ [box (/.box sample)]
+ (/.read box))))))
+
+ (_.cover [/.write]
+ (n.= factor
+ (/.run (: (All [!] (Thread ! Nat))
+ (do /.monad
+ [box (/.box sample)
+ _ (/.write factor box)]
+ (/.read box))))))
+
+ (_.cover [/.update]
+ (n.= (n.* factor sample)
+ (/.run (: (All [!] (Thread ! Nat))
+ (do /.monad
+ [box (/.box sample)
+ old (/.update (n.* factor) box)]
+ (/.read box))))))))
))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-08-28 16:58:00 +0000