Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : ghc-7.6
http://hackage.haskell.org/trac/ghc/changeset/5ea49271f793ed0f872342bf6a1cb0de10a48d94 >--------------------------------------------------------------- commit 5ea49271f793ed0f872342bf6a1cb0de10a48d94 Author: Ian Lynagh <i...@well-typed.com> Date: Fri Dec 14 21:57:48 2012 +0000 MERGED: Fix a bug in the handling of nested orElse commit f184d9caffa09750ef6a374a7987b9213d6db28e Author: Simon Marlow <marlo...@gmail.com> Date: Mon Dec 10 12:00:54 2012 +0000 Fix a bug in the handling of nested orElse Exposed by the following snippet, courtesy of Bas van Dijk and Patrick Palka on librar...@haskell.org: import Control.Concurrent.STM main = do x <- atomically $ do t <- newTVar 1 writeTVar t 2 ((readTVar t >> retry) `orElse` return ()) `orElse` return () readTVar t print x >--------------------------------------------------------------- rts/STM.c | 24 +++++++++++++++++++++--- 1 files changed, 21 insertions(+), 3 deletions(-) diff --git a/rts/STM.c b/rts/STM.c index f8f56a2..b988358 100644 --- a/rts/STM.c +++ b/rts/STM.c @@ -1447,10 +1447,28 @@ StgBool stmCommitNestedTransaction(Capability *cap, StgTRecHeader *trec) { StgTVar *s; s = e -> tvar; - if (entry_is_update(e)) { + + // Careful! We might have a read entry here that we don't want + // to spam over the update entry in the enclosing TRec. e.g. in + // + // t <- newTVar 1 + // writeTVar t 2 + // ((readTVar t >> retry) `orElse` return ()) `orElse` return () + // + // - the innermost txn first aborts, giving us a read-only entry + // with e->expected_value == e->new_value == 1 + // - the inner orElse commits into the outer orElse, which + // lands us here. If we unconditionally did + // merge_update_into(), then we would overwrite the outer + // TRec's update, so we must check whether the entry is an + // update or not, and if not, just do merge_read_into. + // + if (entry_is_update(e)) { unlock_tvar(trec, s, e -> expected_value, FALSE); - } - merge_update_into(cap, et, s, e -> expected_value, e -> new_value); + merge_update_into(cap, et, s, e -> expected_value, e -> new_value); + } else { + merge_read_into(cap, et, s, e -> expected_value); + } ACQ_ASSERT(s -> current_value != (StgClosure *)trec); }); } else { _______________________________________________ Cvs-ghc mailing list Cvs-ghc@haskell.org http://www.haskell.org/mailman/listinfo/cvs-ghc
