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/equivalence.lux56
-rw-r--r--stdlib/source/test/lux/control/concurrency/actor.lux165
-rw-r--r--stdlib/source/test/lux/control/try.lux6
-rw-r--r--stdlib/source/test/lux/control/writer.lux48
4 files changed, 176 insertions, 99 deletions
diff --git a/stdlib/source/test/lux/abstract/equivalence.lux b/stdlib/source/test/lux/abstract/equivalence.lux
index 7ae9b37af..b7db2ee70 100644
--- a/stdlib/source/test/lux/abstract/equivalence.lux
+++ b/stdlib/source/test/lux/abstract/equivalence.lux
@@ -4,50 +4,48 @@
[abstract/monad (#+ do)]
[data
["." bit ("#@." equivalence)]
- [text
- ["%" format (#+ format)]]
[number
["n" nat]
["i" int]]]
[math
- ["r" random (#+ Random)]]]
+ ["." random (#+ Random)]]]
{1
["." / (#+ Equivalence)]})
(def: #export test
Test
- (do r.monad
- [leftN r.nat
- rightN r.nat
- leftI r.int
- rightI r.int]
- (<| (_.context (%.name (name-of /._)))
+ (do random.monad
+ [leftN random.nat
+ rightN random.nat
+ leftI random.int
+ rightI random.int]
+ (<| (_.covering /._)
($_ _.and
- (_.test (%.name (name-of /.sum))
- (let [equivalence (/.sum n.equivalence i.equivalence)]
- (and (bit@= (:: n.equivalence = leftN leftN)
- (:: equivalence = (#.Left leftN) (#.Left leftN)))
- (bit@= (:: n.equivalence = leftN rightN)
- (:: equivalence = (#.Left leftN) (#.Left rightN)))
- (bit@= (:: i.equivalence = leftI leftI)
- (:: equivalence = (#.Right leftI) (#.Right leftI)))
- (bit@= (:: i.equivalence = leftI rightI)
- (:: equivalence = (#.Right leftI) (#.Right rightI))))))
- (_.test (%.name (name-of /.product))
- (let [equivalence (/.product n.equivalence i.equivalence)]
- (and (bit@= (and (:: n.equivalence = leftN leftN)
- (:: i.equivalence = leftI leftI))
- (:: equivalence = [leftN leftI] [leftN leftI]))
- (bit@= (and (:: n.equivalence = leftN rightN)
- (:: i.equivalence = leftI rightI))
- (:: equivalence = [leftN leftI] [rightN rightI])))))))))
+ (_.cover [/.sum]
+ (let [equivalence (/.sum n.equivalence i.equivalence)]
+ (and (bit@= (:: n.equivalence = leftN leftN)
+ (:: equivalence = (#.Left leftN) (#.Left leftN)))
+ (bit@= (:: n.equivalence = leftN rightN)
+ (:: equivalence = (#.Left leftN) (#.Left rightN)))
+ (bit@= (:: i.equivalence = leftI leftI)
+ (:: equivalence = (#.Right leftI) (#.Right leftI)))
+ (bit@= (:: i.equivalence = leftI rightI)
+ (:: equivalence = (#.Right leftI) (#.Right rightI))))))
+ (_.cover [/.product]
+ (let [equivalence (/.product n.equivalence i.equivalence)]
+ (and (bit@= (and (:: n.equivalence = leftN leftN)
+ (:: i.equivalence = leftI leftI))
+ (:: equivalence = [leftN leftI] [leftN leftI]))
+ (bit@= (and (:: n.equivalence = leftN rightN)
+ (:: i.equivalence = leftI rightI))
+ (:: equivalence = [leftN leftI] [rightN rightI])))))))))
(def: #export (spec (^open "_@.") generator)
(All [a] (-> (Equivalence a) (Random a) Test))
- (do r.monad
+ (do random.monad
[left generator
right generator]
- (<| (_.context (%.name (name-of /.Equivalence)))
+ (<| (_.with-cover [/.Equivalence])
($_ _.and
(_.test "Reflexivity."
(_@= left left))
diff --git a/stdlib/source/test/lux/control/concurrency/actor.lux b/stdlib/source/test/lux/control/concurrency/actor.lux
index cde83e09d..741b848cb 100644
--- a/stdlib/source/test/lux/control/concurrency/actor.lux
+++ b/stdlib/source/test/lux/control/concurrency/actor.lux
@@ -3,8 +3,8 @@
["_" test (#+ Test)]
[abstract/monad (#+ do)]
[control
- ["." try]
- ["ex" exception]
+ ["." try (#+ Try)]
+ ["." exception (#+ exception:)]
["." io (#+ IO io)]]
[data
[number
@@ -12,59 +12,95 @@
[text
["%" format (#+ format)]]]
[math
- ["r" random]]]
+ ["." random]]]
{1
["." / (#+ actor: message:)
[//
- ["." promise ("#;." monad)]]]})
+ ["." promise (#+ Promise Resolver) ("#@." monad)]]]})
+
+(exception: get-wrecked)
(actor: Counter
Nat
- ((handle message state self)
- (do (try.with promise.monad)
- [#let [_ (log! "BEFORE")]
- output (message state self)
- #let [_ (log! "AFTER")]]
- (wrap output)))
+ ((handle [message state self])
+ (message state self))
- ((stop cause state)
- (promise;wrap (log! (if (ex.match? /.poisoned cause)
- (format "Counter was poisoned: " (%.nat state))
- cause)))))
+ ((stop [cause state])
+ (promise@wrap [])))
(message: #export Counter
(count! {increment Nat} state self Nat)
(let [state' (n.+ increment state)]
- (promise;wrap (#try.Success [state' state']))))
+ (promise@wrap (#try.Success [state' state']))))
(def: #export test
Test
- (do r.monad
- [_ (wrap [])]
- (<| (_.context (%.name (name-of /.Actor)))
+ (do random.monad
+ [initial-state random.nat]
+ (<| (_.covering /._)
+ (_.with-cover [/.Actor])
($_ _.and
- (_.test "Can check if an actor is alive."
- (io.run (do io.monad
- [counter (new@Counter 0)]
- (wrap (/.alive? counter)))))
-
- (_.test "Can poison actors."
- (io.run (do io.monad
- [counter (new@Counter 0)
- poisoned? (/.poison counter)]
- (wrap (and poisoned?
- (not (/.alive? counter)))))))
-
- (_.test "Cannot poison an already dead actor."
- (io.run (do io.monad
- [counter (new@Counter 0)
- first-time (/.poison counter)
- second-time (/.poison counter)]
- (wrap (and first-time
- (not second-time))))))
-
- (:: r.monad wrap
+ (_.cover [/.alive?]
+ (io.run (do io.monad
+ [actor (/.spawn /.default-behavior 0)]
+ (/.alive? actor))))
+
+ (_.cover [/.poison]
+ (and (io.run (do io.monad
+ [actor (/.spawn /.default-behavior 0)
+ poisoned? (/.poison actor)
+ alive? (/.alive? actor)]
+ (wrap (and poisoned?
+ (not alive?)))))
+ (io.run (do io.monad
+ [actor (/.spawn /.default-behavior 0)
+ first-time? (/.poison actor)
+ second-time? (/.poison actor)]
+ (wrap (and first-time?
+ (not second-time?)))))))
+
+ (let [inc! (: (/.Message Nat)
+ (function (_ state actor)
+ (promise@wrap
+ (#try.Success
+ (inc state)))))]
+ (:: random.monad wrap
+ (do promise.monad
+ [result (promise.future (do io.monad
+ [actor (/.spawn /.default-behavior 0)
+ sent? (/.send inc! actor)]
+ (wrap (#try.Success sent?))))]
+ (_.claim [/.Behavior /.Message
+ /.default-behavior /.spawn /.send]
+ (case result
+ (#try.Success outcome)
+ outcome
+
+ (#try.Failure error)
+ false)))))
+
+ (let [[read write] (: [(Promise Text) (Resolver Text)]
+ (promise.promise []))]
+ (:: random.monad wrap
+ (do promise.monad
+ [result (promise.future (do io.monad
+ [actor (/.spawn {#/.handle (function (_ message state self)
+ (message state self))
+ #/.end (function (_ cause state)
+ (promise.future (write cause)))}
+ write)
+ _ (/.poison actor)]
+ (io.io (promise.poll read))))]
+ (_.claim [/.poisoned]
+ (case result
+ (#.Some error)
+ (exception.match? /.poisoned error)
+
+ #.None
+ false)))))
+
+ (:: random.monad wrap
(do promise.monad
[result (do (try.with promise.monad)
[#let [counter (io.run (new@Counter 0))]
@@ -74,11 +110,50 @@
(wrap (and (n.= 1 output-1)
(n.= 2 output-2)
(n.= 3 output-3))))]
- (_.assert "Can send messages to actors."
- (case result
- (#try.Success outcome)
- outcome
+ (_.claim [/.actor: /.message:]
+ (case result
+ (#try.Success outcome)
+ outcome
+
+ (#try.Failure error)
+ false))))
+
+ (:: random.monad wrap
+ (do promise.monad
+ [result (do (try.with promise.monad)
+ [counter (promise.future (do io.monad
+ [counter (new@Counter 0)
+ _ (/.poison counter)]
+ (wrap (#try.Success counter))))]
+ (count! 1 counter))]
+ (_.claim [/.dead]
+ (case result
+ (#try.Success outcome)
+ false
+
+ (#try.Failure error)
+ (exception.match? /.dead error)))))
+
+ (let [die! (: (/.Message Nat)
+ (function (_ state actor)
+ (promise@wrap (exception.throw ..get-wrecked []))))]
+ (:: random.monad wrap
+ (do promise.monad
+ [result (promise.future (do io.monad
+ [actor (/.spawn /.default-behavior initial-state)
+ sent? (/.send die! actor)
+ alive? (/.alive? actor)
+ obituary (/.obituary actor)]
+ (wrap (#try.Success [actor sent? alive? obituary]))))]
+ (_.claim [/.Obituary /.obituary]
+ (case result
+ (^ (#try.Success [actor sent? alive? (#.Some [error state (list single-pending-message)])]))
+ (and sent?
+ (not alive?)
+ (exception.match? ..get-wrecked error)
+ (n.= initial-state state)
+ (is? die! single-pending-message))
- (#try.Failure _)
- #0))))
+ _
+ false)))))
))))
diff --git a/stdlib/source/test/lux/control/try.lux b/stdlib/source/test/lux/control/try.lux
index 08c19794d..ef090c1a9 100644
--- a/stdlib/source/test/lux/control/try.lux
+++ b/stdlib/source/test/lux/control/try.lux
@@ -72,9 +72,9 @@
(_.cover [/.assume]
(n.= expected
(/.assume (/.succeed expected))))
- (_.cover [/.maybe]
- (case [(/.maybe (/.succeed expected))
- (/.maybe (/.fail error))]
+ (_.cover [/.to-maybe]
+ (case [(/.to-maybe (/.succeed expected))
+ (/.to-maybe (/.fail error))]
[(#.Some actual) #.None]
(n.= expected actual)
diff --git a/stdlib/source/test/lux/control/writer.lux b/stdlib/source/test/lux/control/writer.lux
index d33cd3969..09dd2aef5 100644
--- a/stdlib/source/test/lux/control/writer.lux
+++ b/stdlib/source/test/lux/control/writer.lux
@@ -16,10 +16,10 @@
["." product]
[number
["n" nat]]
- ["." text ("#;." equivalence)
+ ["." text ("#@." equivalence)
["%" format (#+ format)]]]
[math
- ["r" random]]]
+ ["." random]]]
{1
["." / (#+ Writer)]})
@@ -34,26 +34,30 @@
(def: #export test
Test
- (do r.monad
- [log (r.ascii 1)
- left r.nat
- right r.nat]
- (<| (_.context (%.name (name-of /.Writer)))
+ (do random.monad
+ [log (random.ascii 1)
+ left random.nat
+ right random.nat]
+ (<| (_.covering /._)
+ (_.with-cover [/.Writer])
($_ _.and
- ($functor.spec (..injection text.monoid) ..comparison /.functor)
- ($apply.spec (..injection text.monoid) ..comparison (/.apply text.monoid))
- ($monad.spec (..injection text.monoid) ..comparison (/.monad text.monoid))
+ (_.with-cover [/.functor]
+ ($functor.spec (..injection text.monoid) ..comparison /.functor))
+ (_.with-cover [/.apply]
+ ($apply.spec (..injection text.monoid) ..comparison (/.apply text.monoid)))
+ (_.with-cover [/.monad]
+ ($monad.spec (..injection text.monoid) ..comparison (/.monad text.monoid)))
- (_.test "Can write any value."
- (text;= log
- (product.left (/.write log))))
- (let [lift (/.lift text.monoid io.monad)
- (^open "io;.") io.monad]
- (_.test "Can add writer functionality to any monad."
- (|> (io.run (do (/.with text.monoid io.monad)
- [a (lift (io;wrap left))
- b (wrap right)]
- (wrap (n.+ a b))))
- product.right
- (n.= (n.+ left right)))))
+ (_.cover [/.write]
+ (text@= log
+ (product.left (/.write log))))
+ (_.cover [/.with /.lift]
+ (let [lift (/.lift text.monoid io.monad)
+ (^open "io@.") io.monad]
+ (|> (io.run (do (/.with text.monoid io.monad)
+ [a (lift (io@wrap left))
+ b (wrap right)]
+ (wrap (n.+ a b))))
+ product.right
+ (n.= (n.+ left right)))))
))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-30 23:14:18 +0000