Update tests following OldException removal
authorIan Lynagh <igloo@earth.li>
Sat, 18 Feb 2012 15:23:54 +0000 (15:23 +0000)
committerIan Lynagh <igloo@earth.li>
Sat, 18 Feb 2012 15:23:54 +0000 (15:23 +0000)
Some redundant test have now been removed

12 files changed:
testsuite/tests/lib/OldException/Makefile [deleted file]
testsuite/tests/lib/OldException/OldException001.hs [deleted file]
testsuite/tests/lib/OldException/OldException001.stdout [deleted file]
testsuite/tests/lib/OldException/all.T [deleted file]
testsuite/tests/lib/exceptions/Makefile [deleted file]
testsuite/tests/lib/exceptions/all.T [deleted file]
testsuite/tests/lib/exceptions/exceptions001.hs [deleted file]
testsuite/tests/lib/should_run/exceptionsrun001.hs
testsuite/tests/lib/should_run/exceptionsrun001.stdout
testsuite/tests/lib/should_run/exceptionsrun002.hs
testsuite/tests/safeHaskell/unsafeLibs/GoodImport03.hs
testsuite/tests/safeHaskell/unsafeLibs/GoodImport03.stderr [deleted file]

diff --git a/testsuite/tests/lib/OldException/Makefile b/testsuite/tests/lib/OldException/Makefile
deleted file mode 100644 (file)
index 4a26853..0000000
+++ /dev/null
@@ -1,4 +0,0 @@
-TOP=../../..
-include $(TOP)/mk/boilerplate.mk
-include $(TOP)/mk/test.mk
-
diff --git a/testsuite/tests/lib/OldException/OldException001.hs b/testsuite/tests/lib/OldException/OldException001.hs
deleted file mode 100644 (file)
index 150dc2a..0000000
+++ /dev/null
@@ -1,22 +0,0 @@
-
--- trace #2913
-
-{-# LANGUAGE DeriveDataTypeable #-}
-
-import qualified Control.Exception as New
-import qualified Control.OldException as Old
-
-import Data.Typeable
-
-data MyException = MyException
-    deriving (Eq, Show, Typeable)
-
-instance New.Exception MyException
-
-main :: IO ()
-main = (New.throwIO MyException
-            `Old.catch`
-            (\e -> do putStrLn ("Old got " ++ show e)
-                      Old.throw e)
-       ) `New.catch` (\e -> putStrLn ("New got " ++ show (e :: MyException)))
-
diff --git a/testsuite/tests/lib/OldException/OldException001.stdout b/testsuite/tests/lib/OldException/OldException001.stdout
deleted file mode 100644 (file)
index ba73072..0000000
+++ /dev/null
@@ -1,2 +0,0 @@
-Old got exception :: SomeException
-New got MyException
diff --git a/testsuite/tests/lib/OldException/all.T b/testsuite/tests/lib/OldException/all.T
deleted file mode 100644 (file)
index 5545982..0000000
+++ /dev/null
@@ -1,3 +0,0 @@
-
-test('OldException001', normal, compile_and_run, [''])
-
diff --git a/testsuite/tests/lib/exceptions/Makefile b/testsuite/tests/lib/exceptions/Makefile
deleted file mode 100644 (file)
index 9101fbd..0000000
+++ /dev/null
@@ -1,3 +0,0 @@
-TOP=../../..
-include $(TOP)/mk/boilerplate.mk
-include $(TOP)/mk/test.mk
diff --git a/testsuite/tests/lib/exceptions/all.T b/testsuite/tests/lib/exceptions/all.T
deleted file mode 100644 (file)
index 04b3a7f..0000000
+++ /dev/null
@@ -1 +0,0 @@
-test('exceptions001', normal, compile_and_run, [''])
diff --git a/testsuite/tests/lib/exceptions/exceptions001.hs b/testsuite/tests/lib/exceptions/exceptions001.hs
deleted file mode 100644 (file)
index f5fcbf0..0000000
+++ /dev/null
@@ -1,7 +0,0 @@
-
--- trac #2508
-
-import System.Exit
-import Control.OldException
-
-main = exitWith ExitSuccess `finally` return ()
index 9c6febc..c858ba5 100644 (file)
@@ -1,7 +1,8 @@
 module Main where
 
 import Prelude hiding (catch)
-import Control.OldException 
+import Control.Exception
+import System.IO.Error hiding (catch, try)
 
 main = do
   ioTest
@@ -9,48 +10,38 @@ main = do
   noMethodTest
   patMatchTest
   guardTest
-  dynTest
 
 ioTest :: IO ()
-ioTest = catchJust userErrors (ioError (userError "wibble")) 
-          (\ex -> putStr "user exception caught\n")
+ioTest = catchJust (\e -> if isUserError e then Just () else Nothing)
+                   (ioError (userError "wibble"))
+                   (\() -> putStrLn "user exception caught")
 
 errorTest :: IO ()
-errorTest = try (evaluate (1 + error "call to 'error'")) >>= \r ->
-           case r of
-               Left exception -> putStr "error call caught\n"
-               Right _        -> error "help!"
+errorTest = do r <- try (evaluate (1 + error "call to 'error'"))
+               case r of
+                   Left (ErrorCall _) -> putStrLn "error call caught"
+                   Right _            -> error "help!"
 
 instance (Show a, Eq a) => Num (Maybe a) where {}
 
 noMethodTest :: IO ()
-noMethodTest = try (evaluate (Just () + Just ())) >>= \ r ->
-       case r of
-               Left (NoMethodError err) -> putStr "no method error\n"
-               Right _                  -> error "help!"
+noMethodTest = do r <- try (evaluate (Just () + Just ()))
+                  case r of
+                      Left (NoMethodError err) -> putStrLn "no method error"
+                      Right _                  -> error "help!"
 
 patMatchTest :: IO ()
 patMatchTest = catch (case test1 [1..10] of () -> return ())
   (\ex -> case ex of
-               PatternMatchFail err -> putStr err
-               other                -> error "help!")
-                 
+          PatternMatchFail err -> putStr err
+          _                    -> error "help!")
+
 test1 [] = ()
 
 guardTest = catch (case test2 of () -> return ())
