diff options
Diffstat (limited to 'stdlib/source/test')
-rw-r--r-- | stdlib/source/test/lux/abstract/monoid.lux | 12 | ||||
-rw-r--r-- | stdlib/source/test/lux/control.lux | 6 | ||||
-rw-r--r-- | stdlib/source/test/lux/control/function.lux | 58 | ||||
-rw-r--r-- | stdlib/source/test/lux/control/io.lux | 10 |
4 files changed, 77 insertions, 9 deletions
diff --git a/stdlib/source/test/lux/abstract/monoid.lux b/stdlib/source/test/lux/abstract/monoid.lux index b0f89abc7..5353e29cd 100644 --- a/stdlib/source/test/lux/abstract/monoid.lux +++ b/stdlib/source/test/lux/abstract/monoid.lux @@ -4,7 +4,7 @@ ["_" test (#+ Test)] [abstract/monad (#+ do)] [math - ["r" random (#+ Random)]] + ["." random (#+ Random)]] [control ["." function]]] {1 @@ -14,12 +14,18 @@ (def: #export (spec (^open "/@.") (^open "/@.") gen-sample) (All [a] (-> (Equivalence a) (Monoid a) (Random a) Test)) - (do r.monad - [sample gen-sample] + (do random.monad + [sample gen-sample + left gen-sample + mid gen-sample + right gen-sample] (<| (_.context (%.name (name-of /.Monoid))) ($_ _.and (_.test "Left identity." (/@= sample (/@compose /@identity sample))) (_.test "Right identity." (/@= sample (/@compose sample /@identity))) + (_.test "Associativity." + (/@= (/@compose left (/@compose mid right)) + (/@compose (/@compose left mid) right))) )))) diff --git a/stdlib/source/test/lux/control.lux b/stdlib/source/test/lux/control.lux index 169332b30..3a6491f25 100644 --- a/stdlib/source/test/lux/control.lux +++ b/stdlib/source/test/lux/control.lux @@ -4,8 +4,9 @@ ["." / #_ ["#." concatenative] ["#." continuation] - ["#." try] ["#." exception] + ["#." function] + ["#." try] ["#." io] ["#." parser] ["#." pipe] @@ -63,8 +64,9 @@ ($_ _.and /concatenative.test /continuation.test - /try.test /exception.test + /function.test + /try.test /io.test /parser.test /pipe.test diff --git a/stdlib/source/test/lux/control/function.lux b/stdlib/source/test/lux/control/function.lux new file mode 100644 index 000000000..f7d4d7678 --- /dev/null +++ b/stdlib/source/test/lux/control/function.lux @@ -0,0 +1,58 @@ +(.module: + [lux #* + [abstract + [equivalence (#+ Equivalence)] + [monad (#+ do)]] + [data + ["." name] + [number + ["n" nat]] + ["." text ("#@." equivalence) + ["%" format (#+ format)]]] + [math + ["." random (#+ Random)]] + ["_" test (#+ Test)]] + ["." /// #_ + [abstract + ["#." monoid]]] + {1 + ["." /]}) + +(def: #export test + Test + (do random.monad + [expected random.nat + f0 (:: @ map n.+ random.nat) + f1 (:: @ map n.* random.nat) + dummy random.nat + extra (|> random.nat (random.filter (|>> (n.= expected) not)))] + (<| (_.context (name.module (name-of /._))) + ($_ _.and + (let [equivalence (: (Equivalence (-> Nat Nat)) + (structure + (def: (= left right) + (n.= (left extra) + (right extra))))) + generator (: (Random (-> Nat Nat)) + (:: @ map n.- random.nat))] + (///monoid.spec equivalence /.monoid generator)) + + (_.test (%.name (name-of /.identity)) + (n.= expected + (/.identity expected))) + (_.test (%.name (name-of /.compose)) + (n.= (f0 (f1 expected)) + ((/.compose f0 f1) expected))) + (_.test (%.name (name-of /.constant)) + (n.= expected + ((/.constant expected) dummy))) + (_.test (%.name (name-of /.flip)) + (let [outcome ((/.flip n.-) expected extra)] + (and (n.= (n.- extra expected) + outcome) + (not (n.= (n.- expected extra) + outcome))))) + (_.test (%.name (name-of /.apply)) + (n.= (f0 extra) + (/.apply extra f0))) + )))) diff --git a/stdlib/source/test/lux/control/io.lux b/stdlib/source/test/lux/control/io.lux index fb5d3e67b..a0e5f7d4b 100644 --- a/stdlib/source/test/lux/control/io.lux +++ b/stdlib/source/test/lux/control/io.lux @@ -11,6 +11,7 @@ ["$." apply] ["$." monad]]}] [data + ["." name] [number ["n" nat]]]] {1 @@ -29,7 +30,7 @@ (def: #export test Test - (<| (_.context (%.name (name-of /.IO))) + (<| (_.context (name.module (name-of /._))) (do r.monad [sample r.nat exit-code r.int] @@ -38,8 +39,9 @@ ($apply.spec ..injection ..comparison /.apply) ($monad.spec ..injection ..comparison /.monad) - (_.test "Can execute computations designated as I/O computations." - (n.= sample (/.run (/.io sample)))) - (_.test "I/O operations won't execute unless they are explicitly run." + (_.test (%.name (name-of /.run)) + (n.= sample + (/.run (/.io sample)))) + (_.test (%.name (name-of /.exit)) (exec (/.exit exit-code) true)))))) |