+ mre tests for cg testuit

tests/test/cg/tassign1.pp

@@ -0,0 +1,77 @@
+{****************************************************************}
+{  CODE GENERATOR TEST PROGRAM                                   }
+{  By Carl Eric Codere                                           }
+{****************************************************************}
+{ NODE TESTED : secondassign()                                   }
+{****************************************************************}
+{ DEFINES:                                                       }
+{            FPC     = Target is FreePascal compiler             }
+{****************************************************************}
+{ REMARKS : Tested with Delphi 3 as reference implementation     }
+{           Tests the sortstring assignment.                     }
+{****************************************************************}
+program tassign1;
+
+{$ifdef fpc}
+{$mode objfpc}
+{$endif}
+
+const
+  RESULT_STRING = 'Hello world';
+  
+
+
+    procedure fail;
+    begin
+      WriteLn('Failure.');
+      halt(1);
+    end;
+    
+    function getc : char;
+     begin
+      getc := 'a';
+     end;
+
+ 
+var
+ failed : boolean;
+ s: shortstring;
+ c: char;
+Begin
+  Write('secondassign shortstring node testing...');
+  failed := false;
+  
+  { constant string }
+  s:=RESULT_STRING;
+  if s<>RESULT_STRING then
+    failed := true;
+  { empty constant string, small optim. }  
+  s:='';
+  if s<>'' then
+    failed := true;
+  { constant character }
+  s:='a';
+  if s<>'a' then
+    failed := true;
+  { non-constant character }
+  c:='a';
+  s:=c;
+  if s<>'a' then
+     failed := true;
+     
+  s:=getc;
+  if s<>'a' then
+     failed := true;
+     
+  if failed then
+    fail
+  else
+    WriteLn('Success!');
+end.
+
+{
+  $Log$
+  Revision 1.1  2002-08-10 08:27:43  carl
+    + mre tests for cg testuit
+
+}  

tests/test/cg/tassign2.pp

