aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/test')
-rw-r--r--stdlib/source/test/lux.lux89
-rw-r--r--stdlib/source/test/lux/abstract.lux2
-rw-r--r--stdlib/source/test/lux/abstract/monoid.lux44
-rw-r--r--stdlib/source/test/lux/control/concurrency/actor.lux2
-rw-r--r--stdlib/source/test/lux/control/concurrency/frp.lux34
-rw-r--r--stdlib/source/test/lux/control/concurrency/promise.lux202
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))))
))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-23 12:56:29 +0000