aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/concurrency/stm.lux2
-rw-r--r--stdlib/test/test/lux/concurrency/stm.lux99
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))))
)))