Follow extensible exception changes
authorIan Lynagh <igloo@earth.li>
Mon, 23 Jun 2008 19:13:32 +0000 (19:13 +0000)
committerIan Lynagh <igloo@earth.li>
Mon, 23 Jun 2008 19:13:32 +0000 (19:13 +0000)
testsuite/tests/ghc-regress/lib/IO/hClose002.hs
testsuite/tests/ghc-regress/numeric/should_run/arith011.hs
testsuite/timeout/timeout.hs

index 279924c..5f20b37 100644 (file)
@@ -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
index 6e82f79..2bb5547 100644 (file)
@@ -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)
 
index 74ba8f4..3a32280 100644 (file)
@@ -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