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

3 files changed, 17 insertions, 0 deletions

diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm
index 84bcea5bff..4d7baca824 100644
--- 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
index d4e76c6b1e..0b502c3bc7 100644
--- 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
new file mode 100644
index 0000000000..13b8a45c32
--- /dev/null
+++ 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
+