From 657aa6d1cc552762cba59da03f9998bd7d8b8e15 Mon Sep 17 00:00:00 2001 From: carl Date: Sat, 3 Aug 2002 11:05:14 +0000 Subject: [PATCH] + exception handling testing (still missing raise / on node testing) --- tests/test/cg/ttryexc1.pp | 828 ++++++++++++++++++++++++++++++++++++++ tests/test/cg/ttryfin1.pp | 506 +++++++++++++++++++++++ tests/test/cg/ttryfin2.pp | 105 +++++ tests/test/cg/ttryfin3.pp | 99 +++++ tests/test/cg/ttryfin4.pp | 108 +++++ 5 files changed, 1646 insertions(+) create mode 100644 tests/test/cg/ttryexc1.pp create mode 100644 tests/test/cg/ttryfin1.pp create mode 100644 tests/test/cg/ttryfin2.pp create mode 100644 tests/test/cg/ttryfin3.pp create mode 100644 tests/test/cg/ttryfin4.pp diff --git a/tests/test/cg/ttryexc1.pp b/tests/test/cg/ttryexc1.pp new file mode 100644 index 0000000000..7963a5f89f --- /dev/null +++ b/tests/test/cg/ttryexc1.pp @@ -0,0 +1,828 @@ +{ %RESULT=217 } +{****************************************************************} +{ CODE GENERATOR TEST PROGRAM } +{ By Carl Eric Codere } +{****************************************************************} +{ NODE TESTED : secondtryexcept() } +{ secondraise() } +{****************************************************************} +{ PRE-REQUISITES: secondload() } +{ secondassign() } +{ secondtypeconv() } +{ secondtryexcept() } +{ secondcalln() } +{ secondadd() } +{****************************************************************} +{ DEFINES: } +{ FPC = Target is FreePascal compiler } +{****************************************************************} +{ REMARKS : Tested with Delphi 3 as reference implementation } +{****************************************************************} +program ttryexc1; + +{$ifdef fpc} +{$mode objfpc} +{$endif} + +Type + TAObject = class(TObject) + a : longint; + end; + TBObject = Class(TObject) + b : longint; + constructor create(c: 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; + + + constructor tbobject.create(c:longint); + begin + inherited create; + b:=c; + end; + + +Procedure raiseanexception; + +Var A : TAObject; +var B : 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; + + +Function DoTryExceptOne: boolean; +var + failed : boolean; +begin + Write('Try..Except clause...'); + global_counter:=0; + failed:=true; + DoTryExceptOne := failed; + Try + IncrementCounter(global_counter); + DecrementCounter(global_counter); + except + end; + if global_counter = 0 then + failed :=false; + DoTryExceptOne := failed; +end; + + +Function DoTryExceptTwo : boolean; +var + failed : boolean; +begin + Write('Try..Except with break statement...'); + global_counter:=0; + failed:=true; + DoTryExceptTwo := failed; + while (failed) do + begin + Try + IncrementCounter(global_counter); + DecrementCounter(global_counter); + break; + except + end; + end; + if global_counter = 0 then + failed :=false; + DoTryExceptTwo := failed; +end; + + + + +Function DoTryExceptFour: boolean; +var + failed : boolean; +begin + Write('Try..Except with exit statement...'); + global_counter:=0; + failed:=true; + DoTryExceptFour := failed; + while (failed) do + begin + Try + IncrementCounter(global_counter); + DecrementCounter(global_counter); + DoTryExceptFour := false; + exit; + except + end; + end; +end; + + +Function DoTryExceptFive: boolean; +var + failed : boolean; + x : integer; +begin + Write('Try..Except nested clauses (three-level nesting)...'); + global_counter:=0; + failed:=true; + DoTryExceptFive := failed; + x:=0; + Try + IncrementCounter(global_counter); + Try + DecrementCounter(global_counter); + IncrementCounter(global_counter); + Try + DecrementCounter(global_counter); + except + Inc(x); + end; + except + Inc(x); + End; + except + end; + if (global_counter = 0) then + failed :=false; + DoTryExceptFive := failed; +end; + + +Function DoTryExceptSix : boolean; +var + failed : boolean; + x: integer; +begin + Write('Try..Except nested clauses with break statement...'); + global_counter:=0; + x:=0; + failed:=true; + DoTryExceptSix := failed; + while (failed) do + begin + Try + IncrementCounter(global_counter); + Try + DecrementCounter(global_counter); + IncrementCounter(global_counter); + Try + DecrementCounter(global_counter); + break; + except + Inc(x); + end; + except + Inc(x); + End; + except + end; + end; + if (global_counter = 0) then + failed :=false; + DoTryExceptSix := failed; +end; + + +Function DoTryExceptEight : boolean; +var + failed : boolean; + x: integer; +begin + Write('Try..Except nested clauses with exit statement...'); + global_counter:=0; + x:=0; + failed:=true; + DoTryExceptEight := failed; + while (failed) do + begin + Try + IncrementCounter(global_counter); + Try + DecrementCounter(global_counter); + IncrementCounter(global_counter); + Try + DecrementCounter(global_counter); + DoTryExceptEight := false; + exit; + except + Inc(x); + end; + except + Inc(x); + End; + except + end; + end; +end; + + +Function DoTryExceptNine : boolean; +var + failed : boolean; + x: integer; +begin + Write('Try..Except nested clauses with break statement in other try-block...'); + global_counter:=0; + x:=0; + failed:=true; + DoTryExceptNine := failed; + Try + while (failed) do + begin + Try + IncrementCounter(global_counter); + Try + DecrementCounter(global_counter); + IncrementCounter(global_counter); + Try + DecrementCounter(global_counter); + break; + except + Inc(x); + end; + except + Inc(x); + End; + except + end; + end; {end while } + except + { normally this should execute! } + DoTryExceptNine := failed; + end; + if (global_counter = 0) and (x = 0) then + failed :=false; + DoTryExceptNine := failed; +end; + + +{****************************************************************************} + +{***************************************************************************} +{ Exception is thrown } +{***************************************************************************} +Function DoTryExceptTen: boolean; +var + failed : boolean; +begin + Write('Try..Except clause with raise...'); + global_counter:=0; + failed:=true; + DoTryExceptTen := failed; + Try + IncrementCounter(global_counter); + RaiseAnException; + DecrementCounter(global_counter); + except + if global_counter = 1 then + failed :=false; + DoTryExceptTen := failed; + end; +end; + +Function DoTryExceptEleven : boolean; +var + failed : boolean; +begin + Write('Try..Except with raise and break statement...'); + global_counter:=0; + failed:=true; + DoTryExceptEleven := failed; + while (failed) do + begin + Try + IncrementCounter(global_counter); + DecrementCounter(global_counter); + RaiseAnException; + break; + except + if global_counter = 0 then + failed :=false; + DoTryExceptEleven := failed; + end; + end; +end; + +Function DoTryExceptTwelve: boolean; +var + failed : boolean; + x : integer; +begin + Write('Try..Except nested clauses (three-level nesting)...'); + global_counter:=0; + failed:=true; + DoTryExceptTwelve := failed; + x:=0; + Try + IncrementCounter(global_counter); + Try + DecrementCounter(global_counter); + IncrementCounter(global_counter); + Try + DecrementCounter(global_counter); + RaiseAnException; + except + if (global_counter = 0) then + failed :=false; + DoTryExceptTwelve := failed; + end; + except + DoTryExceptTwelve := true; + End; + except + DoTryExceptTwelve := true; + end; +end; + + +Function DoTryExceptThirteen: boolean; +var + failed : boolean; + x : integer; +begin + Write('Try..Except nested clauses (three-level nesting)...'); + global_counter:=0; + failed:=true; + DoTryExceptThirteen := failed; + x:=0; + Try + IncrementCounter(global_counter); + Try + DecrementCounter(global_counter); + IncrementCounter(global_counter); + RaiseAnException; + Try + DecrementCounter(global_counter); + except + DoTryExceptThirteen := true; + end; + except + if (global_counter = 1) then + failed :=false; + DoTryExceptThirteen := failed; + End; + except + DoTryExceptThirteen := true; + end; +end; + +{***************************************************************************} +{ Exception is thrown in except block } +{***************************************************************************} +Function DoTryExceptFourteen: boolean; +var + failed : boolean; + x : integer; +begin + Write('Try..Except nested clauses with single re-raise...'); + global_counter:=0; + failed:=true; + DoTryExceptFourteen := failed; + x:=0; + Try + IncrementCounter(global_counter); + Try + DecrementCounter(global_counter); + IncrementCounter(global_counter); + Try + DecrementCounter(global_counter); + RaiseAnException; + except + { raise to next block } + Raise; + end; + except + if (global_counter = 0) then + failed :=false; + DoTryExceptFourteen := failed; + End; + except + DoTryExceptFourteen := true; + end; +end; + + + +Function DoTryExceptFifteen: boolean; +var + failed : boolean; + x : integer; +begin + Write('Try..Except nested clauses with re-reraises (1)...'); + global_counter:=0; + failed:=true; + DoTryExceptFifteen := failed; + x:=0; + Try + IncrementCounter(global_counter); + Try + DecrementCounter(global_counter); + IncrementCounter(global_counter); + Try + DecrementCounter(global_counter); + RaiseAnException; + except + { raise to next block } + Raise; + end; + except + { re-raise to next block } + Raise; + End; + except + if (global_counter = 0) then + failed :=false; + DoTryExceptFifteen := failed; + end; +end; + +procedure nestedtryblock(var global_counter: integer); +begin + IncrementCounter(global_counter); + Try + DecrementCounter(global_counter); + IncrementCounter(global_counter); + Try + DecrementCounter(global_counter); + RaiseAnException; + except + { raise to next block } + Raise; + end; + except + { re-raise to next block } + Raise; + End; +end; + + +Function DoTryExceptSixteen: boolean; +var + failed : boolean; + x : integer; +begin + Write('Try..Except nested clauses with re-reraises (2)...'); + global_counter:=0; + failed:=true; + DoTryExceptSixteen := failed; + x:=0; + Try + NestedTryBlock(global_counter); + except + if (global_counter = 0) then + failed :=false; + DoTryExceptSixteen := failed; + end; +end; + + +Function DoTryExceptSeventeen: boolean; +var + failed : boolean; + x : integer; +begin + Write('Try..Except nested clauses with raises...'); + global_counter:=0; + failed:=true; + DoTryExceptSeventeen := failed; + x:=0; + Try + IncrementCounter(global_counter); + Try + DecrementCounter(global_counter); + IncrementCounter(global_counter); + Try + DecrementCounter(global_counter); + RaiseAnException; + except + { raise to next block } + raise TAObject.Create; + end; + except + { re-raise to next block } + raise TBObject.Create(1234); + End; + except + if (global_counter = 0) then + failed :=false; + DoTryExceptSeventeen := failed; + end; +end; + +{***************************************************************************} +{ Exception flow control in except block } +{***************************************************************************} +Function DoTryExceptEighteen: boolean; +var + failed : boolean; +begin + Write('Try..Except clause with raise with break in except block...'); + global_counter:=0; + failed:=true; + DoTryExceptEighteen := failed; + while (failed) do + begin + Try + IncrementCounter(global_counter); + RaiseAnException; + DecrementCounter(global_counter); + except + if global_counter = 1 then + failed :=false; + DoTryExceptEighteen := failed; + break; + end; + end; +end; + + +Function DoTryExceptNineteen: boolean; +var + failed : boolean; +begin + Write('Try..Except clause with raise with exit in except block...'); + global_counter:=0; + failed:=true; + DoTryExceptNineteen := failed; + while (failed) do + begin + Try + IncrementCounter(global_counter); + RaiseAnException; + DecrementCounter(global_counter); + except + if global_counter = 1 then + failed :=false; + DoTryExceptNineteen := failed; + exit; + end; + end; +end; + + +Function DoTryExceptTwenty: boolean; +var + failed : boolean; + x : integer; +begin + Write('Try..Except nested clauses with raises with break in inner try...'); + global_counter:=0; + failed:=true; + DoTryExceptTwenty := failed; + x:=0; + Try + IncrementCounter(global_counter); + Try + while (x = 0) do + begin + DecrementCounter(global_counter); + IncrementCounter(global_counter); + Try + DecrementCounter(global_counter); + RaiseAnException; + except + { raise to next block } + raise TAObject.Create; + break; + end; + end; + except + { re-raise to next block } + raise TBObject.Create(1234); + End; + except + if (global_counter = 0) then + failed :=false; + DoTryExceptTwenty := failed; + end; +end; + + +Function DoTryExceptTwentyOne: boolean; +var + failed : boolean; + x : integer; +begin + Write('Try..Except nested clauses with raises with continue in inner try...'); + global_counter:=0; + failed:=true; + DoTryExceptTwentyOne := failed; + x:=0; + Try + IncrementCounter(global_counter); + Try + while (x = 0) do + begin + DecrementCounter(global_counter); + IncrementCounter(global_counter); + Try + DecrementCounter(global_counter); + RaiseAnException; + except + { raise to next block } + raise TAObject.Create; + x:=1; + continue; + end; + end; + except + { re-raise to next block } + raise TBObject.Create(1234); + End; + except + if (global_counter = 0) then + failed :=false; + DoTryExceptTwentyOne := failed; + end; +end; + + +Function DoTryExceptTwentyTwo: boolean; +var + failed : boolean; + x : integer; +begin + Write('Try..Except nested clauses with raises with exit in inner try...'); + global_counter:=0; + failed:=true; + DoTryExceptTwentyTwo := failed; + x:=0; + Try + IncrementCounter(global_counter); + Try + while (x = 0) do + begin + DecrementCounter(global_counter); + IncrementCounter(global_counter); + Try + DecrementCounter(global_counter); + RaiseAnException; + except + { raise to next block } + raise TAObject.Create; + exit; + end; + end; + except + { re-raise to next block } + raise TBObject.Create(1234); + End; + except + if (global_counter = 0) then + failed :=false; + DoTryExceptTwentyTwo := failed; + end; +end; + + +var + failed: boolean; +begin + failed := DoTryExceptOne; + if failed then + fail + else + WriteLn('Success!'); + failed := DoTryExceptTwo; + if failed then + fail + else + WriteLn('Success!'); +{ failed := DoTryExceptThree; + if failed then + fail + else + WriteLn('Success!');} + failed := DoTryExceptFour; + if failed then + fail + else + WriteLn('Success!'); + failed := DoTryExceptFive; + if failed then + fail + else + WriteLn('Success!'); + failed := DoTryExceptSix; + if failed then + fail + else + WriteLn('Success!'); +{ failed := DoTryExceptSeven; + if failed then + fail + else + WriteLn('Success!');} + failed := DoTryExceptEight; + if failed then + fail + else + WriteLn('Success!'); + failed := DoTryExceptNine; + if failed then + fail + else + WriteLn('Success!'); + (************************ Exceptions are created from here ****************************) + failed := DoTryExceptTen; + if failed then + fail + else + WriteLn('Success!'); + failed := DoTryExceptEleven; + if failed then + fail + else + WriteLn('Success!'); + failed := DoTryExceptTwelve; + if failed then + fail + else + WriteLn('Success!'); + failed := DoTryExceptThirteen; + if failed then + fail + else + WriteLn('Success!'); + (************************ Exceptions in except block ****************************) + failed := DoTryExceptFourteen; + if failed then + fail + else + WriteLn('Success!'); + failed := DoTryExceptFifteen; + if failed then + fail + else + WriteLn('Success!'); + failed := DoTryExceptSixteen; + if failed then + fail + else + WriteLn('Success!'); + failed := DoTryExceptSeventeen; + if failed then + fail + else + WriteLn('Success!'); + failed := DoTryExceptEighteen; + if failed then + fail + else + WriteLn('Success!'); + failed := DoTryExceptNineteen; + if failed then + fail + else + WriteLn('Success!'); + failed := DoTryExceptTwenty; + if failed then + fail + else + WriteLn('Success!'); + failed := DoTryExceptTwentyOne; + if failed then + fail + else + WriteLn('Success!'); + failed := DoTryExceptTwentyTwo; + if failed then + fail + else + WriteLn('Success!'); +end. + +{ + $Log$ + Revision 1.1 2002-08-03 11:05:14 carl + + exception handling testing + (still missing raise / on node testing) + +} diff --git a/tests/test/cg/ttryfin1.pp b/tests/test/cg/ttryfin1.pp new file mode 100644 index 0000000000..d75297f2dd --- /dev/null +++ b/tests/test/cg/ttryfin1.pp @@ -0,0 +1,506 @@ +{****************************************************************} +{ 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$ + Revision 1.1 2002-08-03 11:05:14 carl + + exception handling testing + (still missing raise / on node testing) + +} diff --git a/tests/test/cg/ttryfin2.pp b/tests/test/cg/ttryfin2.pp new file mode 100644 index 0000000000..9c5ad5bb1d --- /dev/null +++ b/tests/test/cg/ttryfin2.pp @@ -0,0 +1,105 @@ +{ %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 ttryfin2; + +{$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 raises an exception? } +Procedure DoTryFinallyOne; +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; + + + +Begin + DoTryFinallyOne; +end. + +{ + $Log$ + Revision 1.1 2002-08-03 11:05:14 carl + + exception handling testing + (still missing raise / on node testing) + +} diff --git a/tests/test/cg/ttryfin3.pp b/tests/test/cg/ttryfin3.pp new file mode 100644 index 0000000000..d875fc0111 --- /dev/null +++ b/tests/test/cg/ttryfin3.pp @@ -0,0 +1,99 @@ +{ %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 ttryfin3; + +{$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 with exception rise in finally block...'); + global_counter:=0; + failed:=true; + Try + IncrementCounter(global_counter); + DecrementCounter(global_counter); + finally + RaiseAnException; + end; +end; + + + +Begin + DoTryFinallyOne; +end. + +{ + $Log$ + Revision 1.1 2002-08-03 11:05:14 carl + + exception handling testing + (still missing raise / on node testing) + +} diff --git a/tests/test/cg/ttryfin4.pp b/tests/test/cg/ttryfin4.pp new file mode 100644 index 0000000000..d3a80a8e57 --- /dev/null +++ b/tests/test/cg/ttryfin4.pp @@ -0,0 +1,108 @@ +{ %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. + +{ + $Log$ + Revision 1.1 2002-08-03 11:05:14 carl + + exception handling testing + (still missing raise / on node testing) + +}