diff options
Diffstat (limited to 'testsuite/tests/concurrent/should_run/conc032.hs')
| -rw-r--r-- | testsuite/tests/concurrent/should_run/conc032.hs | 74 |
1 files changed, 74 insertions, 0 deletions
diff --git a/testsuite/tests/concurrent/should_run/conc032.hs b/testsuite/tests/concurrent/should_run/conc032.hs new file mode 100644 index 0000000000..42149ff477 --- /dev/null +++ b/testsuite/tests/concurrent/should_run/conc032.hs @@ -0,0 +1,74 @@ +-- !!! this test exposed a bug in the take/putMVar implementation in +-- !!! GHC 5.00. It involves multiple blocking takes & puts on the +-- !!! same MVar. + +import Control.Concurrent +import System.IO.Unsafe + +awk True True z = 1 +awk False y True = 2 +awk x False False = 3 + +awk'1 True True z = 1 +awk'2 False y True = 2 +awk'3 x False False = 3 + +awk' x y z | ppm [a1'1,a1'2,a1'3] (x,y,z) = awk'1 x y z + | ppm [a2'1,a2'2,a2'3] (x,y,z) = awk'2 x y z + | ppm [a3'1,a3'2,a3'3] (x,y,z) = awk'3 x y z + | otherwise = 0 + +a1'1 (True,y,z) s = s True +a1'1 (x,y,z) s = s False + +a1'2 (x,True,z) s = s True +a1'2 (x,y,z) s = s False + +a1'3 (x,y,z) s = s True + +a2'1 (False,y,z) s = s True +a2'1 (x,y,z) s = s False + +a2'2 (x,y,z) s = s True + +a2'3 (x,y,True) s = s True +a2'3 (x,y,z) s = s False + +a3'1 (x,y,z) s = s True + +a3'2 (x,False,z) s = s True +a3'2 (x,y,z) s = s False + +a3'3 (x,y,False) s = s True +a3'3 (x,y,z) s = s False + +ppm fs as = unsafePerformIO (ppm' fs as) + +ppm' fs as = do m <- newEmptyMVar + let s = putMVar m + hs <- sequence [forkIO (f as s)|f <- fs] + result <- assess (length fs) m + sequence (map killThread hs) + return result + where assess 0 m = return True + assess n m = do h <- takeMVar m + if h then (assess (n-1) m) + else return False + +main = do sequence [putStrLn (show (awk' x y z))|(x,y,z) <- args] + where args = [ + (t,t,t), + (t,t,f), + (t,f,t), + (t,f,f), + (f,t,t), + (f,t,f), + (f,f,t), + (f,f,f), + (t,t,n) + --(f,n,t), + --(n,f,f), + ] + t = True + f = False + n = odd (last [1..]) |