Commit af45af60 authored by Simon Marlow's avatar Simon Marlow
Browse files

add tests for #1048

parent 4c96813e
......@@ -10,6 +10,7 @@ test('conc003', normal, compile_and_run, [''])
test('conc006', normal, compile_and_run, [''])
test('conc027', normal, compile_and_run, [''])
test('conc051', normal, compile_and_run, [''])
test('conc069', only_ways(['ghci','threaded1','threaded2']), compile_and_run, [''])
# -----------------------------------------------------------------------------
# These tests we only do for a full run
......
......@@ -12,6 +12,7 @@ import Control.Exception
main = do
main_thread <- myThreadId
print =<< blocked
m <- newEmptyMVar
m2 <- newEmptyMVar
forkIO (do takeMVar m
......@@ -22,14 +23,15 @@ main = do
( do
block (do
putMVar m ()
print =<< blocked
sum [1..10000] `seq` -- give 'foo' a chance to be raised
(unblock (myDelay 500000))
(unblock (do print =<< blocked; myDelay 500000))
`Control.Exception.catch` (\e -> putStrLn ("caught1: " ++ show e))
)
takeMVar m2
)
`Control.Exception.catch`
(\e -> putStrLn ("caught2: " ++ show e))
(\e -> do print =<< blocked; putStrLn ("caught2: " ++ show e))
-- compensate for the fact that threadDelay is non-interruptible
-- on Windows with the threaded RTS in 6.6.
......
import Control.Concurrent
import Control.Exception
main = do
stat
m <- newEmptyMVar
forkIO (do stat; putMVar m ())
takeMVar m
block $ forkIO (do stat; putMVar m ())
takeMVar m
forkOS (do stat; putMVar m ())
takeMVar m
block $ forkOS (do stat; putMVar m ())
takeMVar m
stat = do
x <- isCurrentThreadBound
y <- blocked
print (x,y)
(True,False)
(False,False)
(False,True)
(True,False)
(True,True)
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment