aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test/lux/control/concurrency/semaphore.lux
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/test/lux/control/concurrency/semaphore.lux')
-rw-r--r--stdlib/source/test/lux/control/concurrency/semaphore.lux244
1 files changed, 122 insertions, 122 deletions
diff --git a/stdlib/source/test/lux/control/concurrency/semaphore.lux b/stdlib/source/test/lux/control/concurrency/semaphore.lux
index 8c31b9796..7e632b8cb 100644
--- a/stdlib/source/test/lux/control/concurrency/semaphore.lux
+++ b/stdlib/source/test/lux/control/concurrency/semaphore.lux
@@ -28,99 +28,99 @@
(def: semaphore
Test
- (_.with-cover [/.Semaphore]
- ($_ _.and
- (do {! random.monad}
- [initial-open-positions (|> random.nat (\ ! map (|>> (n.% 10) (n.max 1))))
- #let [semaphore (/.semaphore initial-open-positions)]]
- (wrap (do promise.monad
- [result (promise.time-out 10 (/.wait semaphore))]
- (_.cover' [/.semaphore]
- (case result
- (#.Some _)
- true
+ (_.for [/.Semaphore]
+ ($_ _.and
+ (do {! random.monad}
+ [initial-open-positions (|> random.nat (\ ! map (|>> (n.% 10) (n.max 1))))
+ #let [semaphore (/.semaphore initial-open-positions)]]
+ (wrap (do promise.monad
+ [result (promise.time-out 10 (/.wait semaphore))]
+ (_.cover' [/.semaphore]
+ (case result
+ (#.Some _)
+ true
- #.None
- false)))))
- (do {! random.monad}
- [initial-open-positions (|> random.nat (\ ! map (|>> (n.% 10) (n.max 1))))
- #let [semaphore (/.semaphore initial-open-positions)]]
- (wrap (do {! promise.monad}
- [_ (monad.map ! /.wait (list.repeat initial-open-positions semaphore))
- result (promise.time-out 10 (/.wait semaphore))]
- (_.cover' [/.wait]
- (case result
- (#.Some _)
- false
+ #.None
+ false)))))
+ (do {! random.monad}
+ [initial-open-positions (|> random.nat (\ ! map (|>> (n.% 10) (n.max 1))))
+ #let [semaphore (/.semaphore initial-open-positions)]]
+ (wrap (do {! promise.monad}
+ [_ (monad.map ! /.wait (list.repeat initial-open-positions semaphore))
+ result (promise.time-out 10 (/.wait semaphore))]
+ (_.cover' [/.wait]
+ (case result
+ (#.Some _)
+ false
- #.None
- true)))))
- (do {! random.monad}
- [initial-open-positions (|> random.nat (\ ! map (|>> (n.% 10) (n.max 1))))
- #let [semaphore (/.semaphore initial-open-positions)]]
- (wrap (do {! promise.monad}
- [_ (monad.map ! /.wait (list.repeat initial-open-positions semaphore))
- #let [block (/.wait semaphore)]
- result/0 (promise.time-out 10 block)
- open-positions (/.signal semaphore)
- result/1 (promise.time-out 10 block)]
- (_.cover' [/.signal]
- (case [result/0 result/1 open-positions]
- [#.None (#.Some _) (#try.Success +0)]
- true
+ #.None
+ true)))))
+ (do {! random.monad}
+ [initial-open-positions (|> random.nat (\ ! map (|>> (n.% 10) (n.max 1))))
+ #let [semaphore (/.semaphore initial-open-positions)]]
+ (wrap (do {! promise.monad}
+ [_ (monad.map ! /.wait (list.repeat initial-open-positions semaphore))
+ #let [block (/.wait semaphore)]
+ result/0 (promise.time-out 10 block)
+ open-positions (/.signal semaphore)
+ result/1 (promise.time-out 10 block)]
+ (_.cover' [/.signal]
+ (case [result/0 result/1 open-positions]
+ [#.None (#.Some _) (#try.Success +0)]
+ true
- _
- false)))))
- (do {! random.monad}
- [initial-open-positions (|> random.nat (\ ! map (|>> (n.% 10) (n.max 1))))
- #let [semaphore (/.semaphore initial-open-positions)]]
- (wrap (do promise.monad
- [outcome (/.signal semaphore)]
- (_.cover' [/.semaphore-is-maxed-out]
- (case outcome
- (#try.Failure error)
- (exception.match? /.semaphore-is-maxed-out error)
+ _
+ false)))))
+ (do {! random.monad}
+ [initial-open-positions (|> random.nat (\ ! map (|>> (n.% 10) (n.max 1))))
+ #let [semaphore (/.semaphore initial-open-positions)]]
+ (wrap (do promise.monad
+ [outcome (/.signal semaphore)]
+ (_.cover' [/.semaphore-is-maxed-out]
+ (case outcome
+ (#try.Failure error)
+ (exception.match? /.semaphore-is-maxed-out error)
- _
- false)))))
- )))
+ _
+ false)))))
+ )))
(def: mutex
Test
- (_.with-cover [/.Mutex]
- ($_ _.and
- (do {! random.monad}
- [repetitions (|> random.nat (\ ! map (|>> (n.% 100) (n.max 10))))
- #let [resource (atom.atom "")
- expected-As (text.join-with "" (list.repeat repetitions "A"))
- expected-Bs (text.join-with "" (list.repeat repetitions "B"))
- mutex (/.mutex [])
- processA (<| (/.synchronize mutex)
- io.io
- promise.future
- (do {! io.monad}
- [_ (<| (monad.seq !)
- (list.repeat repetitions)
- (atom.update (|>> (format "A")) resource))]
- (wrap [])))
- processB (<| (/.synchronize mutex)
- io.io
- promise.future
- (do {! io.monad}
- [_ (<| (monad.seq !)
- (list.repeat repetitions)
- (atom.update (|>> (format "B")) resource))]
- (wrap [])))]]
- (wrap (do promise.monad
- [_ processA
- _ processB
- #let [outcome (io.run (atom.read resource))]]
- (_.cover' [/.mutex /.synchronize]
- (or (text\= (format expected-As expected-Bs)
- outcome)
- (text\= (format expected-Bs expected-As)
- outcome))))))
- )))
+ (_.for [/.Mutex]
+ ($_ _.and
+ (do {! random.monad}
+ [repetitions (|> random.nat (\ ! map (|>> (n.% 100) (n.max 10))))
+ #let [resource (atom.atom "")
+ expected-As (text.join-with "" (list.repeat repetitions "A"))
+ expected-Bs (text.join-with "" (list.repeat repetitions "B"))
+ mutex (/.mutex [])
+ processA (<| (/.synchronize mutex)
+ io.io
+ promise.future
+ (do {! io.monad}
+ [_ (<| (monad.seq !)
+ (list.repeat repetitions)
+ (atom.update (|>> (format "A")) resource))]
+ (wrap [])))
+ processB (<| (/.synchronize mutex)
+ io.io
+ promise.future
+ (do {! io.monad}
+ [_ (<| (monad.seq !)
+ (list.repeat repetitions)
+ (atom.update (|>> (format "B")) resource))]
+ (wrap [])))]]
+ (wrap (do promise.monad
+ [_ processA
+ _ processB
+ #let [outcome (io.run (atom.read resource))]]
+ (_.cover' [/.mutex /.synchronize]
+ (or (text\= (format expected-As expected-Bs)
+ outcome)
+ (text\= (format expected-Bs expected-As)
+ outcome))))))
+ )))
(def: (waiter resource barrier id)
(-> (Atom Text) /.Barrier Nat (Promise Any))
@@ -131,43 +131,43 @@
(def: barrier
Test
- (_.with-cover [/.Barrier]
- ($_ _.and
- (do random.monad
- [raw random.nat]
- (_.cover [/.Limit /.limit]
- (case [raw (/.limit raw)]
- [0 #.None]
- true
-
- [_ (#.Some limit)]
- (and (n.> 0 raw)
- (n.= raw (refinement.un-refine limit)))
+ (_.for [/.Barrier]
+ ($_ _.and
+ (do random.monad
+ [raw random.nat]
+ (_.cover [/.Limit /.limit]
+ (case [raw (/.limit raw)]
+ [0 #.None]
+ true
+
+ [_ (#.Some limit)]
+ (and (n.> 0 raw)
+ (n.= raw (refinement.un-refine limit)))
- _
- false)))
- (do {! random.monad}
- [limit (|> random.nat (\ ! map (|>> (n.% 10) (n.max 1))))
- #let [barrier (/.barrier (maybe.assume (/.limit limit)))
- resource (atom.atom "")]]
- (wrap (do {! promise.monad}
- [#let [ending (|> "_"
- (list.repeat limit)
- (text.join-with ""))
- ids (enum.range n.enum 0 (dec limit))
- waiters (list\map (function (_ id)
- (exec (io.run (atom.update (|>> (format "_")) resource))
- (waiter resource barrier id)))
- ids)]
- _ (monad.seq ! waiters)
- #let [outcome (io.run (atom.read resource))]]
- (_.cover' [/.barrier /.block]
- (and (text.ends-with? ending outcome)
- (list.every? (function (_ id)
- (text.contains? (%.nat id) outcome))
- ids)
- )))))
- )))
+ _
+ false)))
+ (do {! random.monad}
+ [limit (|> random.nat (\ ! map (|>> (n.% 10) (n.max 1))))
+ #let [barrier (/.barrier (maybe.assume (/.limit limit)))
+ resource (atom.atom "")]]
+ (wrap (do {! promise.monad}
+ [#let [ending (|> "_"
+ (list.repeat limit)
+ (text.join-with ""))
+ ids (enum.range n.enum 0 (dec limit))
+ waiters (list\map (function (_ id)
+ (exec (io.run (atom.update (|>> (format "_")) resource))
+ (waiter resource barrier id)))
+ ids)]
+ _ (monad.seq ! waiters)
+ #let [outcome (io.run (atom.read resource))]]
+ (_.cover' [/.barrier /.block]
+ (and (text.ends-with? ending outcome)
+ (list.every? (function (_ id)
+ (text.contains? (%.nat id) outcome))
+ ids)
+ )))))
+ )))
(def: #export test
Test
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-22 23:38:12 +0000