MERGED: Fix a bug in the handling of nested orElse
authorIan Lynagh <ian@well-typed.com>
Fri, 14 Dec 2012 21:57:48 +0000 (21:57 +0000)
committerIan Lynagh <ian@well-typed.com>
Fri, 14 Dec 2012 21:57:48 +0000 (21:57 +0000)
    commit f184d9caffa09750ef6a374a7987b9213d6db28e
    Author: Simon Marlow <marlowsd@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 libraries@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

index f8f56a2..b988358 100644 (file)
--- 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 {