+ exception handling testing

     (still missing raise / on node testing)

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)
+
+}  

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)
+
+}  

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)
+
+}  

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)
+
+}  

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)
+
+}