1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
|
module Main where
{
import qualified Control.OldException as Exception;
import Data.IORef;
import Prelude;
safeCatch :: IO () -> IO ();
safeCatch f = Exception.catch f (\_ -> return ());
type Thrower = IO Bool;
type Catcher = IO Bool -> IO () -> IO ();
checkCatch :: Catcher -> Thrower -> IO Bool;
checkCatch catcher thrower = do
{
ref <- newIORef False;
safeCatch (catcher thrower (writeIORef ref True));
readIORef ref;
};
data Named a = MkNamed String a;
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);
returnUndefinedThrower :: Named Thrower;
returnUndefinedThrower = MkNamed "return undefined" (return undefined);
returnErrorThrower :: Named Thrower;
returnErrorThrower = MkNamed "return error" (return (error "some error"));
undefinedThrower :: Named Thrower;
undefinedThrower = MkNamed "undefined" undefined;
failThrower :: Named Thrower;
failThrower = MkNamed "fail" (fail "some failure");
errorThrower :: Named Thrower;
errorThrower = MkNamed "error" (error "some error");
throwThrower :: Named Thrower;
throwThrower = MkNamed "Exception.throw"
(Exception.throw (Exception.ErrorCall "throw error"));
ioErrorErrorCallThrower :: Named Thrower;
ioErrorErrorCallThrower = MkNamed "ioError ErrorCall"
(Exception.throwIO (Exception.ErrorCall "throw error"));
ioErrorIOExceptionThrower :: Named Thrower;
ioErrorIOExceptionThrower = MkNamed "ioError IOException"
(Exception.throwIO (Exception.IOException undefined));
returnThrowThrower :: Named Thrower;
returnThrowThrower = MkNamed "return Exception.throw"
(return (Exception.throw (Exception.ErrorCall "throw error")));
-- catchers
bindCatcher :: Named Catcher;
bindCatcher = MkNamed ">>" (>>);
preludeCatchCatcher :: Named Catcher;
preludeCatchCatcher = MkNamed "Prelude.catch"
(\f cc -> Prelude.catch (f >> (return ())) (const cc));
ceCatchCatcher :: Named Catcher;
ceCatchCatcher = MkNamed "Exception.catch"
(\f cc -> Exception.catch (f >> (return ())) (const cc));
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];
}
|
