diff options
| -rw-r--r-- | stdlib/source/lux/concurrency/stm.lux | 2 | ||||
| -rw-r--r-- | stdlib/test/test/lux/concurrency/stm.lux | 99 |
2 files changed, 40 insertions, 61 deletions
diff --git a/stdlib/source/lux/concurrency/stm.lux b/stdlib/source/lux/concurrency/stm.lux index c3e5fad3a..914920773 100644 --- a/stdlib/source/lux/concurrency/stm.lux +++ b/stdlib/source/lux/concurrency/stm.lux @@ -91,7 +91,7 @@ (:! (Var ($ +0)) _var)) (#;Cons [(:! (Var ($ +0)) _var) (:! ($ +0) _original) - (:! ($ +0) _current)] + (:! ($ +0) value)] tx') (#;Cons [_var _original _current] (update-tx-value var value tx'))) diff --git a/stdlib/test/test/lux/concurrency/stm.lux b/stdlib/test/test/lux/concurrency/stm.lux index 71c82dfab..2f0b7d99c 100644 --- a/stdlib/test/test/lux/concurrency/stm.lux +++ b/stdlib/test/test/lux/concurrency/stm.lux @@ -8,7 +8,7 @@ (lux (codata [io]) (control monad) (data [number] - (struct [list "" Functor<List>]) + (struct [list "" Functor<List> "List/" Fold<List>]) text/format) (concurrency ["&" stm] [promise]) @@ -17,67 +17,46 @@ pipe) lux/test) -(def: vars Int 5) -(def: processes/vars Int 5) (def: iterations/processes Int 100) (test: "STM" - (let [_var (&;var 0) - changes (io;run (&;follow "test" _var)) - tests (: (List Test) - (map (lambda [_] - (let [_concurrency-var (&;var 0)] - (do promise;Monad<Promise> - [_ (seqM @ - (map (lambda [_] - (mapM @ (lambda [_] (&;commit (&;update i.inc _concurrency-var))) - (list;i.range 1 iterations/processes))) - (list;i.range 1 processes/vars))) - _ (&;commit (&;read _concurrency-var))] - (assert "" true)))) - (list;i.range 1 vars)))] + (do promise;Monad<Promise> + [#let [_var (&;var 0) + changes (io;run (&;follow "test" _var))] + output1 (&;commit (&;read _var)) + output2 (&;commit (do &;Monad<STM> + [_ (&;write 5 _var)] + (&;read _var))) + output3 (&;commit (do &;Monad<STM> + [temp (&;read _var) + _ (&;update (i.* 3) _var)] + (&;read _var))) + ?c1+changes' changes + #let [[c1 changes'] (default [-1 changes] ?c1+changes')] + ?c2+changes' changes' + #let [[c2 changes'] (default [-1 changes] ?c2+changes')]] ($_ seq - (do promise;Monad<Promise> - [output (&;commit (do &;Monad<STM> - [value (&;read _var)] - (wrap value)))] - (assert "" (i.= 0 output))) - - (do promise;Monad<Promise> - [output (&;commit (do &;Monad<STM> - [_ (&;write 5 _var) - value (&;read _var)] - (wrap value)))] - (assert "" (i.= 5 output))) - - (do promise;Monad<Promise> - [output (&;commit (do &;Monad<STM> - [value (&;read _var)] - (wrap value)))] - (assert "" (i.= 5 output))) - - (do promise;Monad<Promise> - [output (&;commit (do &;Monad<STM> - [_ (&;update (i.* 3) _var) - value (&;read _var)] - (wrap value)))] - (assert "" (i.= 15 output))) - - (do promise;Monad<Promise> - [output (&;commit (do &;Monad<STM> - [value (&;read _var)] - (wrap value)))] - (assert "" (i.= 15 output))) - - (do promise;Monad<Promise> - [?c1+changes' changes - #let [[c1 changes'] (default [-1 changes] ?c1+changes')] - ?c2+changes' changes' - #let [[c2 changes'] (default [-1 changes] ?c2+changes')]] - (assert "" - (and (i.= 5 c1) - (i.= 15 c2)))) - ## Temporarily commented-out due to type-checking bug in - ## compiler... - ## (match+ _ (seqM Monad<Test> tests)) + (assert "Can read STM vars." + (i.= 0 output1)) + + (assert "Can write STM vars." + (i.= 5 output2)) + + (assert "Can update STM vars." + (i.= 15 output3)) + + (assert "Can follow all the changes to STM vars." + (and (i.= 5 c1) (i.= 15 c2))) + + (let [_concurrency-var (&;var 0)] + (do promise;Monad<Promise> + [_ (seqM @ + (map (lambda [_] + (mapM @ (lambda [_] (&;commit (&;update i.inc _concurrency-var))) + (list;i.range 1 iterations/processes))) + (list;i.range 1 (nat-to-int promise;concurrency-level)))) + last-val (&;commit (&;read _concurrency-var))] + (assert "Can modify STM vars concurrently from multiple threads." + (i.= (i.* iterations/processes (nat-to-int promise;concurrency-level)) + last-val)))) ))) |