@@ -0,0 +1,211 @@
+{****************************************************************}
+{  CODE GENERATOR TEST PROGRAM                                   }
+{  By Carl Eric Codere                                           }
+{****************************************************************}
+{ NODE TESTED : secondassign()                                   }
+{****************************************************************}
+{ DEFINES:                                                       }
+{            FPC     = Target is FreePascal compiler             }
+{****************************************************************}
+{ REMARKS : Tested with Delphi 3 as reference implementation     }
+{****************************************************************}
+program tassign2;
+
+{$ifdef fpc}
+{$warning Will only work on 32-bit cpu's}
+{$mode objfpc}
+{$endif}
+
+const
+  RESULT_STRING = 'Hello world';
+  RESULT_S64BIT = -12;
+  RESULT_S32BIT = -124356;
+  RESULT_U32BIT = 654321;
+  RESULT_U8BIT  = $55;
+  RESULT_S16BIT = -12124;
+  RESULT_REAL   = 12.12;
+  
+  { adjusts the size of the bigrecord }
+  MAX_INDEX = 7;
+
+type
+  { 
+    the size of this record should *at least* be the size
+    of a natural register for the target processor
+  }  
+  tbigrecord = record
+   x : cardinal;
+   y : cardinal;
+   z : array[0..MAX_INDEX] of byte;
+  end;
+
+
+    procedure fail;
+    begin
+      WriteLn('Failure.');
+      halt(1);
+    end;
+    
+     
+     
+    function getresults64bit: int64;
+     begin
+       getresults64bit := RESULT_S64BIT;
+     end;
+     
+    function getresults32bit : longint;
+     begin
+       getresults32bit := RESULT_S32BIT;
+     end;
+     
+    function getresultu8bit : byte;
+      begin
+        getresultu8bit := RESULT_U8BIT;
+      end;
+      
+    function getresults16bit : smallint;
+      begin
+        getresults16bit := RESULT_S16BIT;
+      end;
+
+    function getresultreal : real;
+      begin
+        getresultreal := RESULT_REAL;
+      end;
+ 
+var
+ failed : boolean;
+ s64bit : int64;
+ s32bit : longint;
+ s16bit : smallint;
+ u8bit : byte;
+ boolval : boolean;
+ real_val : real;
+ bigrecord1, bigrecord2 : tbigrecord;
+ i: integer;
+Begin
+  WriteLn('secondassign node testing.');
+  failed := false;
+  { possibilities : left : any, right : LOC_REFERENCE, LOC_REGISTER,
+    LOC_FPUREGISTER, LOC_CONSTANT, LOC_JUMP and LOC_FLAGS }
+  Write('left : LOC_REFERENCE, right : LOC_CONSTANT tests..');
+  s64bit := RESULT_S64BIT;
+  if s64bit <> RESULT_S64BIT then
+    failed := true;
+    
+  s32bit := RESULT_S32BIT;
+  if s32bit <> RESULT_S32BIT then
+    failed := true;
+    
+  if failed then
+    fail
+  else
+    WriteLn('Success!');
+    
+  Write('left : LOC_REFERENCE, right : LOC_REGISTER tests..');
+  failed := false;
+  
+  s64bit := getresults64bit;
+  if s64bit <> RESULT_S64BIT then
+    failed := true;
+    
+  s32bit := getresults32bit;
+  if s32bit <> RESULT_S32BIT then
+    failed := true;
+  
+  s16bit := getresults16bit;
+  if s16bit <> RESULT_S16BIT then
+    failed := true;
+    
+  u8bit := getresultu8bit;
+  if u8bit <> RESULT_U8BIT then
+    failed := true;
+     
+  if failed then
+    fail
+  else
+    WriteLn('Success!');
+    
+  Write('left : LOC_REFERENCE, right : LOC_FPUREGISTER tests..');
+  failed := false;
+
+  real_val := getresultreal;
+  if trunc(real_val) <> trunc(RESULT_REAL) then
+    failed := true;
+
+  if failed then
+    fail
+  else
+    WriteLn('Success!');
+
+  Write('left : LOC_REFERENCE, right : LOC_REFERENCE tests..');
+  failed := false;
+  
+  bigrecord1.x := RESULT_U32BIT;
+  bigrecord1.y := RESULT_U32BIT;
+  for i:=0 to MAX_INDEX do
+    bigrecord1.z[i] := RESULT_U8BIT;
+  
+  fillchar(bigrecord2, sizeof(bigrecord2),#0);
+  
+  bigrecord2 := bigrecord1;
+  
+  if bigrecord2.x <> RESULT_U32BIT then
+    failed := true;
+  if bigrecord2.y <> RESULT_U32BIT then
+    failed := true;
+  for i:=0 to MAX_INDEX do
+    begin
+       if bigrecord2.z[i] <> RESULT_U8BIT then
+         begin
+           failed := true;
+           break;
+         end;
+    end;
+  
+
+  if failed then
+    fail
+  else
+    WriteLn('Success!');
+
+  Write('left : LOC_REFERENCE, right : LOC_JUMP tests (32-bit cpus only!)..');
+  {!!!!! This test will only work on 32-bit CPU's probably, on 64-bit CPUs
+    the location should be in LOC_FLAGS
+  }
+  failed := false;
+  
+  s64bit := RESULT_S64BIT;
+  boolval := s64bit = RESULT_S64BIT;
+  if boolval = FALSE then
+    failed := true;
+    
+  if failed then
+    fail
+  else
+    WriteLn('Success!');
+    
+
+  Write('left : LOC_REFERENCE, right : LOC_FLAGS tests..');
+  failed := false;
+  
+  s32bit := RESULT_S32BIT;
+  boolval := s32bit = RESULT_S32BIT;
+  if boolval = FALSE then
+    failed := true;
+  
+  
+  if failed then
+    fail
+  else
+    WriteLn('Success!');
+  
+    
+end.
+
+{
+  $Log$
+  Revision 1.1  2002-08-10 08:27:43  carl
+    + mre tests for cg testuit
+
+}  

tests/test/cg/tcnvint4.pp

@@ -0,0 +1,193 @@
+{****************************************************************}
+{  CODE GENERATOR TEST PROGRAM                                   }
+{****************************************************************}
+{ NODE TESTED : secondtypeconvert() -> second_int_to_real        }
+{****************************************************************}
+{ PRE-REQUISITES: secondload()                                   }
+{                 secondassign()                                 }
+{                 secondcalln()                                  }
+{                 secondinline()                                 }
+{                 secondadd()                                    }
+{****************************************************************}
+{ DEFINES:                                                       }
+{****************************************************************}
+{ REMARKS: Tests integer to real conversion                      }
+{   This routine assumes that there is a type conversion         }
+{   from all types to s32bit, u32bit or s64bit before conversion }
+{   to a real.                                                   }
+{****************************************************************}
+program tcnvint4;
+
+{$ifdef VER70}
+  {$define tp}
+{$endif}
+
+{$R-}
+
+{$ifdef tp}
+type
+  smallint = integer;
+{$endif}
+
+procedure fail;
+begin
+  WriteLn('Failure.');
+  halt(1);
+end;
+
+
+const
+ RESULT_S64BIT            =   101234; 
+ RESULT_S32BIT            = -1000000;
+ RESULT_U32BIT            =  2000000;
+ RESULT_S16BIT            =   -12123;
+ RESULT_U16BIT            =    12123;
+ RESULT_U8BIT             =      247;
+ RESULT_S8BIT             =     -123;
+
+
+{$ifndef tp}
+   function gets64bit : int64;
+    begin
+      gets64bit := RESULT_S64BIT;
+    end;
+{$endif}
+
+   function gets32bit : longint;
+    begin
+      gets32bit := RESULT_S32BIT;
+    end;
+    
+   function gets16bit : smallint;
+    begin
+      gets16bit := RESULT_S16BIT;
+    end;
+    
+   function gets8bit : shortint;
+    begin
+      gets8bit := RESULT_S8BIT; 
+    end;
+
+   function getu8bit : byte;
+    begin
+      getu8bit := RESULT_U8BIT;
+    end;
+    
+   function getu16bit : word;
+    begin
+      getu16bit := RESULT_U16BIT;
+    end;
+
+   function getu32bit : longint;
+    begin
+      getu32bit := RESULT_U32BIT;
+    end;
+
+var
+ s32bit : longint;
+ failed : boolean;
+ s16bit : smallint;
+ s8bit : shortint;
+ u8bit : byte;
+ u16bit : word;
+{$ifndef tp}
+ s64bit : int64;
+ u32bit : cardinal;
+{$endif}
+ result_val : real;
+begin
+  { left : LOC_REFERENCE }
+  Write('second_int_to_real (left : LOC_REFERENCE)...');
+  s64bit := RESULT_S64BIT;
+  failed := false;
+  result_val := s64bit;
+  if trunc(result_val) <> RESULT_S64BIT then
+     failed:=true;
+     
+  s32bit := RESULT_S32BIT;
+  result_val := s32bit;
+  if trunc(result_val) <> RESULT_S32BIT then
+     failed:=true;
+
+
+  u32bit := RESULT_U32BIT;
+  result_val := u32bit;
+  if trunc(result_val) <> RESULT_U32BIT then
+     failed:=true;
+     
+  s16bit := RESULT_S16BIT;
+  result_val := s16bit;
+  if trunc(result_val) <> RESULT_S16BIT then
+     failed:=true;
+
+  u16bit := RESULT_U16BIT;
+  result_val := u16bit;
+  if trunc(result_val) <> RESULT_U16BIT then
+     failed:=true;
+
+
+  s8bit := RESULT_S8BIT;
+  result_val := s8bit;
+  if trunc(result_val) <> RESULT_S8BIT then
+     failed:=true;
+
+  u8bit := RESULT_U8BIT;
+  result_val := u8bit;
+  if trunc(result_val) <> RESULT_U8BIT then
+     failed:=true;
+     
+
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+
+  Write('second_int_to_real (left : LOC_REGISTER)...');
+  failed := false;
+  result_val := gets64bit;
+  if trunc(result_val) <> RESULT_S64BIT then
+     failed:=true;
+     
+  result_val := gets32bit;
+  if trunc(result_val) <> RESULT_S32BIT then
+     failed:=true;
+
+
+  result_val := getu32bit;
+  if trunc(result_val) <> RESULT_U32BIT then
+     failed:=true;
+
+  result_val := getu8bit;
+  if trunc(result_val) <> RESULT_u8BIT then
+     failed:=true;
+
+
+  result_val := gets8bit;
+  if trunc(result_val) <> RESULT_s8BIT then
+     failed:=true;
+
+
+  result_val := gets16bit;
+  if trunc(result_val) <> RESULT_S16BIT then
+     failed:=true;
+
+
+  result_val := getu16bit;
+  if trunc(result_val) <> RESULT_U16BIT then
+     failed:=true;
+
+
+  if failed then
+    fail
+  else
+    WriteLn('Passed!');
+    
+end.
+
+{
+
+ $Log$
+ Revision 1.1  2002-08-10 08:27:43  carl
+   + mre tests for cg testuit
+
+}

tests/test/cg/tfuncret.pp

@@ -0,0 +1,319 @@
+{****************************************************************}
+{  CODE GENERATOR TEST PROGRAM                                   }
+{  By Carl Eric Codere                                           }
+{****************************************************************}
+{ NODE TESTED : secondfuncret()                                  }
+{****************************************************************}
+{ DEFINES:                                                       }
+{            FPC     = Target is FreePascal compiler             }
+{****************************************************************}
+{ REMARKS : Tested with Delphi 3 as reference implementation     }
+{****************************************************************}
+program tfuncret;
+
+{$ifdef ver70}
+{$define tp}
+{$endif}
+
+const
+  { adjusts the size of the bigrecord }
+  MAX_INDEX = 7;
+  
+  
+  RESULT_S64BIT = -12;
+  RESULT_S32BIT = -124356;
+  RESULT_U32BIT = 654321;
+  RESULT_U8BIT  = $55;
+type
+  { 
+    the size of this record should *at least* be the size
+    of a natural register for the target processor
+  }  
+  tbigrecord = record
+   x : cardinal;
+   y : cardinal;
+   z : array[0..MAX_INDEX] of byte;
+  end;
+   
+
+    procedure fail;
+    begin
+      WriteLn('Failure.');
+      halt(1);
+    end;
+    
+{****************************************************************}
+{                         SIMPLE CASE                            }
+{****************************************************************}
+    
+    function getresult_simple_s64bit: int64;
+      var
+       s64bit : int64;
+       i: integer;
+      begin
+        getresult_simple_s64bit := 0;
+        s64bit:=RESULT_S64BIT;
+        getresult_simple_s64bit := s64bit;
+      end;
+      
+      
+    function getresult_simple_s32bit: longint;
+      var
+       s32bit : longint;
+       i: longint;
+      begin
+        getresult_simple_s32bit := 0;  
+        i:=1;
+        i:=i*RESULT_S32BIT div i;
+        s32bit:=i;
+        getresult_simple_s32bit := s32bit;
+      end;
+      
+      
+    function getresult_simple_bigrecord : tbigrecord;
+     var
+      localbigrecord : tbigrecord;
+      i: integer;
+     begin
+      localbigrecord.x := RESULT_U32BIT;
+      localbigrecord.y := RESULT_U32BIT;
+      for i:=0 to MAX_INDEX do
+        localbigrecord.z[i] := RESULT_U8BIT;
+      getresult_simple_bigrecord := localbigrecord;
+     end;
+      
+{****************************************************************}
+{                         WITH NESTING                           }
+{****************************************************************}
+
+    function getresult_nested_s64bit: int64;
+    
+      procedure nested_one;
+      var
+       s64bit : int64;
+       i: longint;
+      begin
+        getresult_nested_s64bit := 0;
+        s64bit:=RESULT_S64BIT;
+        getresult_nested_s64bit := s64bit;
+      end;
+    
+    begin
+      nested_one;
+    end;
+      
+      
+    function getresult_nested_s32bit: longint;
+    
+    
+      procedure nested_one;
+      var
+       s32bit : longint;
+       i: longint;
+      begin
+        getresult_nested_s32bit := 0;  
+        i:=1;
+        i:=i*RESULT_S32BIT div i;
+        s32bit:=i;
+        getresult_nested_s32bit := s32bit;
+      end;
+    
+    begin
+      nested_one;
+    end;
+      
+      
+    function getresult_nested_bigrecord : tbigrecord;
+    
+       procedure nested_one;
+        var
+         localbigrecord : tbigrecord;
+         i: longint;
+       begin
+         localbigrecord.x := RESULT_U32BIT;
+         localbigrecord.y := RESULT_U32BIT;
+         for i:=0 to MAX_INDEX do
+           localbigrecord.z[i] := RESULT_U8BIT;
+         getresult_nested_bigrecord := localbigrecord;
+       end;
+     
+     begin
+       nested_one;
+     end;
+
+
+{****************************************************************}
+{                     WITH COMPLEX NESTING                       }
+{****************************************************************}
+
+    function getresult_nested_complex_s64bit: int64;
+    
+      procedure nested_one;
+      var
+       s64bit : int64;
+       i: integer;
+       
+       function nested_two: int64;
+        begin
+         nested_two:=0;
+         getresult_nested_complex_s64bit := 0;
+         s64bit:=RESULT_S64BIT;
+         getresult_nested_complex_s64bit := s64bit;
+        end;
+        
+      begin
+        nested_two;
+      end;
+    
+    begin
+      nested_one;
+    end;
+      
+      
+    function getresult_nested_complex_s32bit: longint;
+    
+    
+      procedure nested_one;
+      var
+       s32bit : longint;
+       i: longint;
+       
+       function nested_two: longint;
+         begin
+           nested_two := 0;
+           getresult_nested_complex_s32bit := 0;  
+           i:=1;
+           i:=i*RESULT_S32BIT div i;
+           s32bit:=i;
+           getresult_nested_complex_s32bit := s32bit;
+         end;
+         
+      begin
+        nested_two; 
+      end;
+    
+    begin
+      nested_one;
+    end;
+      
+      
+    function getresult_nested_complex_bigrecord : tbigrecord;
+    
+       procedure nested_one;
+        var
+         localbigrecord : tbigrecord;
+         
+         function nested_two : tbigrecord;
+           var
+            i : integer;
+           begin
+            nested_two := localbigrecord;
+            localbigrecord.x := RESULT_U32BIT;
+            localbigrecord.y := RESULT_U32BIT;
+            for i:=0 to MAX_INDEX do
+               localbigrecord.z[i] := RESULT_U8BIT;
+            getresult_nested_complex_bigrecord := localbigrecord;
+           end;
+           
+       begin
+         nested_two;
+       end;
+     
+     begin
+       nested_one;
+     end;
+
+
+var
+ failed : boolean;
+ bigrecord : tbigrecord;
+ i: integer;
+Begin
+  Write('secondfuncret simple case tests...');
+  failed := false;
+  if getresult_simple_s64bit <> RESULT_S64BIT then
+    failed := true;
+  if getresult_simple_s32bit <> RESULT_S32BIT then
+    failed := true;
+  bigrecord := getresult_simple_bigrecord; 
+  if bigrecord.x <> RESULT_U32BIT then
+    failed := true;
+  if bigrecord.y <> RESULT_U32BIT then
+    failed := true;
+  for i:=0 to MAX_INDEX do
+    begin
+       if bigrecord.z[i] <> RESULT_U8BIT then
+         begin
+           failed := true;
+           break;
+         end;
+    end;
+
+    
+  if failed then
+    fail
+  else
+    WriteLn('Success!');
+    
+  Write('secondfuncret simple nesting case tests...');
+  failed := false;
+  if getresult_nested_s64bit <> RESULT_S64BIT then
+    failed := true;
+  if getresult_nested_s32bit <> RESULT_S32BIT then
+    failed := true;
+  
+  bigrecord := getresult_nested_bigrecord; 
+  if bigrecord.x <> RESULT_U32BIT then
+    failed := true;
+  if bigrecord.y <> RESULT_U32BIT then
+    failed := true;
+  for i:=0 to MAX_INDEX do
+    begin
+       if bigrecord.z[i] <> RESULT_U8BIT then
+         begin
+           failed := true;
+           break;
+         end;
+    end;
+  
+  
+  if failed then
+    fail
+  else
+    WriteLn('Success!');
+    
+  Write('secondfuncret complex nesting case tests...');
+  failed := false;
+  if getresult_nested_complex_s64bit <> RESULT_S64BIT then
+    failed := true;
+  if getresult_nested_complex_s32bit <> RESULT_S32BIT then
+    failed := true;
+  
+  bigrecord := getresult_nested_complex_bigrecord; 
+  if bigrecord.x <> RESULT_U32BIT then
+    failed := true;
+  if bigrecord.y <> RESULT_U32BIT then
+    failed := true;
+  for i:=0 to MAX_INDEX do
+    begin
+       if bigrecord.z[i] <> RESULT_U8BIT then
+         begin
+           failed := true;
+           break;
+         end;
+    end;
+  
+  
+  if failed then
+    fail
+  else
+    WriteLn('Success!');
+    
+end.
+
+{
+  $Log$
+  Revision 1.1  2002-08-10 08:27:43  carl
+    + mre tests for cg testuit
+
+}  

tests/test/cg/tloadvmt.pp

@@ -0,0 +1,72 @@
+{****************************************************************}
+{  CODE GENERATOR TEST PROGRAM                                   }
+{  By Carl Eric Codere                                           }
+{****************************************************************}
+{ NODE TESTED : secondloadvmt()                                  }
+{****************************************************************}
+{ DEFINES:                                                       }
+{            FPC     = Target is FreePascal compiler             }
+{****************************************************************}
+{ REMARKS : Tested with Delphi 3 as reference implementation     }
+{****************************************************************}
+program tloadvmt;
+
+{$ifdef fpc}
+{$mode objfpc}
+{$endif}
+
+const
+  RESULT_STRING = 'Hello world';
+  
+Type
+  TAObject = class(TObject)
+    a : longint;
+    end;
+  TBObject = Class(TAObject)
+    b : longint;
+    s : shortstring;
+      constructor create(c: longint);
+      function getstring : shortstring;
+    end;
+
+
+    procedure fail;
+    begin
+      WriteLn('Failure.');
+      halt(1);
+    end;
+
+ 
+ constructor tbobject.create(c:longint);
+  begin
+    taobject.create;
+    b:=c;
+    s:=RESULT_STRING;
+  end;
+  
+ function tbobject.getstring : shortstring;
+  begin
+    getstring := s;
+  end;
+  
+ 
+var
+ bobj: TBobject;
+ i: integer;
+ l : longint;
+Begin
+  i:=$7f;
+  Write('Secondloadvmt test...');
+  bobj:=TBobject.create(i);
+  if bobj.getstring <> RESULT_STRING then
+    fail
+  else
+    WriteLn('Success!');
+end.
+
+{
+  $Log$
+  Revision 1.1  2002-08-10 08:27:43  carl
+    + mre tests for cg testuit
+
+}  

tests/test/cg/traise1.pp

@@ -0,0 +1,64 @@
+{ %RESULT=217 }
+{****************************************************************}
+{  CODE GENERATOR TEST PROGRAM                                   }
+{  By Carl Eric Codere                                           }
+{****************************************************************}
+{ NODE TESTED : secondraise()                                    }
+{****************************************************************}
+{ PRE-REQUISITES: secondload()                                   }
+{                 secondassign()                                 }
+{                 secondtypeconv()                               }
+{                 secondtryexcept()                              }
+{                 secondcalln()                                  }
+{                 secondadd()                                    }
+{****************************************************************}
+{ DEFINES:                                                       }
+{            FPC     = Target is FreePascal compiler             }
+{****************************************************************}
+{ REMARKS : Tested with Delphi 3 as reference implementation     }
+{****************************************************************}
+program traise1;
+
+{$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;
+
+ 
+ constructor tbobject.create(c:longint);
+  begin
+    inherited create;
+    b:=c;
+  end;
+ 
+
+var
+  A: TAObject;
+Begin
+  A:=TAobject.create;
+  raise A;
+end.
+
+{
+  $Log$
+  Revision 1.1  2002-08-10 08:27:44  carl
+    + mre tests for cg testuit
+
+}  

tests/test/cg/traise2.pp

@@ -0,0 +1,61 @@
+{ %RESULT=217 }
+{****************************************************************}
+{  CODE GENERATOR TEST PROGRAM                                   }
+{  By Carl Eric Codere                                           }
+{****************************************************************}
+{ NODE TESTED : secondraise()                                    }
+{****************************************************************}
+{ PRE-REQUISITES: secondload()                                   }
+{                 secondassign()                                 }
+{                 secondtypeconv()                               }
+{                 secondtryexcept()                              }
+{                 secondcalln()                                  }
+{                 secondadd()                                    }
+{****************************************************************}
+{ DEFINES:                                                       }
+{            FPC     = Target is FreePascal compiler             }
+{****************************************************************}
+{ REMARKS : Tested with Delphi 3 as reference implementation     }
+{****************************************************************}
+program traise2;
+
+{$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;
+
+ 
+ constructor tbobject.create(c:longint);
+  begin
+    inherited create;
+    b:=c;
+  end;
+ 
+
+Begin
+  raise TAobject.create;
+end.
+
+{
+  $Log$
+  Revision 1.1  2002-08-10 08:27:44  carl
+    + mre tests for cg testuit
+
+}  

tests/test/cg/traise3.pp

@@ -0,0 +1,65 @@
+{ %RESULT=217 }
+{****************************************************************}
+{  CODE GENERATOR TEST PROGRAM                                   }
+{  By Carl Eric Codere                                           }
+{****************************************************************}
+{ NODE TESTED : secondraise()                                    }
+{****************************************************************}
+{ PRE-REQUISITES: secondload()                                   }
+{                 secondassign()                                 }
+{                 secondtypeconv()                               }
+{                 secondtryexcept()                              }
+{                 secondcalln()                                  }
+{                 secondadd()                                    }
+{****************************************************************}
+{ DEFINES:                                                       }
+{            FPC     = Target is FreePascal compiler             }
+{****************************************************************}
+{ REMARKS : Tested with Delphi 3 as reference implementation     }
+{****************************************************************}
+program traise3;
+
+{$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;
+
+ 
+ constructor tbobject.create(c:longint);
+  begin
+    inherited create;
+    b:=c;
+  end;
+ 
+var
+ bobj: TBobject;
+ i: integer;
+Begin
+  i:=$7f;
+  bobj := TBobject.create(i);
+  raise bobj;
+end.
+
+{
+  $Log$
+  Revision 1.1  2002-08-10 08:27:44  carl
+    + mre tests for cg testuit
+
+}  

tests/test/cg/traise4.pp

@@ -0,0 +1,64 @@
+{ %RESULT=217 }
+{****************************************************************}
+{  CODE GENERATOR TEST PROGRAM                                   }
+{  By Carl Eric Codere                                           }
+{****************************************************************}
+{ NODE TESTED : secondraise()                                    }
+{****************************************************************}
+{ PRE-REQUISITES: secondload()                                   }
+{                 secondassign()                                 }
+{                 secondtypeconv()                               }
+{                 secondtryexcept()                              }
+{                 secondcalln()                                  }
+{                 secondadd()                                    }
+{****************************************************************}
+{ DEFINES:                                                       }
+{            FPC     = Target is FreePascal compiler             }
+{****************************************************************}
+{ REMARKS : Tested with Delphi 3 as reference implementation     }
+{****************************************************************}
+program traise4;
+
+{$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;
+
+ 
+ constructor tbobject.create(c:longint);
+  begin
+    inherited create;
+    b:=c;
+  end;
+ 
+var
+ bobj: TBobject;
+ i: integer;
+Begin
+  i:=$7f;
+  raise TBobject.create(i);
+end.
+
+{
+  $Log$
+  Revision 1.1  2002-08-10 08:27:44  carl
+    + mre tests for cg testuit
+
+}  

tests/test/cg/traise5.pp

@@ -0,0 +1,74 @@
+{ %RESULT=217 }
+{****************************************************************}
+{  CODE GENERATOR TEST PROGRAM                                   }
+{  By Carl Eric Codere                                           }
+{****************************************************************}
+{ NODE TESTED : secondraise()                                    }
+{****************************************************************}
+{ PRE-REQUISITES: secondload()                                   }
+{                 secondassign()                                 }
+{                 secondtypeconv()                               }
+{                 secondtryexcept()                              }
+{                 secondcalln()                                  }
+{                 secondadd()                                    }
+{****************************************************************}
+{ DEFINES:                                                       }
+{            FPC     = Target is FreePascal compiler             }
+{****************************************************************}
+{ REMARKS : Tested with Delphi 3 as reference implementation     }
+{****************************************************************}
+program traise5;
+
+{$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;
+
+ 
+ constructor tbobject.create(c:longint);
+  begin
+    inherited create;
+    b:=c;
+  end;
+  
+  
+  procedure MyRoutine;
+   Begin
+     WriteLn('hello world!');
+   end;
+ 
+var
+ bobj: TBobject;
+ i: integer;
+Begin
+  i:=$7f;
+{$ifdef ver1_0}  
+  raise TBobject.create(i) at longint(@MyRoutine);
+{$else}
+  raise TBobject.create(i) at @MyRoutine;
+{$endif}
+end.
+
+{
+  $Log$
+  Revision 1.1  2002-08-10 08:27:44  carl
+    + mre tests for cg testuit
+
+}  

tests/test/cg/traise6.pp

@@ -0,0 +1,74 @@
+{ %RESULT=217 }
+{****************************************************************}
+{  CODE GENERATOR TEST PROGRAM                                   }
+{  By Carl Eric Codere                                           }
+{****************************************************************}
+{ NODE TESTED : secondraise()                                    }
+{****************************************************************}
+{ PRE-REQUISITES: secondload()                                   }
+{                 secondassign()                                 }
+{                 secondtypeconv()                               }
+{                 secondtryexcept()                              }
+{                 secondcalln()                                  }
+{                 secondadd()                                    }
+{****************************************************************}
+{ DEFINES:                                                       }
+{            FPC     = Target is FreePascal compiler             }
+{****************************************************************}
+{ REMARKS : Tested with Delphi 3 as reference implementation     }
+{****************************************************************}
+program traise6;
+
+{$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;
+
+ 
+ constructor tbobject.create(c:longint);
+  begin
+    inherited create;
+    b:=c;
+  end;
+  
+  
+  procedure MyRoutine;
+   Begin
+     WriteLn('hello world!');
+   end;
+ 
+var
+ bobj: TBobject;
+ i: integer;
+Begin
+  i:=$7f;
+{$ifdef ver1_0}  
+  raise TBobject.create(i) at longint(@MyRoutine);
+{$else}
+  raise TBobject.create(i) at @MyRoutine,$00000001;
+{$endif}
+end.
+
+{
+  $Log$
+  Revision 1.1  2002-08-10 08:27:44  carl
+    + mre tests for cg testuit
+
+}