[commit: testsuite] master: Test for #7815 (fe604b0)

[Ian Lynagh]

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

On branch  : master

https://github.com/ghc/testsuite/commit/fe604b0c91c8d3f25fde435c08269f2548191125

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

commit fe604b0c91c8d3f25fde435c08269f2548191125
Author: Ryan Yates <ryates at cs.rochester.edu>
Date:   Mon Apr 8 21:45:22 2013 -0400

    Test for #7815
    
    This test differes slightly from the code in the ticket, but the
    simplification betters the chances of seeing the error.  Instead of
    looking for the error with an additional tranaction, when error appears
    only one `reset` can complete and the other is blocked on STM raising an
    exception.

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

 tests/rts/T7815.hs |   29 +++++++++++++++++++++++++++++
 tests/rts/all.T    |    5 +++++
 2 files changed, 34 insertions(+), 0 deletions(-)

diff --git a/tests/rts/T7815.hs b/tests/rts/T7815.hs
new file mode 100644
index 0000000..2710da1
--- /dev/null
+++ b/tests/rts/T7815.hs
@@ -0,0 +1,29 @@
+import GHC.Conc.Sync
+import Control.Monad
+import System.Environment
+
+test n = do
+  dog <- newTVarIO False
+  cat <- newTVarIO False
+  let unset = do
+        d <- readTVar dog
+        c <- readTVar cat
+        if (d || c) then retry else return ()
+      setDog = unset >> writeTVar dog True
+      setCat = unset >> writeTVar cat True
+      reset = do
+        d <- readTVar dog
+        c <- readTVar cat
+        guard (d || c)
+        writeTVar dog False
+        writeTVar cat False
+  
+  replicateM_ n (do
+    forkIO (atomically setDog)
+    forkIO (atomically setCat)
+    atomically reset
+    atomically reset)
+
+main = do
+  [n] <- getArgs
+  test (read n :: Int)
diff --git a/tests/rts/all.T b/tests/rts/all.T
index 3a73054..f345b3b 100644
--- a/tests/rts/all.T
+++ b/tests/rts/all.T
@@ -165,3 +165,8 @@ test('T7636', [ exit_code(1), extra_run_opts('100000') ], compile_and_run, ['']
 test('stablename001', expect_fail_for(['hpc']), compile_and_run, [''])
 # hpc should fail this, because it tags every variable occurrence with
 # a different tick.  It's probably a bug if it works, hence expect_fail.
+
+# Run this test alone (via, high_memory_usage) to increase chances of seeing the race.
+test('T7815', [ high_memory_usage,
+                extra_run_opts('50000 +RTS -N2 -RTS'),
+                only_ways(['threaded1', 'threaded2']) ], compile_and_run, [''] )