From 2711470123106187682776034fd848d0a7a4a4b2 Mon Sep 17 00:00:00 2001 From: rrt Date: Tue, 13 Feb 2001 15:12:42 +0000 Subject: [PATCH] [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. --- ghc/tests/concurrent/should_run/Makefile | 5 +++-- ghc/tests/concurrent/should_run/conc007.hs | 2 +- ghc/tests/concurrent/should_run/conc008.hs | 2 +- ghc/tests/concurrent/should_run/conc009.hs | 2 +- ghc/tests/concurrent/should_run/conc010.hs | 4 ++-- ghc/tests/concurrent/should_run/conc012.hs | 2 +- ghc/tests/concurrent/should_run/conc014.hs | 8 ++++---- ghc/tests/concurrent/should_run/conc015.hs | 12 ++++++------ ghc/tests/concurrent/should_run/conc016.hs | 6 +++--- ghc/tests/concurrent/should_run/conc017.hs | 14 +++++++------- ghc/tests/concurrent/should_run/conc018.hs | 2 +- ghc/tests/concurrent/should_run/conc020.hs | 4 ++-- ghc/tests/concurrent/should_run/conc021.stderr-mingw | 1 + ghc/tests/concurrent/should_run/conc022.hs | 6 +++--- ghc/tests/concurrent/should_run/conc024.hs | 6 +++--- ghc/tests/concurrent/should_run/conc025.stdout | 1 + 16 files changed, 40 insertions(+), 37 deletions(-) create mode 100644 ghc/tests/concurrent/should_run/conc021.stderr-mingw diff --git a/ghc/tests/concurrent/should_run/Makefile b/ghc/tests/concurrent/should_run/Makefile index 6b0271d..4d7c4ce 100644 --- a/ghc/tests/concurrent/should_run/Makefile +++ b/ghc/tests/concurrent/should_run/Makefile @@ -1,5 +1,5 @@ #----------------------------------------------------------------------------- -# $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 diff --git a/ghc/tests/concurrent/should_run/conc007.hs b/ghc/tests/concurrent/should_run/conc007.hs index 0caada8..77421ca 100644 --- a/ghc/tests/concurrent/should_run/conc007.hs +++ b/ghc/tests/concurrent/should_run/conc007.hs @@ -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..] diff --git a/ghc/tests/concurrent/should_run/conc008.hs b/ghc/tests/concurrent/should_run/conc008.hs index b12cf16..abbdf18 100644 --- a/ghc/tests/concurrent/should_run/conc008.hs +++ b/ghc/tests/concurrent/should_run/conc008.hs @@ -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)) diff --git a/ghc/tests/concurrent/should_run/conc009.hs b/ghc/tests/concurrent/should_run/conc009.hs index d64e932..ee8017f 100644 --- a/ghc/tests/concurrent/should_run/conc009.hs +++ b/ghc/tests/concurrent/should_run/conc009.hs @@ -7,4 +7,4 @@ import Exception main = do id <- myThreadId - raiseInThread id (ErrorCall "hello") + throwTo id (ErrorCall "hello") diff --git a/ghc/tests/concurrent/should_run/conc010.hs b/ghc/tests/concurrent/should_run/conc010.hs index 661b076..bb97b96 100644 --- a/ghc/tests/concurrent/should_run/conc010.hs +++ b/ghc/tests/concurrent/should_run/conc010.hs @@ -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 diff --git a/ghc/tests/concurrent/should_run/conc012.hs b/ghc/tests/concurrent/should_run/conc012.hs index 0030742..e94d91b 100644 --- a/ghc/tests/concurrent/should_run/conc012.hs +++ b/ghc/tests/concurrent/should_run/conc012.hs @@ -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 diff --git a/ghc/tests/concurrent/should_run/conc014.hs b/ghc/tests/concurrent/should_run/conc014.hs index 650a0d7..e7b38d6 100644 --- a/ghc/tests/concurrent/should_run/conc014.hs +++ b/ghc/tests/concurrent/should_run/conc014.hs @@ -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)) diff --git a/ghc/tests/concurrent/should_run/conc015.hs b/ghc/tests/concurrent/should_run/conc015.hs index 96ce373..07b2fcd 100644 --- a/ghc/tests/concurrent/should_run/conc015.hs +++ b/ghc/tests/concurrent/should_run/conc015.hs @@ -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)) diff --git a/ghc/tests/concurrent/should_run/conc016.hs b/ghc/tests/concurrent/should_run/conc016.hs index e616a42..3990d0c 100644 --- a/ghc/tests/concurrent/should_run/conc016.hs +++ b/ghc/tests/concurrent/should_run/conc016.hs @@ -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" diff --git a/ghc/tests/concurrent/should_run/conc017.hs b/ghc/tests/concurrent/should_run/conc017.hs index 7bdaad2..4dbda4e 100644 --- a/ghc/tests/concurrent/should_run/conc017.hs +++ b/ghc/tests/concurrent/should_run/conc017.hs @@ -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)) diff --git a/ghc/tests/concurrent/should_run/conc018.hs b/ghc/tests/concurrent/should_run/conc018.hs index 56f0e9e..6ffe887 100644 --- a/ghc/tests/concurrent/should_run/conc018.hs +++ b/ghc/tests/concurrent/should_run/conc018.hs @@ -2,7 +2,7 @@ import Concurrent import Exception main = do - catchAllIO (do + Exception.catch (do m <- newMVar () putMVar m () ) diff --git a/ghc/tests/concurrent/should_run/conc020.hs b/ghc/tests/concurrent/should_run/conc020.hs index 7a3774a..29e3418 100644 --- a/ghc/tests/concurrent/should_run/conc020.hs +++ b/ghc/tests/concurrent/should_run/conc020.hs @@ -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 diff --git a/ghc/tests/concurrent/should_run/conc021.stderr-mingw b/ghc/tests/concurrent/should_run/conc021.stderr-mingw new file mode 100644 index 0000000..49ee2ae --- /dev/null +++ b/ghc/tests/concurrent/should_run/conc021.stderr-mingw @@ -0,0 +1 @@ +C:\TEMP\fptools-head\fptools\ghc\tests\concurrent\should_run\conc021.bin: main thread exited (uncaught exception) diff --git a/ghc/tests/concurrent/should_run/conc022.hs b/ghc/tests/concurrent/should_run/conc022.hs index 7e84e83..8bbeaf6 100644 --- a/ghc/tests/concurrent/should_run/conc022.hs +++ b/ghc/tests/concurrent/should_run/conc022.hs @@ -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 ()) diff --git a/ghc/tests/concurrent/should_run/conc024.hs b/ghc/tests/concurrent/should_run/conc024.hs index 0daed7e..d195b97 100644 --- a/ghc/tests/concurrent/should_run/conc024.hs +++ b/ghc/tests/concurrent/should_run/conc024.hs @@ -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) diff --git a/ghc/tests/concurrent/should_run/conc025.stdout b/ghc/tests/concurrent/should_run/conc025.stdout index e69de29..fb15692 100644 --- a/ghc/tests/concurrent/should_run/conc025.stdout +++ b/ghc/tests/concurrent/should_run/conc025.stdout @@ -0,0 +1 @@ +"Got done done" -- 1.7.10.4