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