[commit: ghc] ghc-7.6: MERGED: Fix a bug in the handling of nested orElse (5ea4927)

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 <[email protected]>
Date:   Fri Dec 14 21:57:48 2012 +0000

    MERGED: Fix a bug in the handling of nested orElse
    
        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 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 {