Tests for atomicReadMVar.

Signed-off-by: Edward Z. Yang <ezyang@mit.edu>

4 files changed, 52 insertions, 0 deletions

diff --git a/testsuite/tests/concurrent/should_run/all.T b/testsuite/tests/concurrent/should_run/all.T
index e10a107d9e..5665764fbc 100644
--- a/testsuite/tests/concurrent/should_run/all.T
+++ b/testsuite/tests/concurrent/should_run/all.T
@@ -74,6 +74,10 @@ test('T5611', normal, compile_and_run, [''])
 test('T5238', normal, compile_and_run, [''])
 test('T5866', exit_code(1), compile_and_run, [''])
 
+test('atomicReadMVar1', normal, compile_and_run, [''])
+test('atomicReadMVar2', normal, compile_and_run, [''])
+test('atomicReadMVar3', normal, compile_and_run, [''])
+
 # -----------------------------------------------------------------------------
 # These tests we only do for a full run
 
diff --git a/testsuite/tests/concurrent/should_run/atomicReadMVar1.hs b/testsuite/tests/concurrent/should_run/atomicReadMVar1.hs
new file mode 100644
index 0000000000..ffbcd57901
--- /dev/null
+++ b/testsuite/tests/concurrent/should_run/atomicReadMVar1.hs
@@ -0,0 +1,18 @@
+module Main where
+
+import GHC.MVar
+import Control.Concurrent
+
+main = do
+    let i = 1000000
+    m <- newMVar (0 :: Int)
+    let readloop 0 = return ()
+        readloop i = do
+            atomicReadMVar m
+            readloop (i-1)
+        writeloop 0 = return ()
+        writeloop i = do
+            readMVar m
+            writeloop (i-1)
+    forkIO $ readloop i
+    writeloop i
diff --git a/testsuite/tests/concurrent/should_run/atomicReadMVar2.hs b/testsuite/tests/concurrent/should_run/atomicReadMVar2.hs
new file mode 100644
index 0000000000..1604119e98
--- /dev/null
+++ b/testsuite/tests/concurrent/should_run/atomicReadMVar2.hs
@@ -0,0 +1,14 @@
+module Main where
+
+import GHC.MVar
+import Control.Concurrent
+
+main = do
+    m <- newEmptyMVar
+    sync <- newEmptyMVar
+    let f = atomicReadMVar m
+    t1 <- forkIO (f >> error "FAILURE")
+    t2 <- forkIO (f >> putMVar sync ())
+    killThread t1
+    putMVar m (0 :: Int)
+    atomicReadMVar sync
diff --git a/testsuite/tests/concurrent/should_run/atomicReadMVar3.hs b/testsuite/tests/concurrent/should_run/atomicReadMVar3.hs
new file mode 100644
index 0000000000..bf73914fdb
--- /dev/null
+++ b/testsuite/tests/concurrent/should_run/atomicReadMVar3.hs
@@ -0,0 +1,16 @@
+module Main where
+
+import GHC.MVar
+import Control.Concurrent
+
+-- example from
+-- http://www.haskell.org/pipermail/glasgow-haskell-users/2008-November/015878.html
+
+main = do
+    m <- newMVar (0 :: Int)
+    forkIO $ putMVar m 1
+    yield
+    r1 <- atomicReadMVar m
+    r2 <- takeMVar m
+    r3 <- takeMVar m
+    return ()