diff options
Diffstat (limited to 'stdlib/test')
| -rw-r--r-- | stdlib/test/test/lux/concurrency/semaphore.lux | 143 | ||||
| -rw-r--r-- | stdlib/test/test/lux/control/concurrency/actor.lux (renamed from stdlib/test/test/lux/concurrency/actor.lux) | 12 | ||||
| -rw-r--r-- | stdlib/test/test/lux/control/concurrency/atom.lux (renamed from stdlib/test/test/lux/concurrency/atom.lux) | 6 | ||||
| -rw-r--r-- | stdlib/test/test/lux/control/concurrency/frp.lux (renamed from stdlib/test/test/lux/concurrency/frp.lux) | 12 | ||||
| -rw-r--r-- | stdlib/test/test/lux/control/concurrency/promise.lux (renamed from stdlib/test/test/lux/concurrency/promise.lux) | 6 | ||||
| -rw-r--r-- | stdlib/test/test/lux/control/concurrency/semaphore.lux | 143 | ||||
| -rw-r--r-- | stdlib/test/test/lux/control/concurrency/stm.lux (renamed from stdlib/test/test/lux/concurrency/stm.lux) | 14 |
7 files changed, 168 insertions, 168 deletions
diff --git a/stdlib/test/test/lux/concurrency/semaphore.lux b/stdlib/test/test/lux/concurrency/semaphore.lux deleted file mode 100644 index f309fcd0c..000000000 --- a/stdlib/test/test/lux/concurrency/semaphore.lux +++ /dev/null @@ -1,143 +0,0 @@ -(.module: - [lux #* - [control - ["." monad (#+ do)]] - [data - ["." maybe] - ["." text ("text/." Equivalence<Text> Monoid<Text>) - format] - [collection - ["." list ("list/." Functor<List>)]]] - [concurrency - ["/" semaphore] - ["." promise (#+ Promise)] - ["." atom (#+ Atom)]] - ["." io] - [math - ["r" random]]] - lux/test) - -(def: (wait-many-times times semaphore) - (-> Nat /.Semaphore (Promise Any)) - (loop [steps times] - (if (n/> 0 steps) - (do promise.Monad<Promise> - [_ (/.wait semaphore)] - (recur (dec steps))) - (:: promise.Monad<Promise> wrap [])))) - -(context: "Semaphore." - (<| (times 100) - (do @ - [open-positions (|> r.nat (:: @ map (|>> (n/% 10) (n/max 1))))] - ($_ seq - (let [semaphore (/.semaphore open-positions)] - (wrap (do promise.Monad<Promise> - [_ (wait-many-times open-positions semaphore)] - (assert "Can wait on a semaphore up to the number of open positions without blocking." - #1)))) - (let [semaphore (/.semaphore open-positions)] - (wrap (do promise.Monad<Promise> - [result (<| (promise.time-out 100) - (wait-many-times (inc open-positions) semaphore))] - (assert "Waiting on a semaphore more than the number of open positions blocks the process." - (case result - (#.Some _) - #0 - - #.None - #1))))) - (let [semaphore (/.semaphore open-positions)] - (wrap (do promise.Monad<Promise> - [_ (: (Promise Any) - (loop [steps (n/* 2 open-positions)] - (if (n/> 0 steps) - (do @ - [_ (/.wait semaphore) - _ (/.signal semaphore)] - (recur (dec steps))) - (wrap []))))] - (assert "Signaling a semaphore replenishes its open positions." - #1)))) - (let [semaphore (/.semaphore open-positions)] - (wrap (do promise.Monad<Promise> - [#let [resource (atom.atom "") - blocked (do @ - [_ (wait-many-times open-positions semaphore) - _ (/.wait semaphore) - #let [_ (io.run (atom.update (|>> (format "B")) - resource))]] - (wrap []))] - _ (promise.wait 100) - _ (exec (io.run (atom.update (|>> (format "A")) - resource)) - (/.signal semaphore)) - _ blocked] - (assert "A blocked process can be un-blocked by a signal somewhere else." - (text/= "BA" - (io.run (atom.read resource))))))) - )))) - -(context: "Mutex." - (<| (times 100) - (do @ - [repetitions (|> r.nat (:: @ map (|>> (n/% 100) (n/max 10))))] - ($_ seq - (let [mutex (/.mutex [])] - (wrap (do promise.Monad<Promise> - [#let [resource (atom.atom "") - expected-As (text.join-with "" (list.repeat repetitions "A")) - expected-Bs (text.join-with "" (list.repeat repetitions "B")) - processA (<| (/.synchronize mutex) - io.io - promise.future - (do io.Monad<IO> - [_ (<| (monad.seq @) - (list.repeat repetitions) - (atom.update (|>> (format "A")) resource))] - (wrap []))) - processB (<| (/.synchronize mutex) - io.io - promise.future - (do io.Monad<IO> - [_ (<| (monad.seq @) - (list.repeat repetitions) - (atom.update (|>> (format "B")) resource))] - (wrap [])))] - _ processA - _ processB - #let [outcome (io.run (atom.read resource))]] - (assert "Mutexes only allow one process to execute at a time." - (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)) - (do promise.Monad<Promise> - [_ (/.block barrier) - #let [_ (io.run (atom.update (|>> (format (%n id))) resource))]] - (wrap []))) - -(context: "Barrier." - (let [limit 10 - barrier (/.barrier (maybe.assume (/.limit limit))) - resource (atom.atom "")] - ($_ seq - (wrap (do promise.Monad<Promise> - [#let [ids (list.n/range 0 (dec limit)) - waiters (list/map (function (_ id) - (let [process (waiter resource barrier id)] - (exec (io.run (atom.update (|>> (format "_")) resource)) - process))) - ids)] - _ (monad.seq @ waiters) - #let [outcome (io.run (atom.read resource))]] - (assert "A barrier can stop all processes from acting, until an amount of waiting processes is reached, and then the barrier is un-blocked for all." - (and (text.ends-with? "__________" outcome) - (list.every? (function (_ id) - (text.contains? (%n id) outcome)) - ids) - ))))))) diff --git a/stdlib/test/test/lux/concurrency/actor.lux b/stdlib/test/test/lux/control/concurrency/actor.lux index a43845380..90c3d6dd4 100644 --- a/stdlib/test/test/lux/concurrency/actor.lux +++ b/stdlib/test/test/lux/control/concurrency/actor.lux @@ -3,15 +3,15 @@ ["." io (#+ IO io)] [control ["M" monad (#+ do Monad)] - ["ex" exception]] + ["ex" exception] + [concurrency + ["P" promise ("promise/." Monad<Promise>)] + ["T" task] + ["&" actor (#+ actor: message:)]]] [data ["e" error] [text - format]] - [concurrency - ["P" promise ("promise/." Monad<Promise>)] - ["T" task] - ["&" actor (#+ actor: message:)]]] + format]]] lux/test) (actor: Counter diff --git a/stdlib/test/test/lux/concurrency/atom.lux b/stdlib/test/test/lux/control/concurrency/atom.lux index a10edcae7..720547e27 100644 --- a/stdlib/test/test/lux/concurrency/atom.lux +++ b/stdlib/test/test/lux/control/concurrency/atom.lux @@ -2,9 +2,9 @@ [lux #* ["." io] [control - ["M" monad (#+ do Monad)]] - [concurrency - ["&" atom]] + ["M" monad (#+ do Monad)] + [concurrency + ["&" atom]]] [math ["r" random]]] lux/test) diff --git a/stdlib/test/test/lux/concurrency/frp.lux b/stdlib/test/test/lux/control/concurrency/frp.lux index 46db40889..04ddd5986 100644 --- a/stdlib/test/test/lux/concurrency/frp.lux +++ b/stdlib/test/test/lux/control/concurrency/frp.lux @@ -2,15 +2,15 @@ [lux #* ["." io (#+ IO io)] [control - ["." monad (#+ do Monad)]] + ["." monad (#+ do Monad)] + [concurrency + ["." promise ("promise/." Monad<Promise>)] + ["." frp (#+ Channel)] + ["." atom (#+ Atom atom)]]] [data ["." number] [collection - ["." list]]] - [concurrency - ["." promise ("promise/." Monad<Promise>)] - ["." frp (#+ Channel)] - ["." atom (#+ Atom atom)]]] + ["." list]]]] lux/test) (def: (write! values channel) diff --git a/stdlib/test/test/lux/concurrency/promise.lux b/stdlib/test/test/lux/control/concurrency/promise.lux index e857d0708..d666f3b31 100644 --- a/stdlib/test/test/lux/concurrency/promise.lux +++ b/stdlib/test/test/lux/control/concurrency/promise.lux @@ -3,9 +3,9 @@ ["." io] [control ["M" monad (#+ do Monad)] - pipe] - [concurrency - ["&" promise ("&/." Monad<Promise>)]] + pipe + [concurrency + ["&" promise ("&/." Monad<Promise>)]]] [math ["r" random]]] lux/test) diff --git a/stdlib/test/test/lux/control/concurrency/semaphore.lux b/stdlib/test/test/lux/control/concurrency/semaphore.lux new file mode 100644 index 000000000..5c09f4bac --- /dev/null +++ b/stdlib/test/test/lux/control/concurrency/semaphore.lux @@ -0,0 +1,143 @@ +(.module: + [lux #* + [control + ["." monad (#+ do)] + [concurrency + ["/" semaphore] + ["." promise (#+ Promise)] + ["." atom (#+ Atom)]]] + [data + ["." maybe] + ["." text ("text/." Equivalence<Text> Monoid<Text>) + format] + [collection + ["." list ("list/." Functor<List>)]]] + ["." io] + [math + ["r" random]]] + lux/test) + +## (def: (wait-many-times times semaphore) +## (-> Nat /.Semaphore (Promise Any)) +## (loop [steps times] +## (if (n/> 0 steps) +## (do promise.Monad<Promise> +## [_ (/.wait semaphore)] +## (recur (dec steps))) +## (:: promise.Monad<Promise> wrap [])))) + +## (context: "Semaphore." +## (<| (times 100) +## (do @ +## [open-positions (|> r.nat (:: @ map (|>> (n/% 10) (n/max 1))))] +## ($_ seq +## (let [semaphore (/.semaphore open-positions)] +## (wrap (do promise.Monad<Promise> +## [_ (wait-many-times open-positions semaphore)] +## (assert "Can wait on a semaphore up to the number of open positions without blocking." +## true)))) +## (let [semaphore (/.semaphore open-positions)] +## (wrap (do promise.Monad<Promise> +## [result (<| (promise.time-out 100) +## (wait-many-times (inc open-positions) semaphore))] +## (assert "Waiting on a semaphore more than the number of open positions blocks the process." +## (case result +## (#.Some _) +## false + +## #.None +## true))))) +## (let [semaphore (/.semaphore open-positions)] +## (wrap (do promise.Monad<Promise> +## [_ (: (Promise Any) +## (loop [steps (n/* 2 open-positions)] +## (if (n/> 0 steps) +## (do @ +## [_ (/.wait semaphore) +## _ (/.signal semaphore)] +## (recur (dec steps))) +## (wrap []))))] +## (assert "Signaling a semaphore replenishes its open positions." +## true)))) +## (let [semaphore (/.semaphore open-positions)] +## (wrap (do promise.Monad<Promise> +## [#let [resource (atom.atom "") +## blocked (do @ +## [_ (wait-many-times open-positions semaphore) +## _ (/.wait semaphore) +## #let [_ (io.run (atom.update (|>> (format "B")) +## resource))]] +## (wrap []))] +## _ (promise.wait 100) +## _ (exec (io.run (atom.update (|>> (format "A")) +## resource)) +## (/.signal semaphore)) +## _ blocked] +## (assert "A blocked process can be un-blocked by a signal somewhere else." +## (text/= "BA" +## (io.run (atom.read resource))))))) +## )))) + +## (context: "Mutex." +## (<| (times 100) +## (do @ +## [repetitions (|> r.nat (:: @ map (|>> (n/% 100) (n/max 10))))] +## ($_ seq +## (let [mutex (/.mutex [])] +## (wrap (do promise.Monad<Promise> +## [#let [resource (atom.atom "") +## expected-As (text.join-with "" (list.repeat repetitions "A")) +## expected-Bs (text.join-with "" (list.repeat repetitions "B")) +## processA (<| (/.synchronize mutex) +## io.io +## promise.future +## (do io.Monad<IO> +## [_ (<| (monad.seq @) +## (list.repeat repetitions) +## (atom.update (|>> (format "A")) resource))] +## (wrap []))) +## processB (<| (/.synchronize mutex) +## io.io +## promise.future +## (do io.Monad<IO> +## [_ (<| (monad.seq @) +## (list.repeat repetitions) +## (atom.update (|>> (format "B")) resource))] +## (wrap [])))] +## _ processA +## _ processB +## #let [outcome (io.run (atom.read resource))]] +## (assert "Mutexes only allow one process to execute at a time." +## (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)) +## (do promise.Monad<Promise> +## [_ (/.block barrier) +## #let [_ (io.run (atom.update (|>> (format (%n id))) resource))]] +## (wrap []))) + +## (context: "Barrier." +## (let [limit 10 +## barrier (/.barrier (maybe.assume (/.limit limit))) +## resource (atom.atom "")] +## ($_ seq +## (wrap (do promise.Monad<Promise> +## [#let [ids (list.n/range 0 (dec limit)) +## waiters (list/map (function (_ id) +## (let [process (waiter resource barrier id)] +## (exec (io.run (atom.update (|>> (format "_")) resource)) +## process))) +## ids)] +## _ (monad.seq @ waiters) +## #let [outcome (io.run (atom.read resource))]] +## (assert "A barrier can stop all processes from acting, until an amount of waiting processes is reached, and then the barrier is un-blocked for all." +## (and (text.ends-with? "__________" outcome) +## (list.every? (function (_ id) +## (text.contains? (%n id) outcome)) +## ids) +## ))))))) diff --git a/stdlib/test/test/lux/concurrency/stm.lux b/stdlib/test/test/lux/control/concurrency/stm.lux index ee84f193e..c84ce44cc 100644 --- a/stdlib/test/test/lux/concurrency/stm.lux +++ b/stdlib/test/test/lux/control/concurrency/stm.lux @@ -2,17 +2,17 @@ [lux #* ["." io (#+ IO)] [control - ["M" monad (#+ do Monad)]] + ["M" monad (#+ do Monad)] + [concurrency + ["." atom (#+ Atom atom)] + ["&" stm] + ["." process] + ["." promise] + ["." frp (#+ Channel)]]] [data ["." number] [collection ["." list ("list/." Functor<List>)]]] - [concurrency - ["." atom (#+ Atom atom)] - ["&" stm] - ["." process] - ["." promise] - ["." frp (#+ Channel)]] [math ["r" random]]] lux/test) |