Move tests from tests/ghc-regress/* to just tests/*

1 files changed, 39 insertions, 0 deletions

diff --git a/testsuite/tests/concurrent/should_run/conc045.hs b/testsuite/tests/concurrent/should_run/conc045.hs
new file mode 100644
index 0000000000..4ab585eef3
--- /dev/null
+++ b/testsuite/tests/concurrent/should_run/conc045.hs
@@ -0,0 +1,39 @@
+module Main where
+
+import GHC.Conc
+import Control.Concurrent
+
+snapshot t1 t2 = atomically ( do v1 <- readTVar t1
+                                 v2 <- readTVar t2
+                                 return (v1, v2) )
+
+twiddle mv _ _ 0 = putMVar mv ()
+twiddle mv t1 t2 n = do atomically ( do v1 <- readTVar t1
+                                        v2 <- readTVar t2
+                                        writeTVar t2 (v1+1)
+                                        writeTVar t1 (v2+1) )
+                        twiddle mv t1 t2 (n-1)
+                  
+
+-- Contended updates to a pair of TVars 
+main = do
+  putStr "Before\n"
+  (t1,t2) <- atomically ( do t1 <- newTVar 0
+                             t2 <- newTVar 1
+                             return (t1, t2))
+
+  -- MVars used to signal completion 
+  t1c <- newEmptyMVar
+  t2c <- newEmptyMVar
+
+  forkIO (twiddle t1c t1 t2 1000)
+  forkIO (twiddle t2c t1 t2 1000)
+
+  -- Wait for threads to exit
+  takeMVar t1c
+  takeMVar t2c
+
+  -- Display final state
+  (r1,r2) <- snapshot t1 t2 
+  putStr ("After " ++ (show r1) ++ " , " ++ (show r2) ++ "\n")
+