[project @ 1999-05-07 11:16:37 by simonm]

Ignore exceptions in the spawned threads.

diff --git a/ghc/tests/concurrent/should_run/conc007.hs b/ghc/tests/concurrent/should_run/conc007.hs
index ccd11be..0caada8 100644 (file)
--- a/ghc/tests/concurrent/should_run/conc007.hs
+++ b/ghc/tests/concurrent/should_run/conc007.hs
@@ -3,19 +3,27 @@
 module Main where
 
 import Concurrent
+import Exception
 import IOExts
 
 choose :: a -> a -> IO a
 choose a b = do
    ready <- newMVar ()
    answer <- newEmptyMVar
-   a_id <- forkIO (a `seq` takeMVar ready >> putMVar answer a)
-   b_id <- forkIO (b `seq` takeMVar ready >> putMVar answer b)
+   a_id <- myForkIO (a `seq` takeMVar ready >> putMVar answer a)
+   b_id <- myForkIO (b `seq` takeMVar ready >> putMVar answer b)
    it <- takeMVar answer
    killThread a_id
    killThread b_id
    return it
 
+-- We need to catch the exception raised by killThread and ignore it.
+-- Otherwise the default handler will exit the program when this
+-- exception is raised in any thread.
+
+myForkIO :: IO () -> IO ThreadId
+myForkIO io = forkIO (catchAllIO io (\e -> return ()))
+
 main = do
    let big = sum [1..]
        small = sum [1..42]