diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/test/lux.lux | 89 | ||||
| -rw-r--r-- | stdlib/source/test/lux/abstract.lux | 2 | ||||
| -rw-r--r-- | stdlib/source/test/lux/abstract/monoid.lux | 44 | ||||
| -rw-r--r-- | stdlib/source/test/lux/control/concurrency/actor.lux | 2 | ||||
| -rw-r--r-- | stdlib/source/test/lux/control/concurrency/frp.lux | 34 | ||||
| -rw-r--r-- | stdlib/source/test/lux/control/concurrency/promise.lux | 202 |
6 files changed, 253 insertions, 120 deletions
diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index c03076d26..c43c2abf4 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -13,7 +13,7 @@ [predicate (#+ Predicate)]] [control ["." io (#+ io)] - ["." function + [function [mixin (#+)]] [parser [cli (#+ program:)]]] @@ -49,28 +49,37 @@ [php (#+)] [common-lisp (#+)] [scheme (#+)]] - [tool - [compiler - [phase - [generation - [jvm (#+) - <host-modules>] - [js (#+) - <host-modules>] - [python (#+) - <host-modules>] - [lua (#+) - <host-modules>] - [ruby (#+) - <host-modules>] - [php (#+) - <host-modules>] - [common-lisp (#+) - <host-modules>] - [scheme (#+) - <host-modules>]]]]] + ## [tool + ## [compiler + ## [language + ## [lux + ## [phase + ## [generation + ## [jvm (#+) + ## <host-modules>] + ## [js (#+) + ## <host-modules>] + ## [python (#+) + ## <host-modules>] + ## [lua (#+) + ## <host-modules>] + ## [ruby (#+) + ## <host-modules>] + ## ## [php (#+) + ## ## <host-modules>] + ## ## [common-lisp (#+) + ## ## <host-modules>] + ## ## [scheme (#+) + ## ## <host-modules>] + ## ] + ## [extension + ## [generation + ## [jvm (#+)] + ## [js (#+)] + ## [python (#+)] + ## [lua (#+)] + ## [ruby (#+)]]]]]]]] ## [control - ## ["._" concatenative] ## ["._" predicate] ## [function ## ["._" contract]] @@ -131,7 +140,7 @@ ["#." macro] ["#." math] ["#." time] - ["#." tool] + ## ["#." tool] ["#." type] ["#." world] ["#." host] @@ -154,8 +163,6 @@ ($_ _.and (_.test "Every value is identical to itself." (is? self self)) - (_.test "The identity function doesn't change values in any way." - (is? self (function.identity self))) (do @ [other (random.unicode 1)] (_.test "Values created separately can't be identical." @@ -357,27 +364,23 @@ ..templates) (<| (_.context "Cross-platform support.") ..cross-platform-support))) - (!bundle ($_ _.and - /abstract.test - /control.test - /data.test - /macro.test - /math.test)) - (!bundle ($_ _.and - /time.test - /tool.test - /type.test - /world.test)) - (!bundle ($_ _.and - /host.test - /extension.test - ($_ _.and - /target/jvm.test))) + (_.in-parallel (list /abstract.test + /control.test + /data.test + /macro.test + /math.test + /time.test + ## /tool.test + /type.test + /world.test + /host.test + /extension.test + /target/jvm.test + )) ))) (program: args (<| io _.run! - ## (_.times 100) - (_.seed 8070500311708372420) + (_.times 100) ..test)) diff --git a/stdlib/source/test/lux/abstract.lux b/stdlib/source/test/lux/abstract.lux index 4becb6344..b9aa18c9c 100644 --- a/stdlib/source/test/lux/abstract.lux +++ b/stdlib/source/test/lux/abstract.lux @@ -9,6 +9,7 @@ ["#." functor] ["#." interval] ["#." monad] + ["#." monoid] ["#." order] ["#." predicate]]) @@ -22,6 +23,7 @@ /functor.test /interval.test /monad.test + /monoid.test /order.test /predicate.test )) diff --git a/stdlib/source/test/lux/abstract/monoid.lux b/stdlib/source/test/lux/abstract/monoid.lux index 5353e29cd..e1271ed2f 100644 --- a/stdlib/source/test/lux/abstract/monoid.lux +++ b/stdlib/source/test/lux/abstract/monoid.lux @@ -1,31 +1,55 @@ (.module: [lux #* - ["%" data/text/format (#+ format)] ["_" test (#+ Test)] - [abstract/monad (#+ do)] - [math - ["." random (#+ Random)]] + [abstract + [monad (#+ do)]] [control - ["." function]]] + ["." function]] + [data + [number + ["." nat] + ["." int]]] + [math + ["." random (#+ Random)]]] {1 - ["." / (#+ Monoid) + ["." / [// [equivalence (#+ Equivalence)]]]}) (def: #export (spec (^open "/@.") (^open "/@.") gen-sample) - (All [a] (-> (Equivalence a) (Monoid a) (Random a) Test)) + (All [a] (-> (Equivalence a) (/.Monoid a) (Random a) Test)) (do random.monad [sample gen-sample left gen-sample mid gen-sample right gen-sample] - (<| (_.context (%.name (name-of /.Monoid))) + (<| (_.with-cover [/.Monoid]) ($_ _.and (_.test "Left identity." - (/@= sample (/@compose /@identity sample))) + (/@= sample + (/@compose /@identity sample))) (_.test "Right identity." - (/@= sample (/@compose sample /@identity))) + (/@= sample + (/@compose sample /@identity))) (_.test "Associativity." (/@= (/@compose left (/@compose mid right)) (/@compose (/@compose left mid) right))) )))) + +(def: #export test + Test + (do random.monad + [natL random.nat + natR random.nat + intL random.int + intR random.int] + (<| (_.covering /._) + ($_ _.and + (_.cover [/.compose] + (let [[natLR intLR] (:: (/.compose nat.addition int.multiplication) compose + [natL intL] [natR intR])] + (and (nat.= (:: nat.addition compose natL natR) + natLR) + (int.= (:: int.multiplication compose intL intR) + intLR)))) + )))) diff --git a/stdlib/source/test/lux/control/concurrency/actor.lux b/stdlib/source/test/lux/control/concurrency/actor.lux index 741b848cb..fe9362b07 100644 --- a/stdlib/source/test/lux/control/concurrency/actor.lux +++ b/stdlib/source/test/lux/control/concurrency/actor.lux @@ -91,7 +91,7 @@ (promise.future (write cause)))} write) _ (/.poison actor)] - (io.io (promise.poll read))))] + (promise.poll read)))] (_.claim [/.poisoned] (case result (#.Some error) diff --git a/stdlib/source/test/lux/control/concurrency/frp.lux b/stdlib/source/test/lux/control/concurrency/frp.lux index 8752a195f..e6c8c179d 100644 --- a/stdlib/source/test/lux/control/concurrency/frp.lux +++ b/stdlib/source/test/lux/control/concurrency/frp.lux @@ -34,14 +34,17 @@ (def: comparison (Comparison /.Channel) (function (_ == left right) - (case [(promise.poll left) - (promise.poll right)] - [(#.Some (#.Some [left _])) - (#.Some (#.Some [right _]))] - (== left right) - - _ - false))) + (io.run + (do io.monad + [?left (promise.poll left) + ?right (promise.poll right)] + (wrap (case [?left ?right] + [(#.Some (#.Some [left _])) + (#.Some (#.Some [right _]))] + (== left right) + + _ + false)))))) (def: #export test Test @@ -72,12 +75,15 @@ _ (:: sink close)] (wrap channel))) (#try.Success channel) - (case (promise.poll channel) - (#.Some (#.Some [actual _])) - (n.= sample actual) - - _ - false) + (io.run + (do io.monad + [?actual (promise.poll channel)] + (wrap (case ?actual + (#.Some (#.Some [actual _])) + (n.= sample actual) + + _ + false)))) (#try.Failure error) false)) diff --git a/stdlib/source/test/lux/control/concurrency/promise.lux b/stdlib/source/test/lux/control/concurrency/promise.lux index 5b412e212..3e2d8982b 100644 --- a/stdlib/source/test/lux/control/concurrency/promise.lux +++ b/stdlib/source/test/lux/control/concurrency/promise.lux @@ -1,73 +1,171 @@ (.module: [lux #* ["_" test (#+ Test)] - [abstract/monad (#+ do)] + [abstract + [monad (#+ do)] + {[0 #test] + [/ + ["$." functor (#+ Injection Comparison)] + ["$." apply] + ["$." monad]]}] [control - pipe + [pipe (#+ case>)] ["." io]] - ["%" data/text/format (#+ format)] + [data + [number + ["n" nat] + ["i" int]]] + [time + ["." instant] + ["." duration]] [math - ["r" random]]] + ["." random]]] {1 - ["." / ("#@." monad)]}) + ["." / + [// + ["." atom (#+ Atom)]]]}) + +(def: injection + (Injection /.Promise) + /.resolved) + +(def: comparison + (Comparison /.Promise) + (function (_ == left right) + (io.run + (do io.monad + [?left (/.poll left) + ?right (/.poll right)] + (wrap (case [?left ?right] + [(#.Some left) + (#.Some right)] + (== left right) + + _ + false)))))) (def: #export test Test - (do r.monad - [_ (wrap [])] - (<| (_.context (%.name (name-of /.Promise))) + (<| (_.covering /._) + (do random.monad + [to-wait (|> random.nat (:: @ map (|>> (n.% 100) (n.max 10)))) + #let [extra-time (n.* 2 to-wait)] + expected random.nat + dummy random.nat + #let [not-dummy (|> random.nat (random.filter (|>> (n.= dummy) not)))] + leftE not-dummy + rightE not-dummy] ($_ _.and + (_.with-cover [/.functor] + ($functor.spec ..injection ..comparison /.functor)) + (_.with-cover [/.apply] + ($apply.spec ..injection ..comparison /.apply)) + (_.with-cover [/.monad] + ($monad.spec ..injection ..comparison /.monad)) + (wrap (do /.monad - [running? (/.future (io.io #1))] - (_.assert "Can run IO actions in separate threads." - running?))) - + [#let [[promise resolver] (: [(/.Promise Nat) (/.Resolver Nat)] + (/.promise []))] + resolved? (/.future (resolver expected)) + actual promise] + (_.claim [/.Promise /.Resolver /.promise] + (and resolved? + (n.= expected actual))))) (wrap (do /.monad - [_ (/.wait 500)] - (_.assert "Can wait for a specified amount of time." - #1))) - + [actual (/.resolved expected)] + (_.claim [/.resolved] + (n.= expected actual)))) (wrap (do /.monad - [[left right] (/.and (/.future (io.io #1)) - (/.future (io.io #0)))] - (_.assert "Can combine promises sequentially." - (and left (not right))))) - + [actual (/.future (io.io expected))] + (_.claim [/.future] + (n.= expected actual)))) (wrap (do /.monad - [?left (/.or (/.delay 100 #1) - (/.delay 200 #0)) - ?right (/.or (/.delay 200 #1) - (/.delay 100 #0))] - (_.assert "Can combine promises alternatively." - (case [?left ?right] - [(#.Left #1) (#.Right #0)] - #1 - - _ - #0)))) - + [pre (/.future instant.now) + actual (/.schedule to-wait (io.io expected)) + post (/.future instant.now)] + (_.claim [/.schedule] + (and (n.= expected actual) + (i.>= (.int to-wait) + (duration.to-millis (instant.span pre post))))))) (wrap (do /.monad - [?left (/.either (/.delay 100 #1) - (/.delay 200 #0)) - ?right (/.either (/.delay 200 #1) - (/.delay 100 #0))] - (_.assert "Can combine promises alternatively [Part 2]." - (and ?left (not ?right))))) + [pre (/.future instant.now) + _ (/.wait to-wait) + post (/.future instant.now)] + (_.claim [/.wait] + (i.>= (.int to-wait) + (duration.to-millis (instant.span pre post)))))) + (wrap (do /.monad + [[leftA rightA] (/.and (/.future (io.io leftE)) + (/.future (io.io rightE)))] + (_.claim [/.and] + (n.= (n.+ leftE rightE) + (n.+ leftA rightA))))) + (wrap (do /.monad + [pre (/.future instant.now) + actual (/.delay to-wait expected) + post (/.future instant.now)] + (_.claim [/.delay] + (and (n.= expected actual) + (i.>= (.int to-wait) + (duration.to-millis (instant.span pre post))))))) + (wrap (do /.monad + [?left (/.or (/.delay 10 leftE) + (/.delay 20 dummy)) + ?right (/.or (/.delay 20 dummy) + (/.delay 10 rightE))] + (_.claim [/.or] + (case [?left ?right] + [(#.Left leftA) (#.Right rightA)] + (n.= (n.+ leftE rightE) + (n.+ leftA rightA)) - (_.test "Can poll a promise for its value." - (and (|> (/.poll (/@wrap #1)) - (case> (#.Some #1) #1 _ #0)) - (|> (/.poll (/.delay 200 #1)) - (case> #.None #1 _ #0)))) + _ + false)))) + (wrap (do /.monad + [leftA (/.either (/.delay 10 leftE) + (/.delay 20 dummy)) + rightA (/.either (/.delay 20 dummy) + (/.delay 10 rightE))] + (_.claim [/.either] + (n.= (n.+ leftE rightE) + (n.+ leftA rightA))))) + (wrap (do /.monad + [?actual (/.future (/.poll (/.resolved expected))) + #let [[promise resolver] (: [(/.Promise Nat) (/.Resolver Nat)] + (/.promise []))] + ?never (/.future (/.poll promise))] + (_.claim [/.poll] + (case [?actual ?never] + [(#.Some actual) #.None] + (n.= expected actual) + _ + false)))) + (wrap (do /.monad + [yep (/.future (/.resolved? (/.resolved expected))) + #let [[promise resolver] (: [(/.Promise Nat) (/.Resolver Nat)] + (/.promise []))] + nope (/.future (/.resolved? promise))] + (_.claim [/.resolved?] + (and yep + (not nope))))) (wrap (do /.monad - [?none (/.time-out 100 (/.delay 200 #1)) - ?some (/.time-out 200 (/.delay 100 #1))] - (_.assert "Can establish maximum waiting times for promises to be fulfilled." - (case [?none ?some] - [#.None (#.Some #1)] - #1 + [?none (/.time-out to-wait (/.delay extra-time dummy)) + ?actual (/.time-out extra-time (/.delay to-wait expected))] + (_.claim [/.time-out] + (case [?none ?actual] + [#.None (#.Some actual)] + (n.= expected actual) - _ - #0)))) + _ + false)))) + (wrap (do /.monad + [#let [box (: (Atom Nat) + (atom.atom dummy))] + _ (/.future (/.await (function (_ value) + (atom.write value box)) + (/.resolved expected))) + actual (/.future (atom.read box))] + (_.claim [/.await] + (n.= expected actual)))) )))) |