From 73c48a994e9dcd63284a522e7ee47ebe854409c9 Mon Sep 17 00:00:00 2001 From: simonm Date: Fri, 7 May 1999 11:16:37 +0000 Subject: [PATCH] [project @ 1999-05-07 11:16:37 by simonm] Ignore exceptions in the spawned threads. --- ghc/tests/concurrent/should_run/conc007.hs | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/ghc/tests/concurrent/should_run/conc007.hs b/ghc/tests/concurrent/should_run/conc007.hs index ccd11be..0caada8 100644 --- 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] -- 1.7.10.4