#-----------------------------------------------------------------------------
-# $Id: Makefile,v 1.9 2000/11/03 16:23:37 simonmar Exp $
+# $Id: Makefile,v 1.10 2001/02/13 15:12:42 rrt Exp $
TOP = ../..
include $(TOP)/mk/boilerplate.mk
include $(TOP)/mk/should_run.mk
+conc007_RUNTEST_OPTS = +RTS -H128M -RTS
conc009_RUNTEST_OPTS = -x 1
-conc021_RUNTEST_OPTS = -x 250
+conc021_RUNTEST_OPTS = -x 250 -o2 conc021.stderr-mingw
SRC_HC_OPTS += -dcore-lint -package concurrent -fglasgow-exts
-- exception is raised in any thread.
myForkIO :: IO () -> IO ThreadId
-myForkIO io = forkIO (catchAllIO io (\e -> return ()))
+myForkIO io = forkIO (Exception.catch io (\e -> return ()))
main = do
let big = sum [1..]
main = do
id <- myThreadId
- catchAllIO (killThread id) (\e -> putStr (show e))
+ Exception.catch (killThread id) (\e -> putStr (show e))
main = do
id <- myThreadId
- raiseInThread id (ErrorCall "hello")
+ throwTo id (ErrorCall "hello")
block <- newEmptyMVar
ready <- newEmptyMVar
ready2 <- newEmptyMVar
- id <- forkIO (catchAllIO (putMVar ready () >> takeMVar block)
+ id <- forkIO (Exception.catch (putMVar ready () >> takeMVar block)
(\e -> putStr (show e) >> putMVar ready2 ()))
takeMVar ready
- raiseInThread id (ErrorCall "hello")
+ throwTo id (ErrorCall "hello")
takeMVar ready2
main = do
let x = stackoverflow 1
result <- newEmptyMVar
- forkIO (catchAllIO (x `seq` putMVar result Finished)
+ forkIO (Exception.catch (x `seq` putMVar result Finished)
(\e -> putMVar result (Died e)))
res <- takeMVar result
case res of
main = do
main_thread <- myThreadId
m <- newEmptyMVar
- forkIO (do { takeMVar m; raiseInThread main_thread (ErrorCall "foo") })
+ forkIO (do { takeMVar m; throwTo main_thread (ErrorCall "foo") })
(error "wibble")
- `catchAllIO` (\e -> do putMVar m ()
- sum [1..10000] `seq` putStrLn "done.")
+ `Exception.catch` (\e -> do putMVar m ()
+ sum [1..10000] `seq` putStrLn "done.")
(threadDelay 500000)
- `catchAllIO` (\e -> putStrLn ("caught: " ++ show e))
+ `Exception.catch` (\e -> putStrLn ("caught: " ++ show e))
m <- newEmptyMVar
m2 <- newEmptyMVar
forkIO (do takeMVar m
- raiseInThread main_thread (ErrorCall "foo")
- raiseInThread main_thread (ErrorCall "bar")
+ throwTo main_thread (ErrorCall "foo")
+ throwTo main_thread (ErrorCall "bar")
putMVar m2 ()
)
( do
- blockAsyncExceptions (do
+ block (do
putMVar m ()
sum [1..10000] `seq` -- give 'foo' a chance to be raised
- (unblockAsyncExceptions (threadDelay 500000))
- `catchAllIO` (\e -> putStrLn ("caught1: " ++ show e))
+ (unblock (threadDelay 500000))
+ `Exception.catch` (\e -> putStrLn ("caught1: " ++ show e))
)
takeMVar m2
)
- `catchAllIO`
+ `Exception.catch`
(\e -> putStrLn ("caught2: " ++ show e))
m <- newEmptyMVar
sub_thread <- forkIO (do
takeMVar m
- raiseInThread main_thread (ErrorCall "foo")
+ throwTo main_thread (ErrorCall "foo")
)
- blockAsyncExceptions (do
+ block (do
putMVar m ()
sum [1..10000] `seq` -- to be sure the other thread is now blocked
- killThread sub_thread
+ killThread sub_thread
)
putStrLn "ok"
m3 <- newEmptyMVar
forkIO (do
takeMVar m1
- raiseInThread main_thread (ErrorCall "foo")
+ throwTo main_thread (ErrorCall "foo")
takeMVar m2
- raiseInThread main_thread (ErrorCall "bar")
+ throwTo main_thread (ErrorCall "bar")
putMVar m3 ()
)
(do
- blockAsyncExceptions (do
+ block (do
(do putMVar m1 ()
- unblockAsyncExceptions (
+ unblock (
-- unblocked, "foo" delivered to "caught1"
threadDelay 100000
)
- ) `catchAllIO` (\e -> putStrLn ("caught1: " ++ show e))
+ ) `Exception.catch` (\e -> putStrLn ("caught1: " ++ show e))
putMVar m2 ()
-- blocked here, "bar" can't be delivered
(sum [1..10000] `seq` return ())
- `catchAllIO` (\e -> putStrLn ("caught2: " ++ show e))
+ `Exception.catch` (\e -> putStrLn ("caught2: " ++ show e))
)
-- unblocked here, "bar" delivered to "caught3"
takeMVar m3
)
- `catchAllIO` (\e -> putStrLn ("caught3: " ++ show e))
+ `Exception.catch` (\e -> putStrLn ("caught3: " ++ show e))
import Exception
main = do
- catchAllIO (do
+ Exception.catch (do
m <- newMVar ()
putMVar m ()
)
main = do
m <- newEmptyMVar
- t <- forkIO (blockAsyncExceptions $ takeMVar m)
+ t <- forkIO (block $ takeMVar m)
threadDelay 100000
- raiseInThread t (ErrorCall "I'm Interruptible")
+ throwTo t (ErrorCall "I'm Interruptible")
threadDelay 100000
putMVar m () -- to avoid t being garbage collected
--- /dev/null
+C:\TEMP\fptools-head\fptools\ghc\tests\concurrent\should_run\conc021.bin: main thread exited (uncaught exception)
threadid <- myThreadId
timeout <- forkIOIgnoreExceptions (
do threadDelay (secs * 1000000)
- raiseInThread threadid (ErrorCall "__timeout")
+ throwTo threadid (ErrorCall "__timeout")
)
( do result <- action
killThread timeout
return result
)
- `catchAllIO`
+ `Exception.catch`
( \exception -> case exception of
ErrorCall "__timeout" -> on_timeout
_other -> do
forkIOIgnoreExceptions action = IO $ \ s ->
case (fork# action_plus s) of (# s1, id #) -> (# s1, ThreadId id #)
where
- action_plus = catchAllIO action (\_ -> return ())
+ action_plus = Exception.catch action (\_ -> return ())
main = do
id <- myThreadId
- forkIO (catchAllIO (do m <- newEmptyMVar; takeMVar m)
- (\e -> raiseInThread id e))
- catchAllIO (print (sum [1..1000000]))
+ forkIO (catch (do m <- newEmptyMVar; takeMVar m)
+ (\e -> throwTo id e))
+ catch (print (sum [1..1000000]))
(\e -> print e)