Fix missing unlockClosure() call in tryReadMVar (#9148)

lortabac · May 30, 2014 · 96a95f0 · 96a95f0
1 parent 660c3f9
commit 96a95f0
Show file tree

Hide file tree

Showing 3 changed files with 17 additions and 0 deletions.
diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm
@@ -1786,6 +1786,7 @@ stg_tryReadMVarzh ( P_ mvar, /* :: MVar a */ )
     LOCK_CLOSURE(mvar, info);
 
     if (StgMVar_value(mvar) == stg_END_TSO_QUEUE_closure) {
+        unlockClosure(mvar, info);
         return (0, stg_NO_FINALIZER_closure);
     }
 

diff --git a/testsuite/tests/concurrent/should_run/all.T b/testsuite/tests/concurrent/should_run/all.T
@@ -78,6 +78,7 @@ test('readMVar1', normal, compile_and_run, [''])
 test('readMVar2', normal, compile_and_run, [''])
 test('readMVar3', normal, compile_and_run, [''])
 test('tryReadMVar1', normal, compile_and_run, [''])
+test('tryReadMVar2', normal, compile_and_run, [''])
 
 test('T7970', normal, compile_and_run, [''])
 

diff --git a/testsuite/tests/concurrent/should_run/tryReadMVar2.hs b/testsuite/tests/concurrent/should_run/tryReadMVar2.hs
@@ -0,0 +1,15 @@
+module Main where
+
+import Control.Concurrent
+import Control.Monad
+
+main = do
+    m <- newEmptyMVar
+    done <- newEmptyMVar
+    let q = 200000
+    forkIO (do mapM (\n -> putMVar m n) [1..q]; putMVar done ())
+    forkIO (do replicateM_ q $ readMVar m; putMVar done ())
+    forkIO (do replicateM_ q $ tryReadMVar m; putMVar done ())
+    forkIO (do replicateM_ q $ takeMVar m; putMVar done ())
+    replicateM_ 4 $ takeMVar done
+