t_id
207
t_adddate
2003/10/03
t_result
0
t_knownrunerror
0
| tr_id | run | tr_ok | tr_skip | tr_result |
|---|---|---|---|---|
| 443635251 | 934962 | True | False | Successfully run |
Record count: 1
{****************************************************************}
{ 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 ttryfin1;
{$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;
{ Will the finally clause of a try block be called if the try block exited normally? }
Function DoTryFinallyOne: boolean;
var
failed : boolean;
begin
Write('Try..Finally clause...');
global_counter:=0;
failed:=true;
DoTryFinallyOne := failed;
Try
IncrementCounter(global_counter);
DecrementCounter(global_counter);
finally
if global_counter = 0 then
failed :=false;
DoTryFinallyOne := failed;
end;
end;
{
Will the finally clause of a try block be called if the try block
is inside a sub-block and the try block is exited with the break
statement?
}
Function DoTryFinallyTwo : boolean;
var
failed : boolean;
begin
Write('Try..Finally with break statement...');
global_counter:=0;
failed:=true;
DoTryFinallyTwo := failed;
while (failed) do
begin
Try
IncrementCounter(global_counter);
DecrementCounter(global_counter);
break;
finally
if global_counter = 0 then
failed :=false;
DoTryFinallyTwo := failed;
end;
end;
end;
{
Will the finally clause of a try block be called if the try block
is inside a sub-block and the try block is exited with the continue
statement?
}
Function DoTryFinallyThree : boolean;
var
failed : boolean;
begin
Write('Try..Finally with continue statement...');
global_counter:=0;
failed:=true;
DoTryFinallyThree := failed;
while (failed) do
begin
Try
IncrementCounter(global_counter);
DecrementCounter(global_counter);
continue;
finally
if global_counter = 0 then
failed :=false;
DoTryFinallyThree := failed;
end;
end;
end;
{
Will the finally clause of a try block be called if the try block
is inside a sub-block and the try block is exited with the exit
statement?
}
Function DoTryFinallyFour: boolean;
var
failed : boolean;
begin
Write('Try..Finally with exit statement...');
global_counter:=0;
failed:=true;
DoTryFinallyFour := failed;
while (failed) do
begin
Try
IncrementCounter(global_counter);
DecrementCounter(global_counter);
exit;
finally
if global_counter = 0 then
failed :=false;
DoTryFinallyFour := failed;
end;
end;
end;
(*
{ Will the finally clause of a try block be called if the try block raises an exception? }
Procedure DoTryFinallyThree;
var
failed : boolean;
begin
Write('Try..Finally with exception rise...');
global_counter:=0;
failed:=true;
Try
IncrementCounter(global_counter);
RaiseAnException;
DecrementCounter(global_counter);
finally
if global_counter = 1 then
failed :=false;
if failed then
fail
else
WriteLn('Success!');
end;
end;
*)
{ Will the finally clause of all nested try blocks be called if the try blocks exited normally? }
Function DoTryFinallyFive: boolean;
var
failed : boolean;
x : integer;
begin
Write('Try..Finally nested clauses (three-level nesting)...');
global_counter:=0;
failed:=true;
DoTryFinallyFive := failed;
x:=0;
Try
IncrementCounter(global_counter);
Try
DecrementCounter(global_counter);
IncrementCounter(global_counter);
Try
DecrementCounter(global_counter);
finally
Inc(x);
end;
finally
Inc(x);
End;
finally
if (global_counter = 0) and (x = 2) then
failed :=false;
DoTryFinallyFive := failed;
end;
end;
{
Will the finally clauses of all try blocks be called if they are
nested within each other and all are nested within a sub-block
and a break statement is encountered in the innermost try
block?
}
Function DoTryFinallySix : boolean;
var
failed : boolean;
x: integer;
begin
Write('Try..Finally nested clauses with break statement...');
global_counter:=0;
x:=0;
failed:=true;
DoTryFinallySix := failed;
while (failed) do
begin
Try
IncrementCounter(global_counter);
Try
DecrementCounter(global_counter);
IncrementCounter(global_counter);
Try
DecrementCounter(global_counter);
break;
finally
Inc(x);
end;
finally
Inc(x);
End;
finally
if (global_counter = 0) and (x = 2) then
failed :=false;
DoTryFinallySix := failed;
end;
end;
end;
{
Will the finally clauses of all try blocks be called if they are
nested within each other and all are nested within a sub-block
and a continue statement is encountered in the innermost try
block?
}
Function DoTryFinallySeven : boolean;
var
failed : boolean;
x: integer;
begin
Write('Try..Finally nested clauses with continue statement...');
global_counter:=0;
x:=0;
failed:=true;
DoTryFinallySeven := failed;
while (failed) do
begin
Try
IncrementCounter(global_counter);
Try
DecrementCounter(global_counter);
IncrementCounter(global_counter);
Try
DecrementCounter(global_counter);
continue;
finally
Inc(x);
end;
finally
Inc(x);
End;
finally
if (global_counter = 0) and (x = 2) then
failed :=false;
DoTryFinallySeven := failed;
end;
end;
end;
{
Will the finally clauses of all try blocks be called if they are
nested within each other and all are nested within a sub-block
and an exit statement is encountered in the innermost try
block?
}
Function DoTryFinallyEight : boolean;
var
failed : boolean;
x: integer;
begin
Write('Try..Finally nested clauses with exit statement...');
global_counter:=0;
x:=0;
failed:=true;
DoTryFinallyEight := failed;
while (failed) do
begin
Try
IncrementCounter(global_counter);
Try
DecrementCounter(global_counter);
IncrementCounter(global_counter);
Try
DecrementCounter(global_counter);
exit;
finally
Inc(x);
end;
finally
Inc(x);
End;
finally
if (global_counter = 0) and (x = 2) then
failed :=false;
DoTryFinallyEight := failed;
end;
end;
end;
(*
------------------
*)
{
If several try blocks are nested within a sub-block, and that sub-block is
nested in a try block within another try block, and the innermost try
blocks are exited due to a break, will all finally clauses be called?
}
Function DoTryFinallyNine : boolean;
var
failed : boolean;
x: integer;
begin
Write('Try..Finally nested clauses with break statement in other try-block...');
global_counter:=0;
x:=0;
failed:=true;
DoTryFinallyNine := failed;
Try
while (failed) do
begin
Try
IncrementCounter(global_counter);
Try
DecrementCounter(global_counter);
IncrementCounter(global_counter);
Try
DecrementCounter(global_counter);
break;
finally
Inc(x);
end;
finally
Inc(x);
End;
finally
if (global_counter = 0) and (x = 2) then
failed :=false;
DoTryFinallyNine := failed;
end;
end; {end while }
finally
{ normally this should execute! }
DoTryFinallyNine := failed;
end;
end;
{
If several try blocks are nested within a sub-block, and that sub-block is
nested in a try block within another try block, and the innermost try
blocks are exited due to an exit, will all finally clauses be called?
}
Function DoTryFinallyTen : boolean;
var
failed : boolean;
x: integer;
begin
Write('Try..Finally nested clauses with exit statement in other try-block...');
global_counter:=0;
x:=0;
failed:=true;
DoTryFinallyTen := failed;
Try
while (failed) do
begin
Try
IncrementCounter(global_counter);
Try
DecrementCounter(global_counter);
IncrementCounter(global_counter);
Try
DecrementCounter(global_counter);
exit;
finally
Inc(x);
end;
finally
Inc(x);
End;
finally
x:=1;
end;
end; {end while }
finally
{ normally this should execute! }
if (global_counter = 0) and (x = 1) then
failed :=false;
DoTryFinallyTen := failed;
end;
end;
var
failed: boolean;
begin
failed := DoTryFinallyOne;
if failed then
fail
else
WriteLn('Success!');
failed := DoTryFinallyTwo;
if failed then
fail
else
WriteLn('Success!');
failed := DoTryFinallyThree;
if failed then
fail
else
WriteLn('Success!');
failed := DoTryFinallyFour;
if failed then
fail
else
WriteLn('Success!');
failed := DoTryFinallyFive;
if failed then
fail
else
WriteLn('Success!');
failed := DoTryFinallySix;
if failed then
fail
else
WriteLn('Success!');
failed := DoTryFinallySeven;
if failed then
fail
else
WriteLn('Success!');
failed := DoTryFinallyEight;
if failed then
fail
else
WriteLn('Success!');
failed := DoTryFinallyNine;
if failed then
fail
else
WriteLn('Success!');
failed := DoTryFinallyTen;
if failed then
fail
else
WriteLn('Success!');
end.
{
$Log: ttryfin1.pp,v $
Revision 1.2 2002/09/07 15:40:56 peter
* old logs removed and tabs fixed
Revision 1.1 2002/08/03 11:05:14 carl
+ exception handling testing
(still missing raise / on node testing)
}