freepascal.compiler/tests/test/cg/tcalfun9.pp

 {****************************************************************}
 {  CODE GENERATOR TEST PROGRAM                                   }
 {  By Carl Eric Codere                                           }
 {****************************************************************}
 { NODE TESTED : secondcallparan()                                }
 {****************************************************************}
 { PRE-REQUISITES: secondload()                                   }
 {                 secondassign()                                 }
 {                 secondtypeconv()                               }
 {                 secondtryexcept()                              }
 {                 secondcalln()                                  }
 {                 secondadd()                                    }
 {****************************************************************}
 { DEFINES:                                                       }
 {            FPC     = Target is FreePascal compiler             }
 {****************************************************************}
 { REMARKS: This tests a subset of the secondcalln() node         }
 {          (function return values with saveregs calling cnvs)   }
 {          (also tests nested routines up to 2 level deep)       }
 {****************************************************************}
 program tcalfun9;

 {$ifdef fpc}
 {$mode objfpc}
 {$INLINE ON}
 {$endif}
 {$R+}
 {$P-}

{$ifdef VER70}
  {$define tp}
{$endif}


  { REAL should map to single or double }
  { so it is not checked, since single  }
  { double nodes are checked.           }

  { assumes that enumdef is the same as orddef (same storage format) }

  const
 { should be defined depending on CPU target }
{$ifdef fpc}
  {$ifdef cpu68k}
    BIG_INDEX = 12000;
    MEDIUM_INDEX = 5000;
    SMALL_INDEX  = 13;
  {$else}
    BIG_INDEX = 33000;
    MEDIUM_INDEX = 5000;
    SMALL_INDEX = 13;     { value should not be aligned! }
  {$endif}
{$else}
  BIG_INDEX = 33000;
  MEDIUM_INDEX = 5000;
  SMALL_INDEX = 13;     { value should not be aligned! }
{$endif}
   RESULT_U8BIT = $55;
   RESULT_U16BIT = $500F;
   RESULT_S32BIT = $500F0000;
   RESULT_S64BIT = $500F0000;
   RESULT_S32REAL = 1777.12;
   RESULT_S64REAL = 3444.24;
   RESULT_BOOL8BIT = 1;
   RESULT_BOOL16BIT = 1;
   RESULT_BOOL32BIT = 1;
   RESULT_PCHAR = 'Hello world';
   RESULT_BIGSTRING = 'Hello world';
   RESULT_SMALLSTRING = 'H';
   RESULT_CHAR = 'I';
   RESULT_BOOLEAN = TRUE;

 type
 {$ifndef tp}
   tclass1 = class
   end;
 {$else}
   shortstring = string;
 {$endif}

   tprocedure = procedure;

   tsmallrecord = packed record
     b: byte;
     w: word;
   end;

   tlargerecord = packed record
     b: array[1..BIG_INDEX] of byte;
   end;

   tmediumrecord = packed record
     b: array[1..MEDIUM_INDEX] of byte;
   end;

   tsmallarray = packed array[1..SMALL_INDEX] of byte;

   tsmallsetenum =
   (A_A,A_B,A_C,A_D);

   tsmallset = set of tsmallsetenum;
   tlargeset = set of char;

   tsmallstring = string[2];





 var
  global_u8bit : byte;
  global_u16bit : word;
  global_s32bit : longint;
  global_s32real : single;
  global_s64real : double;
  global_ptr : pchar;
  global_proc : tprocedure;
  global_bigstring : shortstring;
  global_boolean : boolean;
  global_char : char;
 {$ifndef tp}
  global_class : tclass1;
  global_s64bit : int64;
  value_s64bit : int64;
  value_class : tclass1;
 {$endif}
  value_ansistring : ansistring;
  value_u8bit : byte;
  value_u16bit : word;
  value_s32bit : longint;
  value_s32real : single;
  value_s64real  : double;
  value_proc : tprocedure;
  value_ptr : pchar;
  value_smallrec : tsmallrecord;
  value_largerec : tlargerecord;
  value_mediumrec : tmediumrecord;
  value_smallset : tsmallset;
  value_smallstring : tsmallstring;
  value_bigstring   : shortstring;
  value_largeset : tlargeset;
  value_smallarray : tsmallarray;
  value_boolean : boolean;
  value_char : char;

     procedure fail;
     begin
       WriteLn('Failure.');
       halt(1);
     end;


     procedure clear_globals;
      begin
       global_u8bit := 0;
       global_u16bit := 0;
       global_s32bit := 0;
       global_s32real := 0.0;
       global_s64real := 0.0;
       global_ptr := nil;
       global_proc := nil;
       global_bigstring := '';
       global_boolean := false;
       global_char := #0;
       global_s64bit := 0;
       global_class := nil;
      end;


     procedure clear_values;
      begin
       value_u8bit := 0;
       value_u16bit := 0;
       value_s32bit := 0;
       value_s32real := 0.0;
       value_s64real  := 0.0;
       value_proc := nil;
       value_ptr := nil;
       fillchar(value_smallrec, sizeof(value_smallrec), #0);
       fillchar(value_largerec, sizeof(value_largerec), #0);
       fillchar(value_mediumrec, sizeof(value_mediumrec), #0);
       value_smallset := [];
       value_smallstring := '';
       value_bigstring   := '';
       value_largeset := [];
       fillchar(value_smallarray, sizeof(value_smallarray), #0);
       value_boolean := false;
       value_char:=#0;
       value_ansistring := '';
 {$ifndef tp}
       value_s64bit := 0;
       value_class := nil;
 {$endif}
      end;



 {********************************* FUNCTION RESULTS *************************}

{ LOC_MEM return values }
function func_array: tsmallarray;saveregisters;
 var
  smallarray: tsmallarray;
 begin
  fillchar(smallarray, sizeof(smallarray), #0);
  smallarray[1] := RESULT_U8BIT;
  smallarray[SMALL_INDEX] := RESULT_U8BIT;
  func_array := smallarray;
 end;

function func_largerecord: tlargerecord;saveregisters;
 var
   largerecord : tlargerecord;
 begin
   fillchar(largerecord, sizeof(largerecord), #0);
   largerecord.b[1] := RESULT_U8BIT;
   largerecord.b[BIG_INDEX] := RESULT_U8BIT;
   func_largerecord := largerecord;
 end;

function func_mediumrecord: tmediumrecord;saveregisters;
 var
   mediumrecord : tmediumrecord;
 begin
   fillchar(mediumrecord, sizeof(mediumrecord), #0);
   mediumrecord.b[1] := RESULT_U8BIT;
   mediumrecord.b[MEDIUM_INDEX] := RESULT_U8BIT;
   func_mediumrecord := mediumrecord;
 end;


function func_shortstring: shortstring;saveregisters;
 begin
   func_shortstring := RESULT_BIGSTRING;
 end;

function func_largeset : tlargeset;saveregisters;
 var
  largeset : tlargeset;
 begin
  largeset := ['I'];
  func_largeset := largeset;
 end;

function func_u8bit : byte;saveregisters;
 begin
   func_u8bit := RESULT_U8BIT;
 end;

function func_u16bit : word;saveregisters;
 begin
   func_u16bit := RESULT_U16BIT;
 end;

function func_s32bit : longint;saveregisters;
 begin
   func_s32bit := RESULT_S32BIT;
 end;

function func_s64bit : int64;saveregisters;
 begin
   func_s64bit := RESULT_S64BIT;
 end;

function func_s32real : single;saveregisters;
 begin
   func_s32real := RESULT_S32REAL;
 end;

function func_s64real : double;saveregisters;
 begin
   func_s64real := RESULT_S64REAl;
 end;

function func_ansistring : ansistring;saveregisters;
 begin
   func_ansistring := RESULT_BIGSTRING;
 end;

function func_pchar : pchar;saveregisters;
 begin
   func_pchar := RESULT_PCHAR;
 end;

 {************************** FUNCTION RESULT WITH PARAMS ******************}
{ LOC_MEM return values }
function func_array_mixed(b: byte): tsmallarray;saveregisters;
 var
  local_b: byte;
  smallarray: tsmallarray;
 begin
  fillchar(smallarray, sizeof(smallarray), #0);
  smallarray[1] := RESULT_U8BIT;
  smallarray[SMALL_INDEX] := RESULT_U8BIT;
  func_array_mixed := smallarray;
  local_b:=b;
  global_u8bit := b;
 end;

function func_largerecord_mixed(b: byte): tlargerecord;saveregisters;
 var
   local_b: byte;
   largerecord : tlargerecord;
 begin
   fillchar(largerecord, sizeof(largerecord), #0);
   largerecord.b[1] := RESULT_U8BIT;
   largerecord.b[BIG_INDEX] := RESULT_U8BIT;
   func_largerecord_mixed := largerecord;
   local_b:=b;
   global_u8bit := b;
 end;

function func_shortstring_mixed(b: byte): shortstring;saveregisters;
 var
  local_b: byte;
 begin
   func_shortstring_mixed := RESULT_BIGSTRING;
   local_b:=b;
   global_u8bit := b;
 end;

function func_largeset_mixed(b: byte) : tlargeset;saveregisters;
 var
  local_b: byte;
  largeset : tlargeset;
 begin
  largeset := ['I'];
  func_largeset_mixed := largeset;
   local_b:=b;
   global_u8bit := b;
 end;

function func_u8bit_mixed(b: byte) : byte;saveregisters;
 var
  local_b: byte;
 begin
   func_u8bit_mixed := RESULT_U8BIT;
   local_b:=b;
   global_u8bit := b;
 end;

function func_u16bit_mixed(b: byte) : word;saveregisters;
 var
  local_b: byte;
 begin
   func_u16bit_mixed := RESULT_U16BIT;
   local_b:=b;
   global_u8bit := b;
 end;

function func_s32bit_mixed(b: byte) : longint;saveregisters;
 var
  local_b: byte;
 begin
   func_s32bit_mixed := RESULT_S32BIT;
   local_b:=b;
   global_u8bit := b;
 end;

function func_s64bit_mixed(b: byte) : int64;saveregisters;
 var
  local_b: byte;
 begin
   func_s64bit_mixed := RESULT_S64BIT;
   local_b:=b;
   global_u8bit := b;
 end;

function func_s32real_mixed(b: byte) : single;saveregisters;
 var
  local_b: byte;
 begin
   func_s32real_mixed := RESULT_S32REAL;
   local_b:=b;
   global_u8bit := b;
 end;

function func_s64real_mixed(b: byte) : double;saveregisters;
 var
  local_b: byte;
 begin
   func_s64real_mixed := RESULT_S64REAl;
   local_b:=b;
   global_u8bit := b;
 end;

function func_ansistring_mixed(b: byte) : ansistring;saveregisters;
 var
  local_b: byte;
 begin
   func_ansistring_mixed := RESULT_BIGSTRING;
   local_b:=b;
   global_u8bit := b;
 end;

function func_pchar_mixed(b: byte) : pchar;saveregisters;
 var
  local_b: byte;
 begin
   func_pchar_mixed := RESULT_PCHAR;
   local_b:=b;
   global_u8bit := b;
 end;

 {********************* FUNCTION RESULT WITH PARAMS (NESTED) ******************}
{ LOC_MEM return values }
function func_array_mixed_nested(b: byte): tsmallarray;saveregisters;

    procedure nested_one_proc(l: longint);
     begin
       global_u16bit := b;
       global_s32bit := l;
     end;

    procedure nested_two_proc(l : longint);
     begin
       global_s64bit := l;
     end;



   function nested_one_func(level1_b : byte; s: shortstring): byte;
     var
      s1 : shortstring;

      function nested_two_func(level2_b : byte; s :shortstring): byte;
        begin
          nested_two_func:=level2_b;
          global_bigstring := s;
          nested_one_proc(RESULT_S32BIT);
        end;

    begin
      s1:=s;
      nested_one_func := nested_two_func(level1_b,s1);
      nested_two_proc(level1_b);
    end;


 var
  local_b: byte;
  smallarray: tsmallarray;
 begin
  fillchar(smallarray, sizeof(smallarray), #0);
  smallarray[1] := RESULT_U8BIT;
  smallarray[SMALL_INDEX] := RESULT_U8BIT;
  func_array_mixed_nested := smallarray;
  local_b:=b;
  global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
{  nested_one_proc(RESULT_S32BIT);}
 end;

function func_largerecord_mixed_nested(b: byte): tlargerecord;saveregisters;

    procedure nested_one_proc(l: longint);
     begin
       global_u16bit := b;
       global_s32bit := l;
     end;

    procedure nested_two_proc(l : longint);
     begin
       global_s64bit := l;
     end;



   function nested_one_func(level1_b : byte; s: shortstring): byte;
     var
      s1 : shortstring;

      function nested_two_func(level2_b : byte; s :shortstring): byte;
        begin
          nested_two_func:=level2_b;
          global_bigstring := s;
          nested_one_proc(RESULT_S32BIT);
        end;

    begin
      s1:=s;
      nested_one_func := nested_two_func(level1_b,s1);
      nested_two_proc(level1_b);
    end;


 var
   local_b: byte;
   largerecord : tlargerecord;
 begin
   fillchar(largerecord, sizeof(largerecord), #0);
   largerecord.b[1] := RESULT_U8BIT;
   largerecord.b[BIG_INDEX] := RESULT_U8BIT;
   func_largerecord_mixed_nested := largerecord;
   local_b:=b;
   global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
 end;

function func_shortstring_mixed_nested(b: byte): shortstring;saveregisters;

    procedure nested_one_proc(l: longint);
     begin
       global_u16bit := b;
       global_s32bit := l;
     end;

    procedure nested_two_proc(l : longint);
     begin
       global_s64bit := l;
     end;



   function nested_one_func(level1_b : byte; s: shortstring): byte;
     var
      s1 : shortstring;

      function nested_two_func(level2_b : byte; s :shortstring): byte;
        begin
          nested_two_func:=level2_b;
          global_bigstring := s;
          nested_one_proc(RESULT_S32BIT);
        end;

    begin
      s1:=s;
      nested_one_func := nested_two_func(level1_b,s1);
      nested_two_proc(level1_b);
    end;

 var
  local_b: byte;
 begin
   func_shortstring_mixed_nested := RESULT_BIGSTRING;
   local_b:=b;
   global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
 end;

function func_largeset_mixed_nested(b: byte) : tlargeset;saveregisters;

    procedure nested_one_proc(l: longint);
     begin
       global_u16bit := b;
       global_s32bit := l;
     end;

    procedure nested_two_proc(l : longint);
     begin
       global_s64bit := l;
     end;



   function nested_one_func(level1_b : byte; s: shortstring): byte;
     var
      s1 : shortstring;

      function nested_two_func(level2_b : byte; s :shortstring): byte;
        begin
          nested_two_func:=level2_b;
          global_bigstring := s;
          nested_one_proc(RESULT_S32BIT);
        end;

    begin
      s1:=s;
      nested_one_func := nested_two_func(level1_b,s1);
      nested_two_proc(level1_b);
    end;


 var
  local_b: byte;
  largeset : tlargeset;
 begin
  largeset := ['I'];
  func_largeset_mixed_nested := largeset;
  local_b:=b;
  global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
 end;

function func_u8bit_mixed_nested(b: byte) : byte;saveregisters;

    procedure nested_one_proc(l: longint);
     begin
       global_u16bit := b;
       global_s32bit := l;
     end;

    procedure nested_two_proc(l : longint);
     begin
       global_s64bit := l;
     end;



   function nested_one_func(level1_b : byte; s: shortstring): byte;
     var
      s1 : shortstring;

      function nested_two_func(level2_b : byte; s :shortstring): byte;
        begin
          nested_two_func:=level2_b;
          global_bigstring := s;
          nested_one_proc(RESULT_S32BIT);
        end;

    begin
      s1:=s;
      nested_one_func := nested_two_func(level1_b,s1);
      nested_two_proc(level1_b);
    end;


 var
  local_b: byte;
 begin
   func_u8bit_mixed_nested := RESULT_U8BIT;
   local_b:=b;
   global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
 end;

function func_u16bit_mixed_nested(b: byte) : word;saveregisters;

    procedure nested_one_proc(l: longint);
     begin
       global_u16bit := b;
       global_s32bit := l;
     end;

    procedure nested_two_proc(l : longint);
     begin
       global_s64bit := l;
     end;



   function nested_one_func(level1_b : byte; s: shortstring): byte;
     var
      s1 : shortstring;

      function nested_two_func(level2_b : byte; s :shortstring): byte;
        begin
          nested_two_func:=level2_b;
          global_bigstring := s;
          nested_one_proc(RESULT_S32BIT);
        end;

    begin
      s1:=s;
      nested_one_func := nested_two_func(level1_b,s1);
      nested_two_proc(level1_b);
    end;


 var
  local_b: byte;
 begin
   func_u16bit_mixed_nested := RESULT_U16BIT;
   local_b:=b;
   global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
 end;

function func_s32bit_mixed_nested(b: byte) : longint;saveregisters;

    procedure nested_one_proc(l: longint);
     begin
       global_u16bit := b;
       global_s32bit := l;
     end;

    procedure nested_two_proc(l : longint);
     begin
       global_s64bit := l;
     end;



   function nested_one_func(level1_b : byte; s: shortstring): byte;
     var
      s1 : shortstring;

      function nested_two_func(level2_b : byte; s :shortstring): byte;
        begin
          nested_two_func:=level2_b;
          global_bigstring := s;
          nested_one_proc(RESULT_S32BIT);
        end;

    begin
      s1:=s;
      nested_one_func := nested_two_func(level1_b,s1);
      nested_two_proc(level1_b);
    end;


 var
  local_b: byte;
 begin
   func_s32bit_mixed_nested := RESULT_S32BIT;
   local_b:=b;
   global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
 end;

function func_s64bit_mixed_nested(b: byte) : int64;saveregisters;

    procedure nested_one_proc(l: longint);
     begin
       global_u16bit := b;
       global_s32bit := l;
     end;

    procedure nested_two_proc(l : longint);
     begin
       global_s64bit := l;
     end;



   function nested_one_func(level1_b : byte; s: shortstring): byte;
     var
      s1 : shortstring;

      function nested_two_func(level2_b : byte; s :shortstring): byte;
        begin
          nested_two_func:=level2_b;
          global_bigstring := s;
          nested_one_proc(RESULT_S32BIT);
        end;

    begin
      s1:=s;
      nested_one_func := nested_two_func(level1_b,s1);
      nested_two_proc(level1_b);
    end;


 var
  local_b: byte;
 begin
   func_s64bit_mixed_nested := RESULT_S64BIT;
   local_b:=b;
   global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
 end;

function func_s32real_mixed_nested(b: byte) : single;saveregisters;

    procedure nested_one_proc(l: longint);
     begin
       global_u16bit := b;
       global_s32bit := l;
     end;

    procedure nested_two_proc(l : longint);
     begin
       global_s64bit := l;
     end;



   function nested_one_func(level1_b : byte; s: shortstring): byte;
     var
      s1 : shortstring;

      function nested_two_func(level2_b : byte; s :shortstring): byte;
        begin
          nested_two_func:=level2_b;
          global_bigstring := s;
          nested_one_proc(RESULT_S32BIT);
        end;

    begin
      s1:=s;
      nested_one_func := nested_two_func(level1_b,s1);
      nested_two_proc(level1_b);
    end;


 var
  local_b: byte;
 begin
   func_s32real_mixed_nested := RESULT_S32REAL;
   local_b:=b;
   global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
 end;

function func_s64real_mixed_nested(b: byte) : double;saveregisters;

    procedure nested_one_proc(l: longint);
     begin
       global_u16bit := b;
       global_s32bit := l;
     end;

    procedure nested_two_proc(l : longint);
     begin
       global_s64bit := l;
     end;



   function nested_one_func(level1_b : byte; s: shortstring): byte;
     var
      s1 : shortstring;

      function nested_two_func(level2_b : byte; s :shortstring): byte;
        begin
          nested_two_func:=level2_b;
          global_bigstring := s;
          nested_one_proc(RESULT_S32BIT);
        end;

    begin
      s1:=s;
      nested_one_func := nested_two_func(level1_b,s1);
      nested_two_proc(level1_b);
    end;


 var
  local_b: byte;
 begin
   func_s64real_mixed_nested := RESULT_S64REAl;
   local_b:=b;
   global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
 end;

function func_ansistring_mixed_nested(b: byte) : ansistring;saveregisters;

    procedure nested_one_proc(l: longint);
     begin
       global_u16bit := b;
       global_s32bit := l;
     end;

    procedure nested_two_proc(l : longint);
     begin
       global_s64bit := l;
     end;



   function nested_one_func(level1_b : byte; s: shortstring): byte;
     var
      s1 : shortstring;

      function nested_two_func(level2_b : byte; s :shortstring): byte;
        begin
          nested_two_func:=level2_b;
          global_bigstring := s;
          nested_one_proc(RESULT_S32BIT);
        end;

    begin
      s1:=s;
      nested_one_func := nested_two_func(level1_b,s1);
      nested_two_proc(level1_b);
    end;


 var
  local_b: byte;
 begin
   func_ansistring_mixed_nested := RESULT_BIGSTRING;
   local_b:=b;
   global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
 end;

function func_pchar_mixed_nested(b: byte) : pchar;saveregisters;

    procedure nested_one_proc(l: longint);
     begin
       global_u16bit := b;
       global_s32bit := l;
     end;

    procedure nested_two_proc(l : longint);
     begin
       global_s64bit := l;
     end;



   function nested_one_func(level1_b : byte; s: shortstring): byte;
     var
      s1 : shortstring;

      function nested_two_func(level2_b : byte; s :shortstring): byte;
        begin
          nested_two_func:=level2_b;
          global_bigstring := s;
          nested_one_proc(RESULT_S32BIT);
        end;

    begin
      s1:=s;
      nested_one_func := nested_two_func(level1_b,s1);
      nested_two_proc(level1_b);
    end;


 var
  local_b: byte;
 begin
   func_pchar_mixed_nested := RESULT_PCHAR;
   local_b:=b;
   global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
 end;


var
 failed: boolean;
Begin
 {************************************* SIMPLE TESTS ***********************************}
 write('Testing function results (LOC_REFERENCE)...');

 clear_globals;
 clear_values;
 failed := false;

 value_smallarray := func_array;
 if (value_smallarray[1] <> RESULT_U8BIT) or (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) then
   failed := true;

 clear_globals;
 clear_values;
 value_largerec := func_largerecord;
 if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[BIG_INDEX] <> RESULT_U8BIT) then
    failed:=true;

 clear_globals;
 clear_values;
 value_mediumrec := func_mediumrecord;
 if (value_mediumrec.b[1] <> RESULT_U8BIT) or (value_mediumrec.b[MEDIUM_INDEX] <> RESULT_U8BIT) then
    failed:=true;


 clear_globals;
 clear_values;
 value_bigstring := func_shortstring;
 if value_bigstring <> RESULT_BIGSTRING then
   failed := true;

 clear_globals;
 clear_values;
 value_largeset := func_largeset;
 if not ('I' in value_largeset) then
   failed := true;

 if failed then
   fail
 else
   WriteLn('Passed!');

 write('Testing orddef/enumdef function results (LOC_REGISTER)...');

 clear_globals;
 clear_values;
 failed := false;


 value_u8bit := func_u8bit;
 if value_u8bit <> RESULT_U8BIT then
     failed := true;

 clear_globals;
 clear_values;
 value_u16bit := func_u16bit;
 if value_u16bit <> RESULT_U16BIT then
     failed := true;

 clear_globals;
 clear_values;
 value_s32bit := func_s32bit;
 if value_s32bit <> RESULT_S32BIT then
     failed := true;

 clear_globals;
 clear_values;
 value_s64bit := func_s64bit;
 if value_s64bit <> RESULT_S64BIT then
    failed := true;

 if failed then
   fail
 else
   WriteLn('Passed!');


 write('Testing floatdef function results...');

 clear_globals;
 clear_values;
 failed := false;

 clear_globals;
 clear_values;
 value_s32real := func_s32real;
 if trunc(value_s32real) <> trunc(RESULT_S32REAL) then
   failed:=true;

 clear_globals;
 clear_values;
 value_s64real := func_s64real;
 if trunc(value_s64real) <> trunc(RESULT_S64REAL) then
   failed:=true;

 if failed then
   fail
 else
   WriteLn('Passed!');

 write('Testing ansistring function result...');

 clear_globals;
 clear_values;
 failed := false;


value_ansistring := func_ansistring;
if value_ansistring <> RESULT_BIGSTRING then
   failed:=true;

 if failed then
   fail
 else
   WriteLn('Passed!');

 write('Testing pointer function result (LOC_REGISTER)...');

 clear_globals;
 clear_values;
 failed := false;

 value_ptr := func_pchar;
 if value_ptr <> RESULT_PCHAR then
    failed := true;

 if failed then
   fail
 else
   WriteLn('Passed!');

 {*********************************** TESTS W/PARAMS ***********************************}
 write('Testing function results with parameter (LOC_REFERENCE)...');

 clear_globals;
 clear_values;
 failed := false;

 value_smallarray := func_array_mixed(RESULT_U8BIT);
 if (value_smallarray[1] <> RESULT_U8BIT) or (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) then
   failed := true;
 if global_u8bit <> RESULT_U8BIT then
   failed := true;

 clear_globals;
 clear_values;
 value_largerec := func_largerecord_mixed(RESULT_U8BIT);
 if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[BIG_INDEX] <> RESULT_U8BIT) then
    failed:=true;
 if global_u8bit <> RESULT_U8BIT then
   failed := true;

 clear_globals;
 clear_values;
 value_bigstring := func_shortstring_mixed(RESULT_U8BIT);
 if value_bigstring <> RESULT_BIGSTRING then
   failed := true;
 if global_u8bit <> RESULT_U8BIT then
   failed := true;

 clear_globals;
 clear_values;
 value_largeset := func_largeset_mixed(RESULT_U8BIT);
 if not ('I' in value_largeset) then
   failed := true;
 if global_u8bit <> RESULT_U8BIT then
   failed := true;

 if failed then
   fail
 else
   WriteLn('Passed!');

 write('Testing orddef/enumdef function results with parameter (LOC_REGISTER)...');

 clear_globals;
 clear_values;
 failed := false;


 value_u8bit := func_u8bit_mixed(RESULT_U8BIT);
 if value_u8bit <> RESULT_U8BIT then
     failed := true;
 if global_u8bit <> RESULT_U8BIT then
   failed := true;

 clear_globals;
 clear_values;
 value_u16bit := func_u16bit_mixed(RESULT_U8BIT);
 if value_u16bit <> RESULT_U16BIT then
     failed := true;
 if global_u8bit <> RESULT_U8BIT then
   failed := true;

 clear_globals;
 clear_values;
 value_s32bit := func_s32bit_mixed(RESULT_U8BIT);
 if value_s32bit <> RESULT_S32BIT then
     failed := true;
 if global_u8bit <> RESULT_U8BIT then
   failed := true;

 clear_globals;
 clear_values;
 value_s64bit := func_s64bit_mixed(RESULT_U8BIT);
 if value_s64bit <> RESULT_S64BIT then
    failed := true;
 if global_u8bit <> RESULT_U8BIT then
   failed := true;

 if failed then
   fail
 else
   WriteLn('Passed!');


 write('Testing floatdef function results with parameter...');

 clear_globals;
 clear_values;
 failed := false;

 value_s32real := func_s32real_mixed(RESULT_U8BIT);
 if trunc(value_s32real) <> trunc(RESULT_S32REAL) then
   failed:=true;
 if global_u8bit <> RESULT_U8BIT then
   failed := true;

 clear_globals;
 clear_values;
 value_s64real := func_s64real_mixed(RESULT_U8BIT);
 if trunc(value_s64real) <> trunc(RESULT_S64REAL) then
   failed:=true;
 if global_u8bit <> RESULT_U8BIT then
   failed := true;

 if failed then
   fail
 else
   WriteLn('Passed!');

 write('Testing ansistring function result with parameter...');

 clear_globals;
 clear_values;
 failed := false;


 value_ansistring := func_ansistring_mixed(RESULT_U8BIT);
 if value_ansistring <> RESULT_BIGSTRING then
   failed:=true;
 if global_u8bit <> RESULT_U8BIT then
   failed := true;

 if failed then
   fail
 else
   WriteLn('Passed!');

 write('Testing pointer function result with parameter (LOC_REGISTER)...');

 clear_globals;
 clear_values;
 failed := false;

 value_ptr := func_pchar_mixed(RESULT_U8BIT);
 if value_ptr <> RESULT_PCHAR then
    failed := true;
 if global_u8bit <> RESULT_U8BIT then
    failed := true;

 if failed then
   fail
 else
   WriteLn('Passed!');

 {******************************NESTED TESTS W/PARAMS **********************************}
 write('Testing function (w/nesting) results with parameter (LOC_REFERENCE)...');

 clear_globals;
 clear_values;
 failed := false;

 value_smallarray := func_array_mixed_nested(RESULT_U8BIT);
 if (value_smallarray[1] <> RESULT_U8BIT) or (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) then
   failed := true;
 if global_u8bit <> RESULT_U8BIT then
   failed := true;
 if global_bigstring <> RESULT_BIGSTRING then
   failed := true;
 if global_u16bit <> RESULT_U8BIT then
   failed := true;
 if global_s32bit <> RESULT_S32BIT then
   failed := true;
 if global_s64bit <> RESULT_U8BIT then
   failed := true;

 clear_globals;
 clear_values;
 value_largerec := func_largerecord_mixed_nested(RESULT_U8BIT);
 if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[BIG_INDEX] <> RESULT_U8BIT) then
    failed:=true;
 if global_u8bit <> RESULT_U8BIT then
   failed := true;
 if global_bigstring <> RESULT_BIGSTRING then
   failed := true;
 if global_u16bit <> RESULT_U8BIT then
   failed := true;
 if global_s64bit <> RESULT_U8BIT then
   failed := true;
 if global_s32bit <> RESULT_S32BIT then
   failed := true;

 clear_globals;
 clear_values;
 value_bigstring := func_shortstring_mixed_nested(RESULT_U8BIT);
 if value_bigstring <> RESULT_BIGSTRING then
   failed := true;
 if global_u8bit <> RESULT_U8BIT then
   failed := true;
 if global_bigstring <> RESULT_BIGSTRING then
   failed := true;
 if global_u16bit <> RESULT_U8BIT then
   failed := true;
 if global_s32bit <> RESULT_S32BIT then
   failed := true;
 if global_s64bit <> RESULT_U8BIT then
   failed := true;

 clear_globals;
 clear_values;
 value_largeset := func_largeset_mixed_nested(RESULT_U8BIT);
 if not ('I' in value_largeset) then
   failed := true;
 if global_u8bit <> RESULT_U8BIT then
   failed := true;
 if global_bigstring <> RESULT_BIGSTRING then
   failed := true;
 if global_u16bit <> RESULT_U8BIT then
   failed := true;
 if global_s32bit <> RESULT_S32BIT then
   failed := true;
 if global_s64bit <> RESULT_U8BIT then
   failed := true;

 if failed then
   fail
 else
   WriteLn('Passed!');

 write('Testing orddef/enumdef function (w/nesting) results with parameter (LOC_REGISTER)...');

 clear_globals;
 clear_values;
 failed := false;


 value_u8bit := func_u8bit_mixed_nested(RESULT_U8BIT);
 if value_u8bit <> RESULT_U8BIT then
     failed := true;
 if global_u8bit <> RESULT_U8BIT then
   failed := true;
 if global_bigstring <> RESULT_BIGSTRING then
   failed := true;
 if global_u16bit <> RESULT_U8BIT then
   failed := true;
 if global_s32bit <> RESULT_S32BIT then
   failed := true;
 if global_s64bit <> RESULT_U8BIT then
   failed := true;

 clear_globals;
 clear_values;
 value_u16bit := func_u16bit_mixed_nested(RESULT_U8BIT);
 if value_u16bit <> RESULT_U16BIT then
     failed := true;
 if global_u8bit <> RESULT_U8BIT then
   failed := true;
 if global_bigstring <> RESULT_BIGSTRING then
   failed := true;
 if global_u16bit <> RESULT_U8BIT then
   failed := true;
 if global_s64bit <> RESULT_U8BIT then
   failed := true;
 if global_s32bit <> RESULT_S32BIT then
   failed := true;

 clear_globals;
 clear_values;
 value_s32bit := func_s32bit_mixed_nested(RESULT_U8BIT);
 if value_s32bit <> RESULT_S32BIT then
     failed := true;
 if global_u8bit <> RESULT_U8BIT then
   failed := true;
 if global_bigstring <> RESULT_BIGSTRING then
   failed := true;
 if global_u16bit <> RESULT_U8BIT then
   failed := true;
 if global_s64bit <> RESULT_U8BIT then
   failed := true;
 if global_s32bit <> RESULT_S32BIT then
   failed := true;

 clear_globals;
 clear_values;
 value_s64bit := func_s64bit_mixed_nested(RESULT_U8BIT);
 if value_s64bit <> RESULT_S64BIT then
    failed := true;
 if global_u8bit <> RESULT_U8BIT then
   failed := true;
 if global_bigstring <> RESULT_BIGSTRING then
   failed := true;
 if global_u16bit <> RESULT_U8BIT then
   failed := true;
 if global_s64bit <> RESULT_U8BIT then
   failed := true;
 if global_s32bit <> RESULT_S32BIT then
   failed := true;

 if failed then
   fail
 else
   WriteLn('Passed!');


 write('Testing floatdef function (w/nesting) results with parameter...');

 clear_globals;
 clear_values;
 failed := false;

 value_s32real := func_s32real_mixed_nested(RESULT_U8BIT);
 if trunc(value_s32real) <> trunc(RESULT_S32REAL) then
   failed:=true;
 if global_u8bit <> RESULT_U8BIT then
   failed := true;
 if global_bigstring <> RESULT_BIGSTRING then
   failed := true;
 if global_u16bit <> RESULT_U8BIT then
   failed := true;
 if global_s64bit <> RESULT_U8BIT then
   failed := true;
 if global_s32bit <> RESULT_S32BIT then
   failed := true;

 clear_globals;
 clear_values;
 value_s64real := func_s64real_mixed_nested(RESULT_U8BIT);
 if trunc(value_s64real) <> trunc(RESULT_S64REAL) then
   failed:=true;
 if global_u8bit <> RESULT_U8BIT then
   failed := true;
 if global_bigstring <> RESULT_BIGSTRING then
   failed := true;
 if global_u16bit <> RESULT_U8BIT then
   failed := true;
 if global_s64bit <> RESULT_U8BIT then
   failed := true;
 if global_s32bit <> RESULT_S32BIT then
   failed := true;

 if failed then
   fail
 else
   WriteLn('Passed!');

 write('Testing ansistring function (w/nesting) result with parameter...');

 clear_globals;
 clear_values;
 failed := false;


 value_ansistring := func_ansistring_mixed_nested(RESULT_U8BIT);
 if value_ansistring <> RESULT_BIGSTRING then
   failed:=true;
 if global_u8bit <> RESULT_U8BIT then
   failed := true;
 if global_bigstring <> RESULT_BIGSTRING then
   failed := true;
 if global_u16bit <> RESULT_U8BIT then
   failed := true;
 if global_s64bit <> RESULT_U8BIT then
   failed := true;
 if global_s32bit <> RESULT_S32BIT then
   failed := true;

 if failed then
   fail
 else
   WriteLn('Passed!');

 write('Testing pointer function (w/nesting) result with parameter (LOC_REGISTER)...');

 clear_globals;
 clear_values;
 failed := false;

 value_ptr := func_pchar_mixed_nested(RESULT_U8BIT);
 if value_ptr <> RESULT_PCHAR then
    failed := true;
 if global_u8bit <> RESULT_U8BIT then
    failed := true;
 if global_bigstring <> RESULT_BIGSTRING then
   failed := true;
 if global_u16bit <> RESULT_U8BIT then
   failed := true;
 if global_s64bit <> RESULT_U8BIT then
   failed := true;
 if global_s32bit <> RESULT_S32BIT then
   failed := true;

 if failed then
   fail
 else
   WriteLn('Passed!');
end.

{
  $Log$
  Revision 1.5  2003-04-22 10:24:29  florian
    * fixed defines for powerpc

  Revision 1.4  2002/09/27 17:44:50  carl
    * add testing for window-page size 4K, so as to test stack corruption

  Revision 1.3  2002/09/07 15:40:51  peter
    * old logs removed and tabs fixed

  Revision 1.2  2002/05/13 13:45:37  peter
    * updated to compile tests with kylix

  Revision 1.1  2002/04/13 17:47:57  carl
  + function calling withy saveregisters convention

}