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/order.lux14
-rw-r--r--stdlib/source/test/lux/control/concurrency/atom.lux49
-rw-r--r--stdlib/source/test/lux/control/concurrency/frp.lux227
-rw-r--r--stdlib/source/test/lux/control/state.lux29
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)