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.lux250
1 files changed, 125 insertions, 125 deletions
diff --git a/stdlib/source/test/lux/control/concurrency/semaphore.lux b/stdlib/source/test/lux/control/concurrency/semaphore.lux
index 1b07c0e65..252f557b9 100644
--- a/stdlib/source/test/lux/control/concurrency/semaphore.lux
+++ b/stdlib/source/test/lux/control/concurrency/semaphore.lux
@@ -36,98 +36,98 @@
(def: semaphore
Test
(_.for [/.Semaphore]
- ($_ _.and
- (do [! random.monad]
- [initial_open_positions (|> random.nat (# ! each (|>> (n.% 10) (n.max 1))))
- .let [semaphore (/.semaphore initial_open_positions)]]
- (in (do async.monad
- [result (async.within ..delay (/.wait! semaphore))]
- (_.cover' [/.semaphore]
- (case result
- {.#Some _}
- true
+ (all _.and
+ (do [! random.monad]
+ [initial_open_positions (|> random.nat (# ! each (|>> (n.% 10) (n.max 1))))
+ .let [semaphore (/.semaphore initial_open_positions)]]
+ (in (do async.monad
+ [result (async.within ..delay (/.wait! semaphore))]
+ (_.cover' [/.semaphore]
+ (case result
+ {.#Some _}
+ true
- {.#None}
- false)))))
- (do [! random.monad]
- [initial_open_positions (|> random.nat (# ! each (|>> (n.% 10) (n.max 1))))
- .let [semaphore (/.semaphore initial_open_positions)]]
- (in (do [! async.monad]
- [_ (monad.each ! /.wait! (list.repeated initial_open_positions semaphore))
- result (async.within ..delay (/.wait! semaphore))]
- (_.cover' [/.wait!]
- (case result
- {.#Some _}
- false
+ {.#None}
+ false)))))
+ (do [! random.monad]
+ [initial_open_positions (|> random.nat (# ! each (|>> (n.% 10) (n.max 1))))
+ .let [semaphore (/.semaphore initial_open_positions)]]
+ (in (do [! async.monad]
+ [_ (monad.each ! /.wait! (list.repeated initial_open_positions semaphore))
+ result (async.within ..delay (/.wait! semaphore))]
+ (_.cover' [/.wait!]
+ (case result
+ {.#Some _}
+ false
- {.#None}
- true)))))
- (do [! random.monad]
- [initial_open_positions (|> random.nat (# ! each (|>> (n.% 10) (n.max 1))))
- .let [semaphore (/.semaphore initial_open_positions)]]
- (in (do [! async.monad]
- [_ (monad.each ! /.wait! (list.repeated initial_open_positions semaphore))
- .let [block (/.wait! semaphore)]
- result/0 (async.within ..delay block)
- open_positions (/.signal! semaphore)
- result/1 (async.within ..delay 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 (# ! each (|>> (n.% 10) (n.max 1))))
+ .let [semaphore (/.semaphore initial_open_positions)]]
+ (in (do [! async.monad]
+ [_ (monad.each ! /.wait! (list.repeated initial_open_positions semaphore))
+ .let [block (/.wait! semaphore)]
+ result/0 (async.within ..delay block)
+ open_positions (/.signal! semaphore)
+ result/1 (async.within ..delay 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 (# ! each (|>> (n.% 10) (n.max 1))))
- .let [semaphore (/.semaphore initial_open_positions)]]
- (in (do async.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 (# ! each (|>> (n.% 10) (n.max 1))))
+ .let [semaphore (/.semaphore initial_open_positions)]]
+ (in (do async.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
(_.for [/.Mutex]
- ($_ _.and
- (do [! random.monad]
- [repetitions (|> random.nat (# ! each (|>> (n.% 100) (n.max 10))))
- .let [resource (atom.atom "")
- expected_As (text.together (list.repeated repetitions "A"))
- expected_Bs (text.together (list.repeated repetitions "B"))
- mutex (/.mutex [])
- processA (<| (/.synchronize! mutex)
- io.io
- async.future
- (do [! io.monad]
- [_ (<| (monad.all !)
- (list.repeated repetitions)
- (atom.update! (|>> (format "A")) resource))]
- (in [])))
- processB (<| (/.synchronize! mutex)
- io.io
- async.future
- (do [! io.monad]
- [_ (<| (monad.all !)
- (list.repeated repetitions)
- (atom.update! (|>> (format "B")) resource))]
- (in [])))]]
- (in (do async.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))))))
- )))
+ (all _.and
+ (do [! random.monad]
+ [repetitions (|> random.nat (# ! each (|>> (n.% 100) (n.max 10))))
+ .let [resource (atom.atom "")
+ expected_As (text.together (list.repeated repetitions "A"))
+ expected_Bs (text.together (list.repeated repetitions "B"))
+ mutex (/.mutex [])
+ processA (<| (/.synchronize! mutex)
+ io.io
+ async.future
+ (do [! io.monad]
+ [_ (<| (monad.all !)
+ (list.repeated repetitions)
+ (atom.update! (|>> (format "A")) resource))]
+ (in [])))
+ processB (<| (/.synchronize! mutex)
+ io.io
+ async.future
+ (do [! io.monad]
+ [_ (<| (monad.all !)
+ (list.repeated repetitions)
+ (atom.update! (|>> (format "B")) resource))]
+ (in [])))]]
+ (in (do async.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 (Async Any))
@@ -139,49 +139,49 @@
(def: barrier
Test
(_.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.value limit)))
+ (all _.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.value limit)))
- _
- false)))
- (do [! random.monad]
- [limit (# ! each (|>> (n.% 9) ++) random.nat)
- .let [barrier (/.barrier (maybe.trusted (/.limit limit)))
- resource (atom.atom "")]]
- (in (do [! async.monad]
- [.let [suffix "_"
- expected_ending (|> suffix
- (list.repeated limit)
- text.together)
- expected_ids (enum.range n.enum 0 (-- limit))]
- _ (|> expected_ids
- (list#each (function (_ id)
- (exec
- (io.run! (atom.update! (|>> (format suffix)) resource))
- (waiter resource barrier id))))
- (monad.all !))
- .let [outcome (io.run! (atom.read! resource))]]
- (_.cover' [/.barrier /.block!]
- (and (text.ends_with? expected_ending outcome)
- (list.every? (function (_ id)
- (text.contains? (%.nat id) outcome))
- expected_ids))))))
- )))
+ _
+ false)))
+ (do [! random.monad]
+ [limit (# ! each (|>> (n.% 9) ++) random.nat)
+ .let [barrier (/.barrier (maybe.trusted (/.limit limit)))
+ resource (atom.atom "")]]
+ (in (do [! async.monad]
+ [.let [suffix "_"
+ expected_ending (|> suffix
+ (list.repeated limit)
+ text.together)
+ expected_ids (enum.range n.enum 0 (-- limit))]
+ _ (|> expected_ids
+ (list#each (function (_ id)
+ (exec
+ (io.run! (atom.update! (|>> (format suffix)) resource))
+ (waiter resource barrier id))))
+ (monad.all !))
+ .let [outcome (io.run! (atom.read! resource))]]
+ (_.cover' [/.barrier /.block!]
+ (and (text.ends_with? expected_ending outcome)
+ (list.every? (function (_ id)
+ (text.contains? (%.nat id) outcome))
+ expected_ids))))))
+ )))
(def: .public test
Test
(<| (_.covering /._)
- ($_ _.and
- ..semaphore
- ..mutex
- ..barrier
- )))
+ (all _.and
+ ..semaphore
+ ..mutex
+ ..barrier
+ )))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-22 23:42:10 +0000