[commit: ghc] master: Fix a bug in the handling of nested orElse (f184d9c)

Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/f184d9caffa09750ef6a374a7987b9213d6db28e

>---------------------------------------------------------------

commit f184d9caffa09750ef6a374a7987b9213d6db28e
Author: Simon Marlow <[email protected]>
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 [email protected]:
    
    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 0a4d0b2..e7232b7 100644
--- a/rts/STM.c
+++ b/rts/STM.c
@@ -1460,10 +1460,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(cap, 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 {