-  (\ex -> case ex of
-               PatternMatchFail err -> putStr err
-               other                -> error "help!")
+                  (\ex -> case ex of
+                          PatternMatchFail err -> putStr err
+                          _                    -> error "help!")
 
 test2 | all (==0) [1] = ()
 
-dynTest = catchDyn (case throwDyn (42::Int, (+1)::Int->Int) of () -> return ())
-  (\(i,f) -> let x = f (i::Int) :: Int in putStr (show x))
-
-{-
-recSelTest
-recConTest
-recUpdTest
-assertTest
-arithTest
--}
index 2d1930f..a84f33a 100644 (file)
@@ -1,6 +1,5 @@
 user exception caught
 error call caught
 no method error
-exceptionsrun001.hs:38:1-13: Non-exhaustive patterns in function test1
-exceptionsrun001.hs:45:1-26: Non-exhaustive patterns in function test2
-43
\ No newline at end of file
+exceptionsrun001.hs:39:1-13: Non-exhaustive patterns in function test1
+exceptionsrun001.hs:46:1-26: Non-exhaustive patterns in function test2
index 13b642a..9503001 100644 (file)
 module Main where
-       {
-       import qualified Control.OldException as Exception;
-       import Data.IORef;
-       import Prelude;
 
-       safeCatch :: IO () -> IO ();
-       safeCatch f = Exception.catch f (\_ -> return ());
+import qualified Control.Exception as Exception
+import System.IO.Error (mkIOError)
+import Data.IORef
+import Prelude
 
-       type Thrower = IO Bool;
+safeCatch :: IO () -> IO ()
+safeCatch f = Exception.catch f
+                  ((\_ -> return ()) :: Exception.SomeException -> IO ())
 
-       type Catcher = IO Bool -> IO () -> IO ();
+type Thrower = IO Bool
 
-       checkCatch :: Catcher -> Thrower -> IO Bool;
-       checkCatch catcher thrower = do
-               {
-               ref <- newIORef False;
-               safeCatch (catcher thrower (writeIORef ref True));
-               readIORef ref;
-               };
+type Catcher = IO Bool -> IO () -> IO ()
 
-       data Named a = MkNamed String a;
+checkCatch :: Catcher -> Thrower -> IO Bool
+checkCatch catcher thrower = do
+    ref <- newIORef False
+    safeCatch (catcher thrower (writeIORef ref True))
+    readIORef ref
 
-       checkNamedCatch :: Named Catcher -> Named Thrower -> IO ();
-       checkNamedCatch (MkNamed cname catcher) (MkNamed tname thrower) = do
-               {
-               didCatch <- checkCatch catcher thrower;
-               putStrLn (cname ++ (if didCatch then " CAUGHT " else " MISSED ") ++ tname);
-               };
+data Named a = MkNamed String a
 
-       checkNamedCatches :: [Named Catcher] -> [Named Thrower] -> IO ();
-       checkNamedCatches [] _ = return ();
-       checkNamedCatches _ [] = return ();
-       checkNamedCatches [c] (t:tr) = do
-               {
-               checkNamedCatch c t;
-               checkNamedCatches [c] tr;
-               };
-       checkNamedCatches (c:cr) ts = do
-               {
-               checkNamedCatches [c] ts;
-               checkNamedCatches cr ts
-               };
+checkNamedCatch :: Named Catcher -> Named Thrower -> IO ()
+checkNamedCatch (MkNamed cname catcher) (MkNamed tname thrower) = do
+    didCatch <- checkCatch catcher thrower
+    putStrLn (cname ++ (if didCatch then " CAUGHT " else " MISSED ") ++ tname)
 
+checkNamedCatches :: [Named Catcher] -> [Named Thrower] -> IO ()
+checkNamedCatches []     _      = return ()
+checkNamedCatches _      []     = return ()
+checkNamedCatches [c]    (t:tr) = do checkNamedCatch c t
+                                     checkNamedCatches [c] tr
+checkNamedCatches (c:cr) ts     = do checkNamedCatches [c] ts
+                                     checkNamedCatches cr ts
 
-       -- throwers
 
-       returnThrower :: Named Thrower;
-       returnThrower = MkNamed "return" (return True);
+-- throwers
 
-       returnUndefinedThrower :: Named Thrower;
-       returnUndefinedThrower = MkNamed "return undefined" (return undefined);
+returnThrower :: Named Thrower
+returnThrower = MkNamed "return" (return True)
 
-       returnErrorThrower :: Named Thrower;
-       returnErrorThrower = MkNamed "return error" (return (error "some error"));
+returnUndefinedThrower :: Named Thrower
+returnUndefinedThrower = MkNamed "return undefined" (return undefined)
 
-       undefinedThrower :: Named Thrower;
-       undefinedThrower = MkNamed "undefined" undefined;
+returnErrorThrower :: Named Thrower
+returnErrorThrower = MkNamed "return error" (return (error "some error"))
 
-       failThrower :: Named Thrower;
-       failThrower = MkNamed "fail" (fail "some failure");
+undefinedThrower :: Named Thrower
+undefinedThrower = MkNamed "undefined" undefined
 
-       errorThrower :: Named Thrower;
-       errorThrower = MkNamed "error" (error "some error");
+failThrower :: Named Thrower
+failThrower = MkNamed "fail" (fail "some failure")
 
-       throwThrower :: Named Thrower;
-       throwThrower = MkNamed "Exception.throw"
-        (Exception.throw (Exception.ErrorCall "throw error"));
+errorThrower :: Named Thrower
+errorThrower = MkNamed "error" (error "some error")
 
-       ioErrorErrorCallThrower :: Named Thrower;
-       ioErrorErrorCallThrower = MkNamed "ioError ErrorCall"
-        (Exception.throwIO (Exception.ErrorCall "throw error"));
+throwThrower :: Named Thrower
+throwThrower = MkNamed "Exception.throw"
+ (Exception.throw (Exception.ErrorCall "throw error"))
 
-       ioErrorIOExceptionThrower :: Named Thrower;
-       ioErrorIOExceptionThrower = MkNamed "ioError IOException"
-        (Exception.throwIO (Exception.IOException undefined));
+ioErrorErrorCallThrower :: Named Thrower
+ioErrorErrorCallThrower = MkNamed "ioError ErrorCall"
+ (Exception.throwIO (Exception.ErrorCall "throw error"))
 
-       returnThrowThrower :: Named Thrower;
-       returnThrowThrower = MkNamed "return Exception.throw"
-        (return (Exception.throw (Exception.ErrorCall "throw error")));
+ioErrorIOExceptionThrower :: Named Thrower
+ioErrorIOExceptionThrower = MkNamed "ioError IOException"
+ (Exception.throwIO (mkIOError undefined undefined undefined undefined))
 
+returnThrowThrower :: Named Thrower
+returnThrowThrower = MkNamed "return Exception.throw"
+ (return (Exception.throw (Exception.ErrorCall "throw error")))
 
-       -- catchers
 
-       bindCatcher :: Named Catcher;
-       bindCatcher = MkNamed ">>" (>>);
+-- catchers
 
-       preludeCatchCatcher :: Named Catcher;
-       preludeCatchCatcher = MkNamed "Prelude.catch"
-        (\f cc -> Prelude.catch (f >> (return ())) (const cc));
+bindCatcher :: Named Catcher
+bindCatcher = MkNamed ">>" (>>)
 
-       ceCatchCatcher :: Named Catcher;
-       ceCatchCatcher = MkNamed "Exception.catch"
-        (\f cc -> Exception.catch (f >> (return ())) (const cc));
+preludeCatchCatcher :: Named Catcher
+preludeCatchCatcher = MkNamed "Prelude.catch"
+ (\f cc -> Prelude.catch (f >> (return ())) (const cc))
 
-       finallyCatcher :: Named Catcher;
-       finallyCatcher = MkNamed "Exception.finally"
-        (\f cc -> Exception.finally (f >> (return ())) cc);
+ceCatchCatcher :: Named Catcher
+ceCatchCatcher = MkNamed "Exception.catch"
+ (\f cc -> Exception.catch (f >> (return ())) (const cc :: Exception.SomeException -> IO ()))
 
-       main = checkNamedCatches
-               [bindCatcher,preludeCatchCatcher,ceCatchCatcher,finallyCatcher]
-               [returnThrower,returnUndefinedThrower,returnThrowThrower,returnErrorThrower,failThrower,
-               errorThrower,throwThrower,ioErrorErrorCallThrower,ioErrorIOExceptionThrower,undefinedThrower];
+finallyCatcher :: Named Catcher
+finallyCatcher = MkNamed "Exception.finally"
+ (\f cc -> Exception.finally (f >> (return ())) cc)
+
+main = checkNamedCatches
+        [bindCatcher,preludeCatchCatcher,ceCatchCatcher,finallyCatcher]
+        [returnThrower,returnUndefinedThrower,returnThrowThrower,returnErrorThrower,failThrower,
+        errorThrower,throwThrower,ioErrorErrorCallThrower,ioErrorIOExceptionThrower,undefinedThrower]
 
-       }
index 9f253a7..1442c9b 100644 (file)
@@ -22,7 +22,6 @@ import Control.Concurrent.QSemN
 import Control.Concurrent.SampleVar
 
 import Control.Exception
-import Control.OldException
 import Control.Exception.Base
 
 import Control.Monad
diff --git a/testsuite/tests/safeHaskell/unsafeLibs/GoodImport03.stderr b/testsuite/tests/safeHaskell/unsafeLibs/GoodImport03.stderr
deleted file mode 100644 (file)
index 33d90f9..0000000
+++ /dev/null
@@ -1,4 +0,0 @@
-
-GoodImport03.hs:25:1:
-    Warning: Module `Control.OldException' is deprecated:
-               Future versions of base will not support the old exceptions style. Please switch to extensible exceptions.