diff options
Diffstat (limited to 'stdlib/source/test')
| -rw-r--r-- | stdlib/source/test/lux/abstract/order.lux | 14 | ||||
| -rw-r--r-- | stdlib/source/test/lux/control/concurrency/atom.lux | 49 | ||||
| -rw-r--r-- | stdlib/source/test/lux/control/concurrency/frp.lux | 227 | ||||
| -rw-r--r-- | stdlib/source/test/lux/control/state.lux | 29 |
4 files changed, 239 insertions, 80 deletions
diff --git a/stdlib/source/test/lux/abstract/order.lux b/stdlib/source/test/lux/abstract/order.lux index a92dd06ad..7157a6c01 100644 --- a/stdlib/source/test/lux/abstract/order.lux +++ b/stdlib/source/test/lux/abstract/order.lux @@ -4,6 +4,7 @@ [abstract [monad (#+ do)]] [data + ["." bit ("#@." equivalence)] [number ["n" nat]]] [math @@ -21,6 +22,19 @@ (_.cover [/.Choice /.min /.max] (n.< (/.max n.order left right) (/.min n.order left right))) + (_.cover [/.Comparison /.>] + (not (bit@= (n.< left right) + (/.> n.order left right)))) + (_.cover [/.<=] + (and (/.<= n.order left left) + (/.<= n.order right right) + (bit@= (:: n.order < left right) + (/.<= n.order left right)))) + (_.cover [/.>=] + (and (/.>= n.order left left) + (/.>= n.order right right) + (bit@= (/.> n.order left right) + (/.>= n.order left right)))) ))) (def: #export (spec (^open "/@.") generator) diff --git a/stdlib/source/test/lux/control/concurrency/atom.lux b/stdlib/source/test/lux/control/concurrency/atom.lux index 1cf645530..8902f0a8f 100644 --- a/stdlib/source/test/lux/control/concurrency/atom.lux +++ b/stdlib/source/test/lux/control/concurrency/atom.lux @@ -1,39 +1,40 @@ (.module: [lux #* ["_" test (#+ Test)] - [abstract/monad (#+ do)] - ["%" data/text/format (#+ format)] - [math - ["r" random]] + [abstract + [monad (#+ do)]] [control ["." io]] [data [number - ["n" nat]]]] + ["n" nat]]] + [math + ["." random]]] {1 ["." /]}) (def: #export test Test - (<| (_.context (%.name (name-of /.Atom))) - (do r.monad - [value r.nat - swap-value r.nat - set-value r.nat + (<| (_.covering /._) + (do random.monad + [value random.nat + swap-value random.nat + set-value random.nat #let [box (/.atom value)]] ($_ _.and - (_.test "Can obtain the value of an atom." - (n.= value (io.run (/.read box)))) - - (_.test "Can swap the value of an atom." - (and (io.run (/.compare-and-swap value swap-value box)) - (n.= swap-value (io.run (/.read box))))) - - (_.test "Can update the value of an atom." - (exec (io.run (/.update inc box)) - (n.= (inc swap-value) (io.run (/.read box))))) - - (_.test "Can immediately set the value of an atom." - (exec (io.run (/.write set-value box)) - (n.= set-value (io.run (/.read box))))) + (_.cover [/.Atom /.atom /.read] + (n.= value + (io.run (/.read box)))) + (_.cover [/.compare-and-swap] + (and (io.run (/.compare-and-swap value swap-value box)) + (n.= swap-value + (io.run (/.read box))))) + (_.cover [/.update] + (exec (io.run (/.update inc box)) + (n.= (inc swap-value) + (io.run (/.read box))))) + (_.cover [/.write] + (exec (io.run (/.write set-value box)) + (n.= set-value + (io.run (/.read box))))) )))) diff --git a/stdlib/source/test/lux/control/concurrency/frp.lux b/stdlib/source/test/lux/control/concurrency/frp.lux index ab705bfce..f7f7427b6 100644 --- a/stdlib/source/test/lux/control/concurrency/frp.lux +++ b/stdlib/source/test/lux/control/concurrency/frp.lux @@ -1,59 +1,202 @@ (.module: [lux #* ["_" test (#+ Test)] - [abstract/monad (#+ do)] + [abstract + [monad (#+ do)] + {[0 #test] + [/ + ["$." functor (#+ Injection Comparison)] + ["$." apply] + ["$." monad]]}] [control + ["." try] + ["." exception] ["." io (#+ IO io)]] [data + [text + ["%" format (#+ format)]] [number ["n" nat]] [collection - ["." list ("#@." functor)]]] + ["." list ("#@." functor fold)] + ["." row (#+ Row)]]] [math - ["r" random]]] + ["." random]]] {1 - ["." / (#+ Channel) + ["." / [// ["." promise ("#@." monad)] ["." atom (#+ Atom atom)]]]}) +(def: injection + (Injection /.Channel) + (|>> promise.resolved + /.from-promise)) + +(def: comparison + (Comparison /.Channel) + (function (_ == left right) + (case [(promise.poll left) + (promise.poll right)] + [(#.Some (#.Some [left _])) + (#.Some (#.Some [right _]))] + (== left right) + + _ + false))) + (def: #export test Test - (let [(^open "list@.") (list.equivalence n.equivalence)] - (do r.monad - [inputs (r.list 5 r.nat) - sample r.nat] - ($_ _.and - (wrap (do promise.monad - [output (|> inputs - (/.sequential 0) - (/.filter n.even?) - /.consume)] - (_.assert "Can filter a channel's elements." - (list@= (list.filter n.even? inputs) - output)))) - (wrap (do promise.monad - [output (|> inputs - (/.sequential 0) - (:: /.functor map inc) - /.consume)] - (_.assert "Functor goes over every element in a channel." - (list@= (list@map inc inputs) - output)))) - (wrap (do promise.monad - [output (/.consume (:: /.apply apply - (/.sequential 0 (list inc)) - (/.sequential 0 (list sample))))] - (_.assert "Apply works over all channel values." - (list@= (list (inc sample)) - output)))) - (wrap (do promise.monad - [output (/.consume - (do /.monad - [f (/.from-promise (promise@wrap inc)) - a (/.from-promise (promise@wrap sample))] - (wrap (f a))))] - (_.assert "Valid monad." - (list@= (list (inc sample)) - output)))) - )))) + (<| (_.covering /._) + (let [(^open "list@.") (list.equivalence n.equivalence)] + (do random.monad + [inputs (random.list 5 random.nat) + sample random.nat + distint/0 random.nat + distint/1 (|> random.nat (random.filter (|>> (n.= distint/0) not))) + distint/2 (|> random.nat (random.filter (function (_ value) + (not (or (n.= distint/0 value) + (n.= distint/1 value)))))) + shift random.nat] + ($_ _.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)) + + (_.cover [/.Channel /.Sink /.channel] + (case (io.run + (do (try.with io.monad) + [#let [[channel sink] (/.channel [])] + _ (:: sink feed sample) + _ (:: sink close)] + (wrap channel))) + (#try.Success channel) + (case (promise.poll channel) + (#.Some (#.Some [actual _])) + (n.= sample actual) + + _ + false) + + (#try.Failure error) + false)) + (_.cover [/.channel-is-already-closed] + (case (io.run + (do (try.with io.monad) + [#let [[channel sink] (/.channel [])] + _ (:: sink close)] + (:: sink feed sample))) + (#try.Success _) + false + + (#try.Failure error) + (exception.match? /.channel-is-already-closed error))) + (wrap (do promise.monad + [output (|> sample + promise.resolved + /.from-promise + /.consume)] + (_.claim [/.from-promise /.consume] + (list@= (list sample) + output)))) + (wrap (do promise.monad + [output (|> inputs + (/.sequential 0) + /.consume)] + (_.claim [/.sequential] + (list@= inputs + output)))) + (wrap (do promise.monad + [output (|> inputs + (/.sequential 0) + (/.filter n.even?) + /.consume)] + (_.claim [/.filter] + (list@= (list.filter n.even? inputs) + output)))) + (wrap (do promise.monad + [#let [sink (: (Atom (Row Nat)) + (atom.atom row.empty)) + channel (/.sequential 0 inputs)] + _ (promise.future (/.listen (function (_ value) + (do io.monad + [_ (atom.update (row.add value) sink)] + (wrap []))) + channel)) + output (/.consume channel) + listened (|> sink + atom.read + promise.future + (:: @ map row.to-list))] + (_.claim [/.listen] + (and (list@= inputs + output) + (list@= output + listened))))) + (wrap (do promise.monad + [actual (/.fold (function (_ input total) + (promise.resolved (n.+ input total))) + 0 + (/.sequential 0 inputs))] + (_.claim [/.fold] + (n.= (list@fold n.+ 0 inputs) + actual)))) + (wrap (do promise.monad + [actual (|> inputs + (/.sequential 0) + (/.folds (function (_ input total) + (promise.resolved (n.+ input total))) + 0) + /.consume)] + (_.claim [/.folds] + (list@= (list.folds n.+ 0 inputs) + actual)))) + (wrap (do promise.monad + [actual (|> (list distint/0 distint/0 distint/0 + distint/1 + distint/2 distint/2) + (/.sequential 0) + (/.distinct n.equivalence) + /.consume)] + (_.claim [/.distinct] + (list@= (list distint/0 distint/1 distint/2) + actual)))) + (wrap (do promise.monad + [#let [polling-delay 10 + amount-of-polls 5 + total-delay (n.* amount-of-polls polling-delay) + [channel sink] (/.poll polling-delay (: (IO Nat) (io.io sample)))] + _ (promise.schedule total-delay (io.io [])) + _ (promise.future (:: sink close)) + actual (/.consume channel)] + (_.claim [/.poll] + (and (list.every? (n.= sample) actual) + (n.>= amount-of-polls (list.size actual)))))) + (wrap (do promise.monad + [#let [polling-delay 10 + amount-of-polls 5 + total-delay (n.* amount-of-polls polling-delay) + [channel sink] (/.periodic polling-delay)] + _ (promise.schedule total-delay (io.io [])) + _ (promise.future (:: sink close)) + actual (/.consume channel)] + (_.claim [/.periodic] + (n.>= amount-of-polls (list.size actual))))) + (wrap (do promise.monad + [#let [max-iterations 10] + actual (|> [0 sample] + (/.iterate (function (_ [iterations current]) + (promise.resolved + (if (n.< max-iterations iterations) + (#.Some [[(inc iterations) (n.+ shift current)] + current]) + #.None)))) + /.consume)] + (_.claim [/.iterate] + (and (n.= max-iterations (list.size actual)) + (list@= (list.folds n.+ sample (list.repeat (dec max-iterations) shift)) + actual))))) + ))))) diff --git a/stdlib/source/test/lux/control/state.lux b/stdlib/source/test/lux/control/state.lux index cb7c94b83..72284ba5c 100644 --- a/stdlib/source/test/lux/control/state.lux +++ b/stdlib/source/test/lux/control/state.lux @@ -18,7 +18,7 @@ [text ["%" format (#+ format)]]] [math - ["r" random]]] + ["." random]]] {1 ["." / (#+ State)]}) @@ -30,9 +30,9 @@ (n.= output))) (def: basics - (do r.monad - [state r.nat - value r.nat] + (do random.monad + [state random.nat + value random.nat] ($_ _.and (_.cover [/.State /.get] (with-conditions [state state] @@ -58,7 +58,8 @@ (def: (injection value) (All [s] (Injection (State s))) - (function (_ state) [state value])) + (function (_ state) + [state value])) (def: (comparison init) (All [s] (-> s (Comparison (State s)))) @@ -68,9 +69,9 @@ (def: structures Test - (do r.monad - [state r.nat - value r.nat] + (do random.monad + [state random.nat + value random.nat] ($_ _.and (_.with-cover [/.functor] ($functor.spec ..injection (..comparison state) /.functor)) @@ -82,8 +83,8 @@ (def: loops Test - (do r.monad - [limit (|> r.nat (:: @ map (n.% 10))) + (do random.monad + [limit (|> random.nat (:: @ map (n.% 10))) #let [condition (do /.monad [state /.get] (wrap (n.< limit state)))]] @@ -104,10 +105,10 @@ (def: monad-transformer Test - (do r.monad - [state r.nat - left r.nat - right r.nat] + (do random.monad + [state random.nat + left random.nat + right random.nat] (let [(^open "io@.") io.monad] (_.cover [/.State' /.with /.lift /.run'] (|> (: (/.State' io.IO Nat Nat) |