From 4639d34aeab515261ff8e21ff96170de74ff8304 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 19 Dec 2016 20:03:13 -0400 Subject: - Fixed a bug when updating the value of a STM var. - Refactored the tests for lux/concurrency/stm. --- stdlib/source/lux/concurrency/stm.lux | 2 +- stdlib/test/test/lux/concurrency/stm.lux | 99 +++++++++++++------------------- 2 files changed, 40 insertions(+), 61 deletions(-) (limited to 'stdlib') 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]) + (struct [list "" Functor "List/" Fold]) 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 - [_ (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 + [#let [_var (&;var 0) + changes (io;run (&;follow "test" _var))] + output1 (&;commit (&;read _var)) + output2 (&;commit (do &;Monad + [_ (&;write 5 _var)] + (&;read _var))) + output3 (&;commit (do &;Monad + [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 - [output (&;commit (do &;Monad - [value (&;read _var)] - (wrap value)))] - (assert "" (i.= 0 output))) - - (do promise;Monad - [output (&;commit (do &;Monad - [_ (&;write 5 _var) - value (&;read _var)] - (wrap value)))] - (assert "" (i.= 5 output))) - - (do promise;Monad - [output (&;commit (do &;Monad - [value (&;read _var)] - (wrap value)))] - (assert "" (i.= 5 output))) - - (do promise;Monad - [output (&;commit (do &;Monad - [_ (&;update (i.* 3) _var) - value (&;read _var)] - (wrap value)))] - (assert "" (i.= 15 output))) - - (do promise;Monad - [output (&;commit (do &;Monad - [value (&;read _var)] - (wrap value)))] - (assert "" (i.= 15 output))) - - (do promise;Monad - [?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 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 + [_ (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)))) ))) -- cgit v1.2.3