Commit 1da60b56 authored by Simon Marlow's avatar Simon Marlow
Browse files

fix up tests for Windows

threadDelay is not interruptible on Windows with the threaded RTS.
Work around it in conc014, conc015 and conc017, and add a new test for
this specific failure, and mark it as an expected failure for the
relevant cases.
parent a4b7694c
......@@ -129,3 +129,11 @@ test('conc055', exit_code(1), compile_and_run, ['-package stm'])
test('conc056', only_ways(['threaded1','threaded2']), compile_and_run, ['-package stm -package network'])
test('conc057', only_ways(['threaded2']), compile_and_run, ['-O0'])
if config.platform == "i386-unknown-mingw32":
config058 = expect_fail_for(['ghci','threaded1','threaded2'])
else:
config058 = normal
test('conc058', compose(only_compiler_types(['ghc']), config058),
compile_and_run, [''])
......@@ -12,7 +12,14 @@ main = do
error "wibble"
`Control.Exception.catch`
(\e -> do putMVar m (); sum [1..10000] `seq` putStrLn "done.")
threadDelay 500000
myDelay 500000
)
`Control.Exception.catch` (\e -> putStrLn ("caught: " ++ show e))
-- compensate for the fact that threadDelay is non-interruptible
-- on Windows with the threaded RTS in 6.6.
myDelay usec = do
m <- newEmptyMVar
forkIO $ do threadDelay usec; putMVar m ()
takeMVar m
......@@ -23,10 +23,17 @@ main = do
block (do
putMVar m ()
sum [1..10000] `seq` -- give 'foo' a chance to be raised
(unblock (threadDelay 500000))
(unblock (myDelay 500000))
`Control.Exception.catch` (\e -> putStrLn ("caught1: " ++ show e))
)
takeMVar m2
)
`Control.Exception.catch`
(\e -> putStrLn ("caught2: " ++ show e))
-- compensate for the fact that threadDelay is non-interruptible
-- on Windows with the threaded RTS in 6.6.
myDelay usec = do
m <- newEmptyMVar
forkIO $ do threadDelay usec; putMVar m ()
takeMVar m
......@@ -21,7 +21,7 @@ main = do
(do putMVar m1 ()
unblock (
-- unblocked, "foo" delivered to "caught1"
threadDelay 100000
myDelay 100000
)
) `Control.Exception.catch` (\e -> putStrLn ("caught1: " ++ show e))
putMVar m2 ()
......@@ -33,3 +33,10 @@ main = do
takeMVar m3
)
`Control.Exception.catch` (\e -> putStrLn ("caught3: " ++ show e))
-- compensate for the fact that threadDelay is non-interruptible
-- on Windows with the threaded RTS in 6.6.
myDelay usec = do
m <- newEmptyMVar
forkIO $ do threadDelay usec; putMVar m ()
takeMVar m
import Control.Concurrent
import Control.Exception
-- variation on conc020 that tests for threadDelay being interruptible.
-- On Windows, with the threaded RTS, in 6.6 and earlier, threadDelay is
-- not interruptible.
main = do
m <- newEmptyMVar
t <- forkIO (block $ threadDelay 1000000)
threadDelay 100000
throwTo t (ErrorCall "I'm Interruptible")
threadDelay 100000
putMVar m () -- to avoid t being garbage collected
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