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
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
|
{ %RESULT=217 }
program testexceptions;
{$mode objfpc}
Type
TAObject = class(TObject)
a : longint;
end;
TBObject = Class(TObject)
b : longint;
end;
Procedure raiseanexception;
Var A : TAObject;
begin
Writeln ('Creating exception object');
A:=TAObject.Create;
Writeln ('Raising with this object');
raise A;
Writeln ('This can''t happen');
end;
Var MaxLevel : longint;
Procedure DoTryFinally (Level : Longint; DoRaise : Boolean);
Var Raised,Reraised : Boolean;
I : Longint;
begin
Try
writeln ('Try(',level,') : Checking for exception');
If Level=MaxLevel then
begin
if DoRaise then
begin
Writeln ('Try(',level,'): Level ',maxlevel,' reached, raising exception.');
Raiseanexception
end
else
Writeln ('Try(',Level,'): Not raising exception')
end
else
begin
Writeln ('Try(',level,') : jumping to next level');
DoTryFinally(Level+1,DoRaise);
end;
finally
Writeln ('Finally (',level,'): Starting code.');
end;
writeln ('Out of try/finally at level (',level,')');
end;
Procedure DoTryExcept (Level : Longint; DoRaise : Boolean);
Var Raised : Boolean;
I : Longint;
Caught : TObject;
begin
Try
writeln ('Try(',level,') : Checking for exception');
If Level=MaxLevel then
if DoRaise then
begin
Writeln ('Try(',level,'): Level ',maxlevel,', raising exception.');
Raiseanexception
end
else
Writeln ('Try(',Level,'): level ',maxlevel,'. Not raising exception')
else
begin
Writeln ('Try(',level,') : jumping to next level');
DoTryExcept(Level+1,DoRaise);
end;
except
On TAObject do Writeln ('Exception was caught by TAObject');
On TBobject do Writeln ('Exception was caught by TBObject');
On E : TObject do Writeln ('Caught object ',E.ClassName);
// writeln ('Except (',level,') : Exception caught by default handler');
end;
writeln ('Out of try/except at level (',level,')');
end;
Procedure DoMix (Level : Longint; DoRaise : Boolean);
Var Raised : Boolean;
I : Longint;
Caught : TObject;
begin
Try
Try
writeln ('Try(',level,') : Checking for exception');
If Level=MaxLevel then
if DoRaise then
begin
Writeln ('Try(',level,'): Level ',maxlevel,', raising exception.');
Raiseanexception
end
else
Writeln ('Try(',Level,'): level ',maxlevel,'. Not raising exception')
else
begin
Writeln ('Try(',level,') : jumping to next level');
DoMix(Level+1,DoRaise);
end;
finally
Writeln ('Mix:Finally (',level,'): Starting code.');
end;
Writeln ('Level (',level,') : Out of try/finally');
except
On TAObject do Writeln ('Exception was caught by TAObject');
On TBobject do Writeln ('Exception was caught by TBObject');
On TObject do writeln ('Except (',level,') : Exception caught by TObject');
// The following don't work...
On E : TObject do Writeln ('Caught object ',E.ClassName);
else
writeln ('Except (',level,') : Exception caught by default handler');
end;
writeln ('Out of try/except at level (',level,')');
end;
function _dotryfinally : boolean;
var
problem : boolean;
begin
result:=false;
try
try
finally
writeln('Raising an exception in finally statement');
Raiseanexception
end;
except
end;
try
exit;
finally
result:=true;
end;
writeln('Problem with finally and exit !!!!');
halt(1);
end;
procedure dotryfinally;
begin
if not(_dotryfinally) then
begin
writeln('Problem with finally and exit !!!!');
halt(1);
end;
end;
Procedure Start(Const Msg : string);
begin
Writeln (Msg);
Writeln;
end;
Procedure Finish;
begin
Writeln;
Writeln ('Finished.');
writeln;
{ Press enter to continue.');
Readln; tests/test/test... must be non interactive !! PM }
end;
begin
Maxlevel:=3;
Start ('Testing Try/Finally without raise');
DoTryFinally (1,False);
Finish;
Start ('Testing Try/except without raise');
DoTryExcept (1,FAlse);
Finish;
Start ('Testing Mix without raise');
DoMix (1,False);
Finish;
Start ('Testing Try/except with raise');
DoTryExcept (1,true);
Finish;
Start ('Testing Mix with raise');
DoMix (1,true);
Finish;
Start ('Testing Try/Finally with Exit');
dotryfinally;
Finish;
Writeln ('Testing Try/Finally with raise');
Start ('This one should end with an error message !!.');
DoTryFinally (1,True);
end.
|
