diff options
author | Eduardo Julian | 2019-02-04 19:39:20 -0400 |
---|---|---|
committer | Eduardo Julian | 2019-02-04 19:39:20 -0400 |
commit | e3acf1b94bea5460409cbd9d7cec534f34bd9037 (patch) | |
tree | 6251d37b6e34aa33ea82d5d9814c2a0e757c96f1 /stdlib/test | |
parent | cb4beecbbc4ab3ec918ab640ffb621036707678f (diff) |
Ported "lux/io" module to new test format.
Diffstat (limited to 'stdlib/test')
-rw-r--r-- | stdlib/test/test.lux | 1 | ||||
-rw-r--r-- | stdlib/test/test/lux.lux | 9 | ||||
-rw-r--r-- | stdlib/test/test/lux/control/apply.lux | 69 | ||||
-rw-r--r-- | stdlib/test/test/lux/control/functor.lux | 56 | ||||
-rw-r--r-- | stdlib/test/test/lux/control/monad.lux | 54 | ||||
-rw-r--r-- | stdlib/test/test/lux/io.lux | 55 |
6 files changed, 220 insertions, 24 deletions
diff --git a/stdlib/test/test.lux b/stdlib/test/test.lux index 53efb1c05..a28c38ce5 100644 --- a/stdlib/test/test.lux +++ b/stdlib/test/test.lux @@ -83,7 +83,6 @@ ## TODO: Must have 100% coverage on tests. [/ ["/." lux - ## [io (#+)] ## [time ## [instant (#+)] ## [duration (#+)] diff --git a/stdlib/test/test/lux.lux b/stdlib/test/test/lux.lux index 0470be339..665a11e89 100644 --- a/stdlib/test/test/lux.lux +++ b/stdlib/test/test/lux.lux @@ -12,6 +12,7 @@ ["_" test (#+ Test)]] [/ ["/." cli] + ["/." io] ["/." host ["/." jvm]]]) @@ -232,11 +233,13 @@ ..template) (<| (_.context "Cross-platform support.") ..cross-platform-support) - (<| (_.context "/cli") + (<| (_.context "/cli Command-Line Interface.") /cli.test) - (<| (_.context "/host") + (<| (_.context "/io I/O (input/output)") + /io.test) + (<| (_.context "/host Host-platform interoperation") ($_ _.and /host.test - (<| (_.context "/jvm") + (<| (_.context "/jvm JVM (Java Virtual Machine)") /jvm.test))) )) diff --git a/stdlib/test/test/lux/control/apply.lux b/stdlib/test/test/lux/control/apply.lux new file mode 100644 index 000000000..01fb33797 --- /dev/null +++ b/stdlib/test/test/lux/control/apply.lux @@ -0,0 +1,69 @@ +(.module: + [lux #* + [control + [monad (#+ do)]] + ["." function] + [math + ["r" random]] + ["_" test (#+ Test)]] + {1 + ["." / (#+ Apply)]} + [// + [functor (#+ Injection Comparison)]]) + +(def: (identity (^open "_/.") injection comparison) + (All [f] (-> (Apply f) (Injection f) (Comparison f) Test)) + (do r.monad + [sample (:: @ map injection r.nat)] + (_.test "Identity." + ((comparison n/=) + (_/apply (injection function.identity) sample) + sample)))) + +(def: (homomorphism (^open "_/.") injection comparison) + (All [f] (-> (Apply f) (Injection f) (Comparison f) Test)) + (do r.monad + [sample r.nat + increase (:: @ map n/+ r.nat)] + (_.test "Homomorphism." + ((comparison n/=) + (_/apply (injection increase) (injection sample)) + (injection (increase sample)))))) + +(def: (interchange (^open "_/.") injection comparison) + (All [f] (-> (Apply f) (Injection f) (Comparison f) Test)) + (do r.monad + [sample r.nat + increase (:: @ map n/+ r.nat)] + (_.test "Interchange." + ((comparison n/=) + (_/apply (injection increase) (injection sample)) + (_/apply (injection (function (_ f) (f sample))) (injection increase)))))) + +(def: (composition (^open "_/.") injection comparison) + (All [f] (-> (Apply f) (Injection f) (Comparison f) Test)) + (do r.monad + [sample r.nat + increase (:: @ map n/+ r.nat) + decrease (:: @ map n/- r.nat)] + (_.test "Composition." + ((comparison n/=) + (_$ _/apply + (injection function.compose) + (injection increase) + (injection decrease) + (injection sample)) + ($_ _/apply + (injection increase) + (injection decrease) + (injection sample)))))) + +(def: #export (laws apply injection comparison) + (All [f] (-> (Apply f) (Injection f) (Comparison f) Test)) + (_.context "Apply laws." + ($_ _.and + (..identity apply injection comparison) + (..homomorphism apply injection comparison) + (..interchange apply injection comparison) + (..composition apply injection comparison) + ))) diff --git a/stdlib/test/test/lux/control/functor.lux b/stdlib/test/test/lux/control/functor.lux new file mode 100644 index 000000000..a93edc291 --- /dev/null +++ b/stdlib/test/test/lux/control/functor.lux @@ -0,0 +1,56 @@ +(.module: + [lux #* + [control + [monad (#+ do)]] + ["." function] + [math + ["r" random]] + ["_" test (#+ Test)]] + {1 + ["." / (#+ Functor)]}) + +(type: #export (Injection f) + (All [a] (-> a (f a)))) + +(type: #export (Comparison f) + (All [a] + (-> (-> a a Bit) + (-> (f a) (f a) Bit)))) + +(def: (identity (^open "_/.") injection comparison) + (All [f] (-> (Functor f) (Injection f) (Comparison f) Test)) + (do r.monad + [sample (:: @ map injection r.nat)] + (_.test "Identity." + ((comparison n/=) + (_/map function.identity sample) + sample)))) + +(def: (homomorphism (^open "_/.") injection comparison) + (All [f] (-> (Functor f) (Injection f) (Comparison f) Test)) + (do r.monad + [sample r.nat + increase (:: @ map n/+ r.nat)] + (_.test "Homomorphism." + ((comparison n/=) + (_/map increase (injection sample)) + (injection (increase sample)))))) + +(def: (composition (^open "_/.") injection comparison) + (All [f] (-> (Functor f) (Injection f) (Comparison f) Test)) + (do r.monad + [sample (:: @ map injection r.nat) + increase (:: @ map n/+ r.nat) + decrease (:: @ map n/- r.nat)] + (_.test "Composition." + ((comparison n/=) + (|> sample (_/map increase) (_/map decrease)) + (|> sample (_/map (|>> increase decrease))))))) + +(def: #export (laws functor injection comparison) + (All [f] (-> (Functor f) (Injection f) (Comparison f) Test)) + (_.context "Functor laws." + ($_ _.and + (..identity functor injection comparison) + (..homomorphism functor injection comparison) + (..composition functor injection comparison)))) diff --git a/stdlib/test/test/lux/control/monad.lux b/stdlib/test/test/lux/control/monad.lux new file mode 100644 index 000000000..412f3ab94 --- /dev/null +++ b/stdlib/test/test/lux/control/monad.lux @@ -0,0 +1,54 @@ +(.module: + [lux #* + ["." function] + [math + ["r" random]] + ["_" test (#+ Test)]] + {1 + ["." / (#+ Monad do)]} + [// + [functor (#+ Injection Comparison)]]) + +(def: (left-identity (^open "_/.") injection comparison) + (All [f] (-> (Monad f) (Injection f) (Comparison f) Test)) + (do r.monad + [sample r.nat + morphism (:: @ map (function (_ diff) + (|>> (n/+ diff) _/wrap)) + r.nat)] + (_.test "Left identity." + ((comparison n/=) + (|> (injection sample) (_/map morphism) _/join) + (morphism sample))))) + +(def: (right-identity (^open "_/.") injection comparison) + (All [f] (-> (Monad f) (Injection f) (Comparison f) Test)) + (do r.monad + [sample r.nat] + (_.test "Right identity." + ((comparison n/=) + (|> (injection sample) (_/map _/wrap) _/join) + (injection sample))))) + +(def: (associativity (^open "_/.") injection comparison) + (All [f] (-> (Monad f) (Injection f) (Comparison f) Test)) + (do r.monad + [sample r.nat + increase (:: @ map (function (_ diff) + (|>> (n/+ diff) _/wrap)) + r.nat) + decrease (:: @ map (function (_ diff) + (|>> (n/- diff) _/wrap)) + r.nat)] + (_.test "Associativity." + ((comparison n/=) + (|> (injection sample) (_/map increase) _/join (_/map decrease) _/join) + (|> (injection sample) (_/map (|>> increase (_/map decrease) _/join)) _/join))))) + +(def: #export (laws monad injection comparison) + (All [f] (-> (Monad f) (Injection f) (Comparison f) Test)) + (_.context "Monad laws." + ($_ _.and + (..left-identity monad injection comparison) + (..right-identity monad injection comparison) + (..associativity monad injection comparison)))) diff --git a/stdlib/test/test/lux/io.lux b/stdlib/test/test/lux/io.lux index 86143fe27..a14a240cb 100644 --- a/stdlib/test/test/lux/io.lux +++ b/stdlib/test/test/lux/io.lux @@ -1,24 +1,39 @@ (.module: [lux #* - ["&" io] [control - ["M" monad (#+ do Monad)]] - [data - [number] - [text ("text/." equivalence) - format]]] - lux/test) + [monad (#+ do)] + {[0 #test] + [/ + [".T" functor (#+ Injection Comparison)] + [".T" apply] + [".T" monad]]}] + ["." function] + [math + ["r" random]] + ["_" test (#+ Test)]] + {1 + ["." / (#+ IO)]}) -(context: "I/O" - ($_ seq - (test "" (text/= "YOLO" (&.run (&.io "YOLO")))) - (test "" (i/= +11 (&.run (:: &.functor map inc (&.io +10))))) - (test "" (i/= +10 (&.run (:: &.monad wrap +10)))) - (test "" (i/= +30 (&.run (let [(^open "&/.") &.apply - (^open "&/.") &.monad] - (&/apply (&/wrap (i/+ +10)) (&/wrap +20)))))) - (test "" (i/= +30 (&.run (do &.monad - [f (wrap i/+) - x (wrap +10) - y (wrap +20)] - (wrap (f x y)))))))) +(def: injection + (Injection IO) + (|>> /.io)) + +(def: comparison + (Comparison IO) + (function (_ == left right) + (== (/.run left) (/.run right)))) + +(def: #export test + Test + (do r.monad + [sample r.nat + exit-code r.int] + ($_ _.and + (_.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." + (exec (/.exit exit-code) + true)) + (functorT.laws /.functor ..injection ..comparison) + (applyT.laws /.apply ..injection ..comparison) + (monadT.laws /.monad ..injection ..comparison)))) |