Follow extensible exception changes

3 files changed, 16 insertions, 11 deletions

diff --git a/testsuite/tests/ghc-regress/lib/IO/hClose002.hs b/testsuite/tests/ghc-regress/lib/IO/hClose002.hs
index 279924c2ce..5f20b37f24 100644
--- a/testsuite/tests/ghc-regress/lib/IO/hClose002.hs
+++ b/testsuite/tests/ghc-regress/lib/IO/hClose002.hs
@@ -11,14 +11,18 @@ main = do
   naughtyClose h
         -- first hClose will raise an exception, but close the
         -- Handle anyway:
-  try (hClose h) >>= print
+  showPossibleException (hClose h)
         -- second hClose should success (Handle is already closed)
-  try (hClose h) >>= print
+  showPossibleException (hClose h)
         -- this should succeed (checking that the lock on the file has
         -- been released:
   h <- openFile "hClose002.tmp" ReadMode
-  try (hClose h) >>= print
-  try (hClose h) >>= print
+  showPossibleException (hClose h)
+  showPossibleException (hClose h)
+
+showPossibleException :: IO () -> IO ()
+showPossibleException f = do e <- try f
+                             print (e :: Either SomeException ())
 
 naughtyClose h = 
   withHandle_ "naughtyClose" h $ \ h_ -> do
diff --git a/testsuite/tests/ghc-regress/numeric/should_run/arith011.hs b/testsuite/tests/ghc-regress/numeric/should_run/arith011.hs
index 6e82f792d0..2bb554756a 100644
--- a/testsuite/tests/ghc-regress/numeric/should_run/arith011.hs
+++ b/testsuite/tests/ghc-regress/numeric/should_run/arith011.hs
@@ -98,7 +98,7 @@ table2 nm op xs ys = do
            ]
   putStrLn "#"
  where
-  op' x y = do s <- Control.Exception.catch (evaluate (show (op x y))) 
+  op' x y = do s <- Control.Exception.catchAny (evaluate (show (op x y))) 
 					    (return . show)
 	       putStrLn (show x ++ " " ++ nm ++ " " ++ show y ++ " = " ++ s)
 
diff --git a/testsuite/timeout/timeout.hs b/testsuite/timeout/timeout.hs
index 74ba8f4a00..3a32280cf2 100644
--- a/testsuite/timeout/timeout.hs
+++ b/testsuite/timeout/timeout.hs
@@ -2,7 +2,8 @@
 
 import Control.Concurrent (forkIO, threadDelay)
 import Control.Concurrent.MVar (putMVar, takeMVar, newEmptyMVar)
-import Control.Exception (try)
+import Control.Exception (ignoreExceptions, catchAny, throw, catch)
+import Control.OldException (Exception(ExitException), catch)
 import Data.Maybe (isNothing)
 import System.Cmd (system)
 import System.Environment (getArgs)
@@ -45,12 +46,12 @@ run secs cmd = do
         forkIO (do threadDelay (secs * 1000000)
                    putMVar m Nothing
                )
-        forkIO (do try (do pid <- systemSession cmd
+        forkIO (ignoreExceptions (do
+                           pid <- systemSession cmd
                            ph <- mkProcessHandle pid
                            putMVar mp (pid,ph)
                            r <- waitForProcess ph
-                           putMVar m (Just r))
-                   return ())
+                           putMVar m (Just r)))
 
         (pid,ph) <- takeMVar mp
         r <- takeMVar m
@@ -73,7 +74,7 @@ systemSession cmd =
    -- more threads.
 
 killProcess pid ph = do
-  try (signalProcessGroup sigTERM pid)
+  ignoreExceptions (signalProcessGroup sigTERM pid)
   checkReallyDead 10
   where
     checkReallyDead 0 = hPutStrLn stderr "checkReallyDead: Giving up"
@@ -81,7 +82,7 @@ killProcess pid ph = do
       do threadDelay (3*100000) -- 3/10 sec
          m <- getProcessExitCode ph
          when (isNothing m) $ do
-             try (signalProcessGroup sigKILL pid)
+             ignoreExceptions (signalProcessGroup sigKILL pid)
              checkReallyDead n
 
 #else