1{ %RESULT=217 }
2{****************************************************************}
3{  CODE GENERATOR TEST PROGRAM                                   }
4{  By Carl Eric Codere                                           }
5{****************************************************************}
6{ NODE TESTED : secondtryfinally()                               }
7{               secondraise()                                    }
8{****************************************************************}
9{ PRE-REQUISITES: secondload()                                   }
10{                 secondassign()                                 }
11{                 secondtypeconv()                               }
12{                 secondtryexcept()                              }
13{                 secondcalln()                                  }
14{                 secondadd()                                    }
15{****************************************************************}
16{ DEFINES:                                                       }
17{            FPC     = Target is FreePascal compiler             }
18{****************************************************************}
19{****************************************************************}
20program ttryfin3;
21
22{$ifdef fpc}
23{$mode objfpc}
24{$endif}
25
26Type
27  TAObject = class(TObject)
28    a : longint;
29    end;
30  TBObject = Class(TObject)
31    b : longint;
32    end;
33
34
35{ The test cases were taken from the SAL internal architecture manual }
36
37    procedure fail;
38    begin
39      WriteLn('Failure.');
40      halt(1);
41    end;
42
43var
44 global_counter : integer;
45
46Procedure raiseanexception;
47
48Var A : TAObject;
49
50begin
51{  Writeln ('Creating exception object');}
52  A:=TAObject.Create;
53{  Writeln ('Raising with this object');}
54  raise A;
55  { this should never happen, if it does there is a problem! }
56  RunError(255);
57end;
58
59
60procedure IncrementCounter(x: integer);
61begin
62  Inc(global_counter);
63end;
64
65procedure DecrementCounter(x: integer);
66begin
67  Dec(global_counter);
68end;
69
70
71{  }
72Procedure DoTryFinallyOne;
73var
74 failed : boolean;
75begin
76  Write('Try..Finally with exception rise in finally block...');
77  global_counter:=0;
78  failed:=true;
79  Try
80    IncrementCounter(global_counter);
81    DecrementCounter(global_counter);
82  finally
83    RaiseAnException;
84  end;
85end;
86
87
88
89Begin
90  DoTryFinallyOne;
91end.
92