Commit 27114701 authored by rrt's avatar rrt
Browse files

[project @ 2001-02-13 15:12:42 by rrt]

Update tests not to use deprecated features (except that I had to write
Exception.catch everywhere instead of catch for some reason, because ghc
complained that catch was ambiguous (Exception. vs PrelException.).

Also add some cases to make mingwin work.
parent 67d98b90
#-----------------------------------------------------------------------------
# $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
......@@ -11,8 +11,9 @@ endif
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
......
......@@ -22,7 +22,7 @@ choose a b = do
-- 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..]
......
......@@ -9,4 +9,4 @@ import Exception
main = do
id <- myThreadId
catchAllIO (killThread id) (\e -> putStr (show e))
Exception.catch (killThread id) (\e -> putStr (show e))
......@@ -7,4 +7,4 @@ import Exception
main = do
id <- myThreadId
raiseInThread id (ErrorCall "hello")
throwTo id (ErrorCall "hello")
......@@ -22,8 +22,8 @@ main = do
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
......@@ -15,7 +15,7 @@ stackoverflow n = n + stackoverflow n
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
......
......@@ -7,10 +7,10 @@ import Exception
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))
......@@ -15,18 +15,18 @@ main = do
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))
......@@ -8,11 +8,11 @@ main = do
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"
......@@ -11,25 +11,25 @@ main = do
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))
......@@ -2,7 +2,7 @@ import Concurrent
import Exception
main = do
catchAllIO (do
Exception.catch (do
m <- newMVar ()
putMVar m ()
)
......
......@@ -3,8 +3,8 @@ import Exception
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
C:\TEMP\fptools-head\fptools\ghc\tests\concurrent\should_run\conc021.bin: main thread exited (uncaught exception)
......@@ -25,13 +25,13 @@ timeout secs action on_timeout
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
......@@ -42,5 +42,5 @@ forkIOIgnoreExceptions :: IO () -> IO ThreadId
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 ())
......@@ -8,7 +8,7 @@ import Prelude hiding (catch)
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)
Supports Markdown
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