[project @ 2001-04-02 21:24:44 by panne]
[ghc-hetmet.git] / ghc / tests / lib / should_run / exceptions001.hs
1 module Main where
2
3 import Prelude hiding (catch)
4 import Exception 
5 import IO hiding (try, catch)
6
7 main = do
8   ioTest
9   errorTest
10   noMethodTest
11   patMatchTest
12   guardTest
13   dynTest
14
15 ioTest :: IO ()
16 ioTest = catchJust userErrors (ioError (userError "wibble")) 
17            (\ex -> putStr "user exception caught\n")
18
19 errorTest :: IO ()
20 errorTest = try (evaluate (1 + error "call to 'error'")) >>= \r ->
21             case r of
22                 Left exception -> putStr "error call caught\n"
23                 Right _        -> error "help!"
24
25 instance (Show a, Eq a) => Num (Maybe a) where {}
26
27 noMethodTest :: IO ()
28 noMethodTest = try (evaluate (Just () + Just ())) >>= \ r ->
29         case r of
30                 Left (NoMethodError err) -> putStr "no method error\n"
31                 Right _                  -> error "help!"
32
33 patMatchTest :: IO ()
34 patMatchTest = catch (case test1 [1..10] of () -> return ())
35   (\ex -> case ex of
36                 PatternMatchFail err -> putStr err
37                 other                -> error "help!")
38                   
39 test1 [] = ()
40
41 guardTest = catch (case test2 of () -> return ())
42   (\ex -> case ex of
43                 PatternMatchFail err -> putStr err
44                 other                -> error "help!")
45
46 test2 | all (==0) [1] = ()
47
48 dynTest = catchDyn (case throwDyn (42::Int, (+1)::Int->Int) of () -> return ())
49   (\(i,f) -> let x = f (i::Int) :: Int in putStr (show x))
50
51 {-
52 recSelTest
53 recConTest
54 recUpdTest
55 assertTest
56 arithTest
57 -}