From: simonm <unknown>
Date: Wed, 12 Aug 1998 11:05:16 +0000 (+0000)
Subject: [project @ 1998-08-12 11:05:14 by simonm]
X-Git-Tag: Approx_2487_patches~449
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=fa7605804521e04066b31fcc91e5e0872334f995;p=ghc-hetmet.git

[project @ 1998-08-12 11:05:14 by simonm]
Exception library tests.
---

diff --git a/ghc/tests/lib/should_run/Makefile b/ghc/tests/lib/should_run/Makefile
index 2df3154..ca76c0f 100644
--- a/ghc/tests/lib/should_run/Makefile
+++ b/ghc/tests/lib/should_run/Makefile
@@ -1,5 +1,5 @@
 #-----------------------------------------------------------------------------
-# $Id: Makefile,v 1.4 1998/08/11 21:08:51 sof Exp $
+# $Id: Makefile,v 1.5 1998/08/12 11:05:14 simonm Exp $
 
 TOP = ../..
 include $(TOP)/mk/boilerplate.mk
@@ -8,6 +8,8 @@ include $(TOP)/mk/should_run.mk
 SRC_HC_OPTS += -dcore-lint
 
 packedstring001_HC_OPTS = -syslib misc
+exceptions001_HC_OPTS   = -fglasgow-exts
+
 stableptr001_RUNTEST_OPTS = +RTS -K4m
 dynamic001_HC_OPTS = -syslib exts
 
diff --git a/ghc/tests/lib/should_run/exceptions001.hs b/ghc/tests/lib/should_run/exceptions001.hs
new file mode 100644
index 0000000..38411a8
--- /dev/null
+++ b/ghc/tests/lib/should_run/exceptions001.hs
@@ -0,0 +1,57 @@
+module Main where
+
+import Prelude hiding (catch)
+import Exception
+import IO hiding (try)
+
+main = do
+  ioTest
+  errorTest
+  noMethodTest
+  patMatchTest
+  guardTest
+  dynTest
+
+ioTest :: IO ()
+ioTest = catchIO (fail (userError "wibble")) 
+	   (\ex -> if isUserError ex then putStr "io exception caught\n" 
+				     else error "help!")
+
+errorTest :: IO ()
+errorTest = case getExceptions (1 + error "call to 'error'") of
+		Left exceptions -> putStr "error call caught\n"
+		Right val	-> error "help!"
+
+instance (Show a, Eq a) => Num (Maybe a) where {}
+
+noMethodTest :: IO ()
+noMethodTest = catch (case Just () + Just () of Nothing -> return ())
+  (\exs -> case unsafePromiseSingleton exs of
+		NoMethodError err -> putStr "no method error\n"
+		other             -> error "help!")
+
+patMatchTest :: IO ()
+patMatchTest = catchOne (case test1 [1..10] of () -> return ())
+  (\ex -> case ex of
+		PatternMatchFail err -> putStr err
+		other 		     -> error "help!")
+		  
+test1 [] = ()
+
+guardTest = catchOne (case test2 of () -> return ())
+  (\ex -> case ex of
+		NonExhaustiveGuards err -> putStr err
+		other 		     -> 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
+-}
diff --git a/ghc/tests/lib/should_run/exceptions001.stdout b/ghc/tests/lib/should_run/exceptions001.stdout
new file mode 100644
index 0000000..e69de29