diff options
author | David Terei <davidterei@gmail.com> | 2011-07-20 11:09:03 -0700 |
---|---|---|
committer | David Terei <davidterei@gmail.com> | 2011-07-20 11:26:35 -0700 |
commit | 16514f272fb42af6e9c7674a9bd6c9dce369231f (patch) | |
tree | e4f332b45fe65e2a7a2451be5674f887b42bf199 /testsuite/tests/concurrent/should_run/conc045.hs | |
parent | ebd422aed41048476aa61dd4c520d43becd78682 (diff) | |
download | haskell-16514f272fb42af6e9c7674a9bd6c9dce369231f.tar.gz |
Move tests from tests/ghc-regress/* to just tests/*
Diffstat (limited to 'testsuite/tests/concurrent/should_run/conc045.hs')
-rw-r--r-- | testsuite/tests/concurrent/should_run/conc045.hs | 39 |
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") + |