Repository : ssh://darcs.haskell.org//srv/darcs/testsuite On branch : master
http://hackage.haskell.org/trac/ghc/changeset/5d4ee3759a6b2e3e0c9b06fd712042f0d6b5980e >--------------------------------------------------------------- commit 5d4ee3759a6b2e3e0c9b06fd712042f0d6b5980e Author: Simon Marlow <[email protected]> Date: Fri Oct 7 14:56:46 2011 +0100 make the test fail if the sleep doesn't get interrupted (#5471) >--------------------------------------------------------------- .../concurrent/should_run/foreignInterruptible.hs | 7 +++++++ 1 files changed, 7 insertions(+), 0 deletions(-) diff --git a/tests/concurrent/should_run/foreignInterruptible.hs b/tests/concurrent/should_run/foreignInterruptible.hs index 06e96cd..ca59fbd 100644 --- a/tests/concurrent/should_run/foreignInterruptible.hs +++ b/tests/concurrent/should_run/foreignInterruptible.hs @@ -20,10 +20,17 @@ main :: IO () main = do newStablePtr stdout -- prevent stdout being finalized th <- newEmptyMVar + tid <- forkIO $ do putStrLn "newThread started" (sleep 2 >> putStrLn "fail") `catch` (\ThreadKilled -> putStrLn "pass") putMVar th "child" + + -- if the killThread below gets blocked for more than a second, then + -- this thread will kill the main thread and the test will fail. + main <- myThreadId + forkIO $ do threadDelay 1000000; throwTo main (ErrorCall "still waiting") + yield threadDelay 500000 killThread tid _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
