blob: 9a34348dd65ad4b8e95cb0f67db4ab8577048dd5 (
plain)
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
|
{ %RESULT=217 }
{****************************************************************}
{ CODE GENERATOR TEST PROGRAM }
{ By Carl Eric Codere }
{****************************************************************}
{ NODE TESTED : secondtryfinally() }
{ secondraise() }
{****************************************************************}
{ PRE-REQUISITES: secondload() }
{ secondassign() }
{ secondtypeconv() }
{ secondtryexcept() }
{ secondcalln() }
{ secondadd() }
{****************************************************************}
{ DEFINES: }
{ FPC = Target is FreePascal compiler }
{****************************************************************}
{****************************************************************}
program ttryfin4;
{$ifdef fpc}
{$mode objfpc}
{$endif}
Type
TAObject = class(TObject)
a : longint;
end;
TBObject = Class(TObject)
b : longint;
end;
{ The test cases were taken from the SAL internal architecture manual }
procedure fail;
begin
WriteLn('Failure.');
halt(1);
end;
var
global_counter : integer;
Procedure raiseanexception;
Var A : TAObject;
begin
{ Writeln ('Creating exception object');}
A:=TAObject.Create;
{ Writeln ('Raising with this object');}
raise A;
{ this should never happen, if it does there is a problem! }
RunError(255);
end;
procedure IncrementCounter(x: integer);
begin
Inc(global_counter);
end;
procedure DecrementCounter(x: integer);
begin
Dec(global_counter);
end;
{ }
Procedure DoTryFinallyOne;
var
failed : boolean;
begin
Write('Try..Finally nested block with exception rise in finally block...');
global_counter:=0;
failed:=true;
Try
Try
IncrementCounter(global_counter);
IncrementCounter(global_counter);
finally
RaiseAnException;
end;
finally
if global_counter = 2 then
failed :=false;
if failed then
fail
else
WriteLn('Success!');
end;
end;
Begin
DoTryFinallyOne;
end.
|
