[commit: testsuite] master: Tests for atomicReadMVar. (1cb6aee)

[Edward Z. Yang]

Repository : ssh://darcs.haskell.org//srv/darcs/testsuite

On branch  : master

https://github.com/ghc/testsuite/commit/1cb6aee7fd81175fe0af81146e878aaf7cda87d2

>---------------------------------------------------------------

commit 1cb6aee7fd81175fe0af81146e878aaf7cda87d2
Author: Edward Z. Yang <ezyang at mit.edu>
Date:   Fri Jun 14 14:21:02 2013 -0700

    Tests for atomicReadMVar.
    
    Signed-off-by: Edward Z. Yang <ezyang at mit.edu>

>---------------------------------------------------------------

 tests/concurrent/should_run/all.T              |    4 ++++
 tests/concurrent/should_run/atomicReadMVar1.hs |   18 ++++++++++++++++++
 tests/concurrent/should_run/atomicReadMVar2.hs |   14 ++++++++++++++
 tests/concurrent/should_run/atomicReadMVar3.hs |   16 ++++++++++++++++
 4 files changed, 52 insertions(+), 0 deletions(-)

diff --git a/tests/concurrent/should_run/all.T b/tests/concurrent/should_run/all.T
index e10a107..5665764 100644
--- a/tests/concurrent/should_run/all.T
+++ b/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/tests/concurrent/should_run/atomicReadMVar1.hs b/tests/concurrent/should_run/atomicReadMVar1.hs
new file mode 100644
index 0000000..ffbcd57
--- /dev/null
+++ b/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/tests/concurrent/should_run/atomicReadMVar2.hs b/tests/concurrent/should_run/atomicReadMVar2.hs
new file mode 100644
index 0000000..1604119
--- /dev/null
+++ b/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/tests/concurrent/should_run/atomicReadMVar3.hs b/tests/concurrent/should_run/atomicReadMVar3.hs
new file mode 100644
index 0000000..bf73914
--- /dev/null
+++ b/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 ()