* updated to compile tests with kylix

packages/base/gdbint/gdbint.pp

@@ -2178,7 +2178,7 @@ begin
    begin
      quit_return:=error_return;
 {$ifdef GDB_V5}
-     mask:=$ffffffff;
+     mask:=longint($ffffffff);
      catch_errors(@gdbint_execute_command,@command,0,mask);
 {$else not  GDB_V5}
      execute_command(@command,0);
@@ -2561,7 +2561,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.4  2002-03-26 16:24:49  pierre
+  Revision 1.5  2002-05-13 13:45:35  peter
+    * updated to compile tests with kylix
+
+  Revision 1.4  2002/03/26 16:24:49  pierre
    * set signal names to nil at start
 
   Revision 1.3  2002/02/06 14:42:45  pierre

tests/test/cg/tcalcst1.pp

@@ -24,7 +24,9 @@ program tcalcst1;
 {$endif}
 {$R+}
 
-
+{$ifdef VER70}
+  {$define tp}
+{$endif}
 
  { REAL should map to single or double }
  { so it is not checked, since single  }
@@ -34,11 +36,16 @@ program tcalcst1;
 
  const
 { should be defined depending on CPU target }
-{$ifdef cpu68k}
-  BIG_INDEX = 8000;
-  SMALL_INDEX  = 13;
-{$endif}
-{$ifdef cpu86}
+{$ifdef fpc}
+  {$ifdef cpu68k}
+    BIG_INDEX = 8000;
+    SMALL_INDEX  = 13;
+  {$endif}
+  {$ifdef cpui386}
+    BIG_INDEX = 33000;
+    SMALL_INDEX = 13;     { value should not be aligned! }
+  {$endif}
+{$else}
   BIG_INDEX = 33000;
   SMALL_INDEX = 13;     { value should not be aligned! }
 {$endif}
@@ -58,38 +65,38 @@ program tcalcst1;
   RESULT_BOOLEAN = TRUE;
 
 type
-{$ifdef fpc}
+{$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;
-  
+
   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;
@@ -104,7 +111,7 @@ var
  value_u8bit : byte;
  value_u16bit : word;
  value_s32bit : longint;
-{$ifdef fpc}
+{$ifndef tp}
  global_class : tclass1;
  global_s64bit : int64;
  value_s64bit : int64;
@@ -129,8 +136,8 @@ var
       WriteLn('Failure.');
       halt(1);
     end;
-    
-    
+
+
     procedure clear_globals;
      begin
       global_u8bit := 0;
@@ -143,7 +150,7 @@ var
       global_bigstring := '';
       global_boolean := false;
       global_char := #0;
-{$ifdef fpc}
+{$ifndef tp}
       global_s64bit := 0;
       global_class := nil;
 {$endif}
@@ -159,7 +166,7 @@ var
       value_s64real  := 0.0;
       value_proc := nil;
       value_ptr := nil;
-{$ifdef fpc}
+{$ifndef tp}
       value_s64bit := 0;
       value_class := nil;
 {$endif}
@@ -173,8 +180,8 @@ var
       value_boolean := false;
       value_char:=#0;
      end;
-     
-   
+
+
   procedure testprocedure;
    begin
    end;
@@ -183,22 +190,22 @@ var
     begin
       getu8bit:=RESULT_U8BIT;
     end;
-    
+
    function getu16bit: word;
      begin
        getu16bit:=RESULT_U16BIT;
      end;
-     
+
    function gets32bit: longint;
     begin
       gets32bit:=RESULT_S32BIT;
     end;
-    
+
    function gets64bit: longint;
     begin
       gets64bit:=RESULT_S32BIT;
     end;
- 
+
 
    function gets32real: single;
     begin
@@ -218,7 +225,7 @@ var
      global_s32bit := v;
    end;
 
-{$ifdef fpc}
+{$ifndef tp}
   procedure proc_const_s64bit(const v: int64);
    begin
      global_s64bit:= v;
@@ -230,11 +237,11 @@ var
   begin
     for i:=0 to high(arr) do
      begin
-       case arr[i].vtype of 
+       case arr[i].vtype of
         vtInteger : global_u8bit := arr[i].vinteger and $ff;
         vtBoolean : global_boolean := arr[i].vboolean;
         vtChar : global_char := arr[i].vchar;
-        vtExtended : global_s64real := arr[i].VExtended^; 
+        vtExtended : global_s64real := arr[i].VExtended^;
         vtString :  global_bigstring := arr[i].VString^;
         vtPointer : ;
         vtPChar : global_ptr := arr[i].VPchar;
@@ -247,7 +254,7 @@ var
        end;
      end; {endfor}
   end;
-  
+
 
   procedure proc_const_smallarray_const_2(const arr : array of const);
   var
@@ -259,7 +266,7 @@ var
 
 {$endif}
 
-   
+
   procedure proc_const_smallrecord(const smallrec : tsmallrecord);
    begin
      if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then
@@ -278,8 +285,8 @@ var
      if A_D in smallset then
        global_u8bit := RESULT_U8BIT;
    end;
-   
-   
+
+
   procedure proc_const_largeset(const largeset : tlargeset);
    begin
      if 'I' in largeset then
@@ -292,29 +299,29 @@ var
      if s = RESULT_SMALLSTRING then
        global_u8bit := RESULT_u8BIT;
    end;
-    
+
 
   procedure proc_const_bigstring(const s:shortstring);
    begin
      if s = RESULT_BIGSTRING then
        global_u8bit := RESULT_u8BIT;
    end;
-   
-   
+
+
   procedure proc_const_smallarray(const arr : tsmallarray);
   begin
     if arr[SMALL_INDEX] = RESULT_U8BIT then
       global_u8bit := RESULT_U8BIT;
   end;
-  
+
   procedure proc_const_smallarray_open(const arr : array of byte);
   begin
     { form 0 to N-1 indexes in open arrays }
     if arr[SMALL_INDEX-1] = RESULT_U8BIT then
       global_u8bit := RESULT_U8BIT;
   end;
-  
-  
+
+
 
 
   procedure proc_const_formaldef_array(const buf);
@@ -336,7 +343,7 @@ var
      value_u8bit := b2;
    end;
 
-{$ifdef fpc}
+{$ifndef tp}
   procedure proc_const_s64bit_mixed(b1 : byte; const v: int64; b2: byte);
    begin
      global_s64bit:= v;
@@ -469,7 +476,7 @@ begin
   proc_const_s32bit(gets32bit);
   if global_s32bit <> RESULT_S32BIT then
     failed:=true;
-{$ifdef fpc}
+{$ifndef tp}
   proc_const_s64bit(gets64bit);
   if global_s64bit <> RESULT_S64BIT then
     failed:=true;
@@ -479,7 +486,7 @@ begin
     fail
   else
     WriteLn('Passed!');
-  
+
   write('Const parameter test (src : LOC_REFERENCE (recorddef)))...');
   clear_globals;
   clear_values;
@@ -490,45 +497,45 @@ begin
   proc_const_smallrecord(value_smallrec);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT);
   proc_const_largerecord(value_largerec);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
 
-    
+
   write('const parameter test (src : LOC_REFERENCE (setdef)))...');
   clear_globals;
   clear_values;
   failed := false;
-  
+
   value_smallset := [A_A,A_D];
   proc_const_smallset(value_smallset);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   value_largeset := ['I'];
   proc_const_largeset(value_largeset);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
 
-    
+
 
 
   write('const parameter test (src : LOC_REFERENCE (stringdef)))...');
@@ -540,7 +547,7 @@ begin
   proc_const_smallstring(value_smallstring);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   value_bigstring := RESULT_BIGSTRING;
@@ -554,13 +561,13 @@ begin
     WriteLn('Passed!');
 
 
-    
-    
+
+
   write('Const parameter test (src : LOC_REFERENCE (formaldef)))...');
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
   proc_const_formaldef_array(value_smallarray);
   if global_u8bit <> RESULT_U8BIT then
@@ -572,13 +579,13 @@ begin
     WriteLn('Passed!');
 
 
-    
+
   write('Const parameter test (src : LOC_REFERENCE (arraydef)))...');
-  
+
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
   proc_const_smallarray(value_smallarray);
   if global_u8bit <> RESULT_U8BIT then
@@ -592,7 +599,7 @@ begin
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
 
-{$ifdef fpc}
+{$ifndef tp}
   clear_globals;
   clear_values;
 
@@ -606,10 +613,10 @@ begin
   value_s64real:=RESULT_S64REAL;
   proc_const_smallarray_const_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real,
     value_boolean,value_class]);
-  
+
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if global_char <> RESULT_CHAR then
     failed := true;
   if global_boolean <> RESULT_BOOLEAN then
@@ -619,7 +626,7 @@ begin
   if global_bigstring <> RESULT_SMALLSTRING then
      failed := true;
   if global_ptr <> value_ptr then
-     failed := true; 
+     failed := true;
 {  if value_class <> global_class then
      failed := true;!!!!!!!!!!!!!!!!!!!!}
   if global_s64bit <> RESULT_S64BIT then
@@ -637,7 +644,7 @@ begin
     fail
   else
     WriteLn('Passed!');
-    
+
 
   {***************************** MIXED  TESTS *******************************}
   write('Mixed const parameter test (src : LOC_REGISTER (orddef)))...');
@@ -650,7 +657,7 @@ begin
     failed:=true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-{$ifdef fpc}
+{$ifndef tp}
   proc_const_s64bit_mixed(RESULT_U8BIT,gets64bit,RESULT_U8BIT);
   if global_s64bit <> RESULT_S64BIT then
     failed:=true;
@@ -786,7 +793,7 @@ begin
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
 
-{$ifdef fpc}
+{$ifndef tp}
   clear_globals;
   clear_values;
 
@@ -839,7 +846,10 @@ end.
 
 {
   $Log$
-  Revision 1.1  2002-04-10 16:34:30  carl
+  Revision 1.2  2002-05-13 13:45:36  peter
+    * updated to compile tests with kylix
+
+  Revision 1.1  2002/04/10 16:34:30  carl
   + first tries at first calln testing
 
 }

tests/test/cg/tcalcst2.pp

@@ -18,11 +18,15 @@
 {          (const parameters)                                    }
 {****************************************************************}
 program tcalcst2;
-{$mode objfpc}
-{$INLINE ON}
+{$ifdef fpc}
+  {$mode objfpc}
+  {$INLINE ON}
+{$endif}
 {$R+}
 
-
+{$ifdef VER70}
+  {$define tp}
+{$endif}
 
  { REAL should map to single or double }
  { so it is not checked, since single  }
@@ -32,11 +36,16 @@ program tcalcst2;
 
  const
 { should be defined depending on CPU target }
-{$ifdef cpu68k}
-  BIG_INDEX = 8000;
-  SMALL_INDEX  = 13;
-{$endif}
-{$ifdef cpui386}
+{$ifdef fpc}
+  {$ifdef cpu68k}
+    BIG_INDEX = 8000;
+    SMALL_INDEX  = 13;
+  {$endif}
+  {$ifdef cpui386}
+    BIG_INDEX = 33000;
+    SMALL_INDEX = 13;     { value should not be aligned! }
+  {$endif}
+{$else}
   BIG_INDEX = 33000;
   SMALL_INDEX = 13;     { value should not be aligned! }
 {$endif}
@@ -54,36 +63,36 @@ program tcalcst2;
   RESULT_SMALLSTRING = 'H';
   RESULT_CHAR = 'I';
   RESULT_BOOLEAN = TRUE;
-  
-type 
+
+type
   tclass1 = class
   end;
-  
+
   tprocedure = procedure;
-  
+
   tsmallrecord = packed record
     b: byte;
     w: word;
   end;
-  
+
   tlargerecord = packed record
     b: array[1..BIG_INDEX] of byte;
   end;
-  
+
   tsmallarray = packed array[1..SMALL_INDEX] of byte;
-  
-  tsmallsetenum = 
+
+  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;
@@ -115,14 +124,14 @@ var
  value_smallarray : tsmallarray;
  value_boolean : boolean;
  value_char : char;
- 
+
     procedure fail;
     begin
       WriteLn('Failure.');
       halt(1);
     end;
-    
-    
+
+
     procedure clear_globals;
      begin
       global_u8bit := 0;
@@ -138,8 +147,8 @@ var
       global_boolean := false;
       global_char := #0;
      end;
-     
-     
+
+
     procedure clear_values;
      begin
       value_u8bit := 0;
@@ -161,8 +170,8 @@ var
       value_boolean := false;
       value_char:=#0;
      end;
-     
-   
+
+
   procedure testprocedure;
    begin
    end;
@@ -171,22 +180,22 @@ var
     begin
       getu8bit:=RESULT_U8BIT;
     end;
-    
+
    function getu16bit: word;
      begin
        getu16bit:=RESULT_U16BIT;
      end;
-     
+
    function gets32bit: longint;
     begin
       gets32bit:=RESULT_S32BIT;
     end;
-    
+
    function gets64bit: longint;
     begin
       gets64bit:=RESULT_S32BIT;
     end;
- 
+
 
    function gets32real: single;
     begin
@@ -198,7 +207,7 @@ var
       gets64real:=RESULT_S64REAL;
     end;
 
-   
+
   {************************************************************************}
   {                      CONST PARAMETERS (INLINE)                         }
   {************************************************************************}
@@ -221,43 +230,43 @@ var
      if A_D in smallset then
        global_u8bit := RESULT_U8BIT;
    end;
-   
-   
+
+
   procedure proc_const_largeset_inline(const largeset : tlargeset);inline;
    begin
      if 'I' in largeset then
        global_u8bit := RESULT_U8BIT;
    end;
-   
+
 
   procedure proc_const_smallstring_inline(const s:tsmallstring);inline;
    begin
      if s = RESULT_SMALLSTRING then
        global_u8bit := RESULT_u8BIT;
    end;
-    
+
 
   procedure proc_const_bigstring_inline(const s:shortstring);inline;
    begin
      if s = RESULT_BIGSTRING then
        global_u8bit := RESULT_u8BIT;
    end;
-   
+
 
   procedure proc_const_smallarray_inline(const arr : tsmallarray);inline;
   begin
     if arr[SMALL_INDEX] = RESULT_U8BIT then
       global_u8bit := RESULT_U8BIT;
   end;
-  
+
   procedure proc_const_smallarray_open_inline(const arr : array of byte);inline;
   begin
     { form 0 to N-1 indexes in open arrays }
     if arr[SMALL_INDEX-1] = RESULT_U8BIT then
       global_u8bit := RESULT_U8BIT;
   end;
-  
-  
+
+
   procedure proc_const_smallarray_const_1_inline(const arr : array of const);inline;
   var
    i: integer;
@@ -267,17 +276,17 @@ var
         global_s64bit := arr[2].vInt64^;
         global_char := arr[3].vchar;
         global_bigstring := arr[4].VString^;
-        global_s64real := arr[5].VExtended^; 
-        
+        global_s64real := arr[5].VExtended^;
+
         global_boolean := arr[6].vboolean;
 (*
     for i:=0 to high(arr) do
      begin
-       case arr[i].vtype of 
+       case arr[i].vtype of
         vtInteger : global_u8bit := arr[i].vinteger and $ff;
         vtBoolean : global_boolean := arr[i].vboolean;
         vtChar : global_char := arr[i].vchar;
-        vtExtended : global_s64real := arr[i].VExtended^; 
+        vtExtended : global_s64real := arr[i].VExtended^;
         vtString :  global_bigstring := arr[i].VString^;
         vtPointer : ;
         vtPChar : global_ptr := arr[i].VPchar;
@@ -289,9 +298,9 @@ var
           RunError(255);
        end;
      end; {endfor}
-*)     
+*)
   end;
-  
+
 
   procedure proc_const_smallarray_const_2_inline(const arr : array of const);inline;
   var
@@ -304,11 +313,11 @@ var
 
   procedure proc_const_formaldef_array_inline(const buf);inline;
   var
-   p: ^byte;
+   p: pchar;
   begin
     { array is indexed from 1 }
     p := @buf;
-    global_u8bit := p[SMALL_INDEX-1];
+    global_u8bit := byte(p[SMALL_INDEX-1]);
   end;
 
 var
@@ -326,14 +335,14 @@ begin
   proc_const_smallrecord_inline(value_smallrec);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT);
   proc_const_largerecord_inline(value_largerec);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
@@ -348,14 +357,14 @@ begin
   proc_const_smallset_inline(value_smallset);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   value_largeset := ['I'];
   proc_const_largeset_inline(value_largeset);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
@@ -370,14 +379,14 @@ begin
   proc_const_smallstring_inline(value_smallstring);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   value_bigstring := RESULT_BIGSTRING;
   proc_const_bigstring_inline(value_bigstring);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
@@ -387,7 +396,7 @@ begin
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
   proc_const_formaldef_array_inline(value_smallarray);
   if global_u8bit <> RESULT_U8BIT then
@@ -401,11 +410,11 @@ begin
 
 
   write('Inline const parameter test (src : LOC_REFERENCE (arraydef)))...');
-  
+
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
   proc_const_smallarray_inline(value_smallarray);
   if global_u8bit <> RESULT_U8BIT then
@@ -418,10 +427,10 @@ begin
   proc_const_smallarray_open_inline(value_smallarray);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
-  
+
   value_u8bit := RESULT_U8BIT;
   value_ptr := RESULT_PCHAR;
   value_s64bit := RESULT_S64BIT;
@@ -431,10 +440,10 @@ begin
   value_char := RESULT_CHAR;
   value_s64real:=RESULT_S64REAL;
   proc_const_smallarray_const_1_inline([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real,value_boolean,value_class]);
-  
+
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if global_char <> RESULT_CHAR then
     failed := true;
   if global_boolean <> RESULT_BOOLEAN then
@@ -444,7 +453,7 @@ begin
   if global_bigstring <> RESULT_SMALLSTRING then
      failed := true;
   if global_ptr <> value_ptr then
-     failed := true; 
+     failed := true;
 {  if value_class <> global_class then
      failed := true;!!!!!!!!!!!!!!!!!!!!}
   if global_s64bit <> RESULT_S64BIT then
@@ -462,12 +471,15 @@ begin
     fail
   else
     WriteLn('Passed!');
-    
+
 end.
 
 {
   $Log$
-  Revision 1.1  2002-04-10 16:34:30  carl
+  Revision 1.2  2002-05-13 13:45:36  peter
+    * updated to compile tests with kylix
+
+  Revision 1.1  2002/04/10 16:34:30  carl
   + first tries at first calln testing
 
   Revision 1.1  2002/04/01 18:05:39  carl

tests/test/cg/tcalcst3.pp

@@ -19,11 +19,14 @@
 {****************************************************************}
 program tcalcst3;
 {$ifdef fpc}
-{$mode objfpc}
-{$INLINE ON}
+  {$mode objfpc}
+  {$INLINE ON}
 {$endif}
 {$R+}
 
+{$ifdef VER70}
+  {$define tp}
+{$endif}
 
 
  { REAL should map to single or double }
@@ -34,11 +37,16 @@ program tcalcst3;
 
  const
 { should be defined depending on CPU target }
-{$ifdef cpu68k}
-  BIG_INDEX = 8000;
-  SMALL_INDEX  = 13;
-{$endif}
-{$ifdef cpu86}
+{$ifdef fpc}
+  {$ifdef cpu68k}
+    BIG_INDEX = 8000;
+    SMALL_INDEX  = 13;
+  {$endif}
+  {$ifdef cpui386}
+    BIG_INDEX = 33000;
+    SMALL_INDEX = 13;     { value should not be aligned! }
+  {$endif}
+{$else}
   BIG_INDEX = 33000;
   SMALL_INDEX = 13;     { value should not be aligned! }
 {$endif}
@@ -58,38 +66,38 @@ program tcalcst3;
   RESULT_BOOLEAN = TRUE;
 
 type
-{$ifdef fpc}
+{$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;
-  
+
   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;
@@ -104,7 +112,7 @@ var
  value_u8bit : byte;
  value_u16bit : word;
  value_s32bit : longint;
-{$ifdef fpc}
+{$ifndef tp}
  global_class : tclass1;
  global_s64bit : int64;
  value_s64bit : int64;
@@ -129,8 +137,8 @@ var
       WriteLn('Failure.');
       halt(1);
     end;
-    
-    
+
+
     procedure clear_globals;
      begin
       global_u8bit := 0;
@@ -143,7 +151,7 @@ var
       global_bigstring := '';
       global_boolean := false;
       global_char := #0;
-{$ifdef fpc}
+{$ifndef tp}
       global_s64bit := 0;
       global_class := nil;
 {$endif}
@@ -159,7 +167,7 @@ var
       value_s64real  := 0.0;
       value_proc := nil;
       value_ptr := nil;
-{$ifdef fpc}
+{$ifndef tp}
       value_s64bit := 0;
       value_class := nil;
 {$endif}
@@ -173,8 +181,8 @@ var
       value_boolean := false;
       value_char:=#0;
      end;
-     
-   
+
+
   procedure testprocedure;
    begin
    end;
@@ -183,22 +191,22 @@ var
     begin
       getu8bit:=RESULT_U8BIT;
     end;
-    
+
    function getu16bit: word;
      begin
        getu16bit:=RESULT_U16BIT;
      end;
-     
+
    function gets32bit: longint;
     begin
       gets32bit:=RESULT_S32BIT;
     end;
-    
+
    function gets64bit: longint;
     begin
       gets64bit:=RESULT_S32BIT;
     end;
- 
+
 
    function gets32real: single;
     begin
@@ -218,7 +226,7 @@ var
      global_s32bit := v;
    end;
 
-{$ifdef fpc}
+{$ifndef tp}
   procedure proc_const_s64bit(const v: int64);pascal;
    begin
      global_s64bit:= v;
@@ -230,11 +238,11 @@ var
   begin
     for i:=0 to high(arr) do
      begin
-       case arr[i].vtype of 
+       case arr[i].vtype of
         vtInteger : global_u8bit := arr[i].vinteger and $ff;
         vtBoolean : global_boolean := arr[i].vboolean;
         vtChar : global_char := arr[i].vchar;
-        vtExtended : global_s64real := arr[i].VExtended^; 
+        vtExtended : global_s64real := arr[i].VExtended^;
         vtString :  global_bigstring := arr[i].VString^;
         vtPointer : ;
         vtPChar : global_ptr := arr[i].VPchar;
@@ -247,7 +255,7 @@ var
        end;
      end; {endfor}
   end;
-  
+
 
   procedure proc_const_smallarray_const_2(const arr : array of const);pascal;
   var
@@ -259,7 +267,7 @@ var
 
 {$endif}
 
-   
+
   procedure proc_const_smallrecord(const smallrec : tsmallrecord);pascal;
    begin
      if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then
@@ -278,8 +286,8 @@ var
      if A_D in smallset then
        global_u8bit := RESULT_U8BIT;
    end;
-   
-   
+
+
   procedure proc_const_largeset(const largeset : tlargeset);pascal;
    begin
      if 'I' in largeset then
@@ -292,29 +300,29 @@ var
      if s = RESULT_SMALLSTRING then
        global_u8bit := RESULT_u8BIT;
    end;
-    
+
 
   procedure proc_const_bigstring(const s:shortstring);pascal;
    begin
      if s = RESULT_BIGSTRING then
        global_u8bit := RESULT_u8BIT;
    end;
-   
-   
+
+
   procedure proc_const_smallarray(const arr : tsmallarray);pascal;
   begin
     if arr[SMALL_INDEX] = RESULT_U8BIT then
       global_u8bit := RESULT_U8BIT;
   end;
-  
+
   procedure proc_const_smallarray_open(const arr : array of byte);pascal;
   begin
     { form 0 to N-1 indexes in open arrays }
     if arr[SMALL_INDEX-1] = RESULT_U8BIT then
       global_u8bit := RESULT_U8BIT;
   end;
-  
-  
+
+
 
 
   procedure proc_const_formaldef_array(const buf);pascal;
@@ -336,7 +344,7 @@ var
      value_u8bit := b2;
    end;
 
-{$ifdef fpc}
+{$ifndef tp}
   procedure proc_const_s64bit_mixed(b1 : byte; const v: int64; b2: byte);pascal;
    begin
      global_s64bit:= v;
@@ -427,7 +435,7 @@ var
    end;
 
 
-  procedure proc_const_smallarray_mixed(b1: byte; const arr : tsmallarray; b2: byte);pascal;
+  procedure proc_const_smallarray_mixed(b1: byte; const arr : tsmallarray; b2: byte);
   begin
     if arr[SMALL_INDEX] = RESULT_U8BIT then
       global_u8bit := RESULT_U8BIT;
@@ -469,7 +477,7 @@ begin
   proc_const_s32bit(gets32bit);
   if global_s32bit <> RESULT_S32BIT then
     failed:=true;
-{$ifdef fpc}
+{$ifndef tp}
   proc_const_s64bit(gets64bit);
   if global_s64bit <> RESULT_S64BIT then
     failed:=true;
@@ -479,7 +487,7 @@ begin
     fail
   else
     WriteLn('Passed!');
-  
+
   write('Const parameter test (src : LOC_REFERENCE (recorddef)))...');
   clear_globals;
   clear_values;
@@ -490,45 +498,45 @@ begin
   proc_const_smallrecord(value_smallrec);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT);
   proc_const_largerecord(value_largerec);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
 
-    
+
   write('const parameter test (src : LOC_REFERENCE (setdef)))...');
   clear_globals;
   clear_values;
   failed := false;
-  
+
   value_smallset := [A_A,A_D];
   proc_const_smallset(value_smallset);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   value_largeset := ['I'];
   proc_const_largeset(value_largeset);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
 
-    
+
 
 
   write('const parameter test (src : LOC_REFERENCE (stringdef)))...');
@@ -540,7 +548,7 @@ begin
   proc_const_smallstring(value_smallstring);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   value_bigstring := RESULT_BIGSTRING;
@@ -554,13 +562,13 @@ begin
     WriteLn('Passed!');
 
 
-    
-    
+
+
   write('Const parameter test (src : LOC_REFERENCE (formaldef)))...');
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
   proc_const_formaldef_array(value_smallarray);
   if global_u8bit <> RESULT_U8BIT then
@@ -572,13 +580,13 @@ begin
     WriteLn('Passed!');
 
 
-    
+
   write('Const parameter test (src : LOC_REFERENCE (arraydef)))...');
-  
+
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
   proc_const_smallarray(value_smallarray);
   if global_u8bit <> RESULT_U8BIT then
@@ -592,7 +600,7 @@ begin
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
 
-{$ifdef fpc}
+{$ifndef tp}
   clear_globals;
   clear_values;
 
@@ -606,10 +614,10 @@ begin
   value_s64real:=RESULT_S64REAL;
   proc_const_smallarray_const_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real,
     value_boolean,value_class]);
-  
+
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if global_char <> RESULT_CHAR then
     failed := true;
   if global_boolean <> RESULT_BOOLEAN then
@@ -619,7 +627,7 @@ begin
   if global_bigstring <> RESULT_SMALLSTRING then
      failed := true;
   if global_ptr <> value_ptr then
-     failed := true; 
+     failed := true;
 {  if value_class <> global_class then
      failed := true;!!!!!!!!!!!!!!!!!!!!}
   if global_s64bit <> RESULT_S64BIT then
@@ -637,7 +645,7 @@ begin
     fail
   else
     WriteLn('Passed!');
-    
+
 
   {***************************** MIXED  TESTS *******************************}
   write('Mixed const parameter test (src : LOC_REGISTER (orddef)))...');
@@ -650,7 +658,7 @@ begin
     failed:=true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-{$ifdef fpc}
+{$ifndef tp}
   proc_const_s64bit_mixed(RESULT_U8BIT,gets64bit,RESULT_U8BIT);
   if global_s64bit <> RESULT_S64BIT then
     failed:=true;
@@ -786,7 +794,7 @@ begin
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
 
-{$ifdef fpc}
+{$ifndef tp}
   clear_globals;
   clear_values;
 
@@ -839,7 +847,10 @@ end.
 
 {
   $Log$
-  Revision 1.1  2002-04-13 17:47:06  carl
+  Revision 1.2  2002-05-13 13:45:36  peter
+    * updated to compile tests with kylix
+
+  Revision 1.1  2002/04/13 17:47:06  carl
   + constant parameter passing for different calling conventions
 
 }

tests/test/cg/tcalcst4.pp

@@ -19,11 +19,14 @@
 {****************************************************************}
 program tcalcst4;
 {$ifdef fpc}
-{$mode objfpc}
-{$INLINE ON}
+  {$mode objfpc}
+  {$INLINE ON}
 {$endif}
 {$R+}
 
+{$ifdef VER70}
+  {$define tp}
+{$endif}
 
 
  { REAL should map to single or double }
@@ -34,11 +37,16 @@ program tcalcst4;
 
  const
 { should be defined depending on CPU target }
-{$ifdef cpu68k}
-  BIG_INDEX = 8000;
-  SMALL_INDEX  = 13;
-{$endif}
-{$ifdef cpu86}
+{$ifdef fpc}
+  {$ifdef cpu68k}
+    BIG_INDEX = 8000;
+    SMALL_INDEX  = 13;
+  {$endif}
+  {$ifdef cpui386}
+    BIG_INDEX = 33000;
+    SMALL_INDEX = 13;     { value should not be aligned! }
+  {$endif}
+{$else}
   BIG_INDEX = 33000;
   SMALL_INDEX = 13;     { value should not be aligned! }
 {$endif}
@@ -58,38 +66,38 @@ program tcalcst4;
   RESULT_BOOLEAN = TRUE;
 
 type
-{$ifdef fpc}
+{$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;
-  
+
   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;
@@ -104,7 +112,7 @@ var
  value_u8bit : byte;
  value_u16bit : word;
  value_s32bit : longint;
-{$ifdef fpc}
+{$ifndef tp}
  global_class : tclass1;
  global_s64bit : int64;
  value_s64bit : int64;
@@ -129,8 +137,8 @@ var
       WriteLn('Failure.');
       halt(1);
     end;
-    
-    
+
+
     procedure clear_globals;
      begin
       global_u8bit := 0;
@@ -143,7 +151,7 @@ var
       global_bigstring := '';
       global_boolean := false;
       global_char := #0;
-{$ifdef fpc}
+{$ifndef tp}
       global_s64bit := 0;
       global_class := nil;
 {$endif}
@@ -159,7 +167,7 @@ var
       value_s64real  := 0.0;
       value_proc := nil;
       value_ptr := nil;
-{$ifdef fpc}
+{$ifndef tp}
       value_s64bit := 0;
       value_class := nil;
 {$endif}
@@ -173,8 +181,8 @@ var
       value_boolean := false;
       value_char:=#0;
      end;
-     
-   
+
+
   procedure testprocedure;
    begin
    end;
@@ -183,22 +191,22 @@ var
     begin
       getu8bit:=RESULT_U8BIT;
     end;
-    
+
    function getu16bit: word;
      begin
        getu16bit:=RESULT_U16BIT;
      end;
-     
+
    function gets32bit: longint;
     begin
       gets32bit:=RESULT_S32BIT;
     end;
-    
+
    function gets64bit: longint;
     begin
       gets64bit:=RESULT_S32BIT;
     end;
- 
+
 
    function gets32real: single;
     begin
@@ -218,7 +226,7 @@ var
      global_s32bit := v;
    end;
 
-{$ifdef fpc}
+{$ifndef tp}
   procedure proc_const_s64bit(const v: int64);cdecl;
    begin
      global_s64bit:= v;
@@ -230,11 +238,11 @@ var
   begin
     for i:=0 to high(arr) do
      begin
-       case arr[i].vtype of 
+       case arr[i].vtype of
         vtInteger : global_u8bit := arr[i].vinteger and $ff;
         vtBoolean : global_boolean := arr[i].vboolean;
         vtChar : global_char := arr[i].vchar;
-        vtExtended : global_s64real := arr[i].VExtended^; 
+        vtExtended : global_s64real := arr[i].VExtended^;
         vtString :  global_bigstring := arr[i].VString^;
         vtPointer : ;
         vtPChar : global_ptr := arr[i].VPchar;
@@ -247,7 +255,7 @@ var
        end;
      end; {endfor}
   end;
-  
+
 
   procedure proc_const_smallarray_const_2(const arr : array of const);cdecl;
   var
@@ -259,7 +267,7 @@ var
 
 {$endif}
 
-   
+
   procedure proc_const_smallrecord(const smallrec : tsmallrecord);cdecl;
    begin
      if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then
@@ -278,8 +286,8 @@ var
      if A_D in smallset then
        global_u8bit := RESULT_U8BIT;
    end;
-   
-   
+
+
   procedure proc_const_largeset(const largeset : tlargeset);cdecl;
    begin
      if 'I' in largeset then
@@ -292,29 +300,29 @@ var
      if s = RESULT_SMALLSTRING then
        global_u8bit := RESULT_u8BIT;
    end;
-    
+
 
   procedure proc_const_bigstring(const s:shortstring);cdecl;
    begin
      if s = RESULT_BIGSTRING then
        global_u8bit := RESULT_u8BIT;
    end;
-   
-   
+
+
   procedure proc_const_smallarray(const arr : tsmallarray);cdecl;
   begin
     if arr[SMALL_INDEX] = RESULT_U8BIT then
       global_u8bit := RESULT_U8BIT;
   end;
-  
+
   procedure proc_const_smallarray_open(const arr : array of byte);cdecl;
   begin
     { form 0 to N-1 indexes in open arrays }
     if arr[SMALL_INDEX-1] = RESULT_U8BIT then
       global_u8bit := RESULT_U8BIT;
   end;
-  
-  
+
+
 
 
   procedure proc_const_formaldef_array(const buf);cdecl;
@@ -336,7 +344,7 @@ var
      value_u8bit := b2;
    end;
 
-{$ifdef fpc}
+{$ifndef tp}
   procedure proc_const_s64bit_mixed(b1 : byte; const v: int64; b2: byte);cdecl;
    begin
      global_s64bit:= v;
@@ -469,7 +477,7 @@ begin
   proc_const_s32bit(gets32bit);
   if global_s32bit <> RESULT_S32BIT then
     failed:=true;
-{$ifdef fpc}
+{$ifndef tp}
   proc_const_s64bit(gets64bit);
   if global_s64bit <> RESULT_S64BIT then
     failed:=true;
@@ -479,7 +487,7 @@ begin
     fail
   else
     WriteLn('Passed!');
-  
+
   write('Const parameter test (src : LOC_REFERENCE (recorddef)))...');
   clear_globals;
   clear_values;
@@ -490,45 +498,45 @@ begin
   proc_const_smallrecord(value_smallrec);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT);
   proc_const_largerecord(value_largerec);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
 
-    
+
   write('const parameter test (src : LOC_REFERENCE (setdef)))...');
   clear_globals;
   clear_values;
   failed := false;
-  
+
   value_smallset := [A_A,A_D];
   proc_const_smallset(value_smallset);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   value_largeset := ['I'];
   proc_const_largeset(value_largeset);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
 
-    
+
 
 
   write('const parameter test (src : LOC_REFERENCE (stringdef)))...');
@@ -540,7 +548,7 @@ begin
   proc_const_smallstring(value_smallstring);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   value_bigstring := RESULT_BIGSTRING;
@@ -554,13 +562,13 @@ begin
     WriteLn('Passed!');
 
 
-    
-    
+
+
   write('Const parameter test (src : LOC_REFERENCE (formaldef)))...');
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
   proc_const_formaldef_array(value_smallarray);
   if global_u8bit <> RESULT_U8BIT then
@@ -572,13 +580,13 @@ begin
     WriteLn('Passed!');
 
 
-    
+
   write('Const parameter test (src : LOC_REFERENCE (arraydef)))...');
-  
+
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
   proc_const_smallarray(value_smallarray);
   if global_u8bit <> RESULT_U8BIT then
@@ -592,7 +600,7 @@ begin
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
 
-{$ifdef fpc}
+{$ifndef tp}
   clear_globals;
   clear_values;
 
@@ -606,10 +614,10 @@ begin
   value_s64real:=RESULT_S64REAL;
   proc_const_smallarray_const_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real,
     value_boolean,value_class]);
-  
+
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if global_char <> RESULT_CHAR then
     failed := true;
   if global_boolean <> RESULT_BOOLEAN then
@@ -619,7 +627,7 @@ begin
   if global_bigstring <> RESULT_SMALLSTRING then
      failed := true;
   if global_ptr <> value_ptr then
-     failed := true; 
+     failed := true;
 {  if value_class <> global_class then
      failed := true;!!!!!!!!!!!!!!!!!!!!}
   if global_s64bit <> RESULT_S64BIT then
@@ -637,7 +645,7 @@ begin
     fail
   else
     WriteLn('Passed!');
-    
+
 
   {***************************** MIXED  TESTS *******************************}
   write('Mixed const parameter test (src : LOC_REGISTER (orddef)))...');
@@ -650,7 +658,7 @@ begin
     failed:=true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-{$ifdef fpc}
+{$ifndef tp}
   proc_const_s64bit_mixed(RESULT_U8BIT,gets64bit,RESULT_U8BIT);
   if global_s64bit <> RESULT_S64BIT then
     failed:=true;
@@ -786,7 +794,7 @@ begin
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
 
-{$ifdef fpc}
+{$ifndef tp}
   clear_globals;
   clear_values;
 
@@ -839,7 +847,10 @@ end.
 
 {
   $Log$
-  Revision 1.1  2002-04-13 17:47:06  carl
+  Revision 1.2  2002-05-13 13:45:36  peter
+    * updated to compile tests with kylix
+
+  Revision 1.1  2002/04/13 17:47:06  carl
   + constant parameter passing for different calling conventions
 
 }

tests/test/cg/tcalcst5.pp

@@ -19,11 +19,14 @@
 {****************************************************************}
 program tcalcst5;
 {$ifdef fpc}
-{$mode objfpc}
-{$INLINE ON}
+  {$mode objfpc}
+  {$INLINE ON}
 {$endif}
 {$R+}
 
+{$ifdef VER70}
+  {$define tp}
+{$endif}
 
 
  { REAL should map to single or double }
@@ -34,11 +37,16 @@ program tcalcst5;
 
  const
 { should be defined depending on CPU target }
-{$ifdef cpu68k}
-  BIG_INDEX = 8000;
-  SMALL_INDEX  = 13;
-{$endif}
-{$ifdef cpu86}
+{$ifdef fpc}
+  {$ifdef cpu68k}
+    BIG_INDEX = 8000;
+    SMALL_INDEX  = 13;
+  {$endif}
+  {$ifdef cpui386}
+    BIG_INDEX = 33000;
+    SMALL_INDEX = 13;     { value should not be aligned! }
+  {$endif}
+{$else}
   BIG_INDEX = 33000;
   SMALL_INDEX = 13;     { value should not be aligned! }
 {$endif}
@@ -58,38 +66,38 @@ program tcalcst5;
   RESULT_BOOLEAN = TRUE;
 
 type
-{$ifdef fpc}
+{$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;
-  
+
   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;
@@ -104,7 +112,7 @@ var
  value_u8bit : byte;
  value_u16bit : word;
  value_s32bit : longint;
-{$ifdef fpc}
+{$ifndef tp}
  global_class : tclass1;
  global_s64bit : int64;
  value_s64bit : int64;
@@ -129,8 +137,8 @@ var
       WriteLn('Failure.');
       halt(1);
     end;
-    
-    
+
+
     procedure clear_globals;
      begin
       global_u8bit := 0;
@@ -143,7 +151,7 @@ var
       global_bigstring := '';
       global_boolean := false;
       global_char := #0;
-{$ifdef fpc}
+{$ifndef tp}
       global_s64bit := 0;
       global_class := nil;
 {$endif}
@@ -159,7 +167,7 @@ var
       value_s64real  := 0.0;
       value_proc := nil;
       value_ptr := nil;
-{$ifdef fpc}
+{$ifndef tp}
       value_s64bit := 0;
       value_class := nil;
 {$endif}
@@ -173,8 +181,8 @@ var
       value_boolean := false;
       value_char:=#0;
      end;
-     
-   
+
+
   procedure testprocedure;
    begin
    end;
@@ -183,22 +191,22 @@ var
     begin
       getu8bit:=RESULT_U8BIT;
     end;
-    
+
    function getu16bit: word;
      begin
        getu16bit:=RESULT_U16BIT;
      end;
-     
+
    function gets32bit: longint;
     begin
       gets32bit:=RESULT_S32BIT;
     end;
-    
+
    function gets64bit: longint;
     begin
       gets64bit:=RESULT_S32BIT;
     end;
- 
+
 
    function gets32real: single;
     begin
@@ -218,7 +226,7 @@ var
      global_s32bit := v;
    end;
 
-{$ifdef fpc}
+{$ifndef tp}
   procedure proc_const_s64bit(const v: int64);popstack;
    begin
      global_s64bit:= v;
@@ -230,11 +238,11 @@ var
   begin
     for i:=0 to high(arr) do
      begin
-       case arr[i].vtype of 
+       case arr[i].vtype of
         vtInteger : global_u8bit := arr[i].vinteger and $ff;
         vtBoolean : global_boolean := arr[i].vboolean;
         vtChar : global_char := arr[i].vchar;
-        vtExtended : global_s64real := arr[i].VExtended^; 
+        vtExtended : global_s64real := arr[i].VExtended^;
         vtString :  global_bigstring := arr[i].VString^;
         vtPointer : ;
         vtPChar : global_ptr := arr[i].VPchar;
@@ -247,7 +255,7 @@ var
        end;
      end; {endfor}
   end;
-  
+
 
   procedure proc_const_smallarray_const_2(const arr : array of const);popstack;
   var
@@ -259,7 +267,7 @@ var
 
 {$endif}
 
-   
+
   procedure proc_const_smallrecord(const smallrec : tsmallrecord);popstack;
    begin
      if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then
@@ -278,8 +286,8 @@ var
      if A_D in smallset then
        global_u8bit := RESULT_U8BIT;
    end;
-   
-   
+
+
   procedure proc_const_largeset(const largeset : tlargeset);popstack;
    begin
      if 'I' in largeset then
@@ -292,29 +300,29 @@ var
      if s = RESULT_SMALLSTRING then
        global_u8bit := RESULT_u8BIT;
    end;
-    
+
 
   procedure proc_const_bigstring(const s:shortstring);popstack;
    begin
      if s = RESULT_BIGSTRING then
        global_u8bit := RESULT_u8BIT;
    end;
-   
-   
+
+
   procedure proc_const_smallarray(const arr : tsmallarray);popstack;
   begin
     if arr[SMALL_INDEX] = RESULT_U8BIT then
       global_u8bit := RESULT_U8BIT;
   end;
-  
+
   procedure proc_const_smallarray_open(const arr : array of byte);popstack;
   begin
     { form 0 to N-1 indexes in open arrays }
     if arr[SMALL_INDEX-1] = RESULT_U8BIT then
       global_u8bit := RESULT_U8BIT;
   end;
-  
-  
+
+
 
 
   procedure proc_const_formaldef_array(const buf);popstack;
@@ -336,7 +344,7 @@ var
      value_u8bit := b2;
    end;
 
-{$ifdef fpc}
+{$ifndef tp}
   procedure proc_const_s64bit_mixed(b1 : byte; const v: int64; b2: byte);popstack;
    begin
      global_s64bit:= v;
@@ -469,7 +477,7 @@ begin
   proc_const_s32bit(gets32bit);
   if global_s32bit <> RESULT_S32BIT then
     failed:=true;
-{$ifdef fpc}
+{$ifndef tp}
   proc_const_s64bit(gets64bit);
   if global_s64bit <> RESULT_S64BIT then
     failed:=true;
@@ -479,7 +487,7 @@ begin
     fail
   else
     WriteLn('Passed!');
-  
+
   write('Const parameter test (src : LOC_REFERENCE (recorddef)))...');
   clear_globals;
   clear_values;
@@ -490,45 +498,45 @@ begin
   proc_const_smallrecord(value_smallrec);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT);
   proc_const_largerecord(value_largerec);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
 
-    
+
   write('const parameter test (src : LOC_REFERENCE (setdef)))...');
   clear_globals;
   clear_values;
   failed := false;
-  
+
   value_smallset := [A_A,A_D];
   proc_const_smallset(value_smallset);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   value_largeset := ['I'];
   proc_const_largeset(value_largeset);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
 
-    
+
 
 
   write('const parameter test (src : LOC_REFERENCE (stringdef)))...');
@@ -540,7 +548,7 @@ begin
   proc_const_smallstring(value_smallstring);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   value_bigstring := RESULT_BIGSTRING;
@@ -554,13 +562,13 @@ begin
     WriteLn('Passed!');
 
 
-    
-    
+
+
   write('Const parameter test (src : LOC_REFERENCE (formaldef)))...');
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
   proc_const_formaldef_array(value_smallarray);
   if global_u8bit <> RESULT_U8BIT then
@@ -572,13 +580,13 @@ begin
     WriteLn('Passed!');
 
 
-    
+
   write('Const parameter test (src : LOC_REFERENCE (arraydef)))...');
-  
+
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
   proc_const_smallarray(value_smallarray);
   if global_u8bit <> RESULT_U8BIT then
@@ -592,7 +600,7 @@ begin
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
 
-{$ifdef fpc}
+{$ifndef tp}
   clear_globals;
   clear_values;
 
@@ -606,10 +614,10 @@ begin
   value_s64real:=RESULT_S64REAL;
   proc_const_smallarray_const_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real,
     value_boolean,value_class]);
-  
+
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if global_char <> RESULT_CHAR then
     failed := true;
   if global_boolean <> RESULT_BOOLEAN then
@@ -619,7 +627,7 @@ begin
   if global_bigstring <> RESULT_SMALLSTRING then
      failed := true;
   if global_ptr <> value_ptr then
-     failed := true; 
+     failed := true;
 {  if value_class <> global_class then
      failed := true;!!!!!!!!!!!!!!!!!!!!}
   if global_s64bit <> RESULT_S64BIT then
@@ -637,7 +645,7 @@ begin
     fail
   else
     WriteLn('Passed!');
-    
+
 
   {***************************** MIXED  TESTS *******************************}
   write('Mixed const parameter test (src : LOC_REGISTER (orddef)))...');
@@ -650,7 +658,7 @@ begin
     failed:=true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-{$ifdef fpc}
+{$ifndef tp}
   proc_const_s64bit_mixed(RESULT_U8BIT,gets64bit,RESULT_U8BIT);
   if global_s64bit <> RESULT_S64BIT then
     failed:=true;
@@ -786,7 +794,7 @@ begin
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
 
-{$ifdef fpc}
+{$ifndef tp}
   clear_globals;
   clear_values;
 
@@ -839,7 +847,10 @@ end.
 
 {
   $Log$
-  Revision 1.1  2002-04-13 17:47:06  carl
+  Revision 1.2  2002-05-13 13:45:36  peter
+    * updated to compile tests with kylix
+
+  Revision 1.1  2002/04/13 17:47:06  carl
   + constant parameter passing for different calling conventions
 
 }

tests/test/cg/tcalcst6.pp

@@ -19,11 +19,14 @@
 {****************************************************************}
 program tcalcst6;
 {$ifdef fpc}
-{$mode objfpc}
-{$INLINE ON}
+  {$mode objfpc}
+  {$INLINE ON}
 {$endif}
 {$R+}
 
+{$ifdef VER70}
+  {$define tp}
+{$endif}
 
 
  { REAL should map to single or double }
@@ -34,11 +37,16 @@ program tcalcst6;
 
  const
 { should be defined depending on CPU target }
-{$ifdef cpu68k}
-  BIG_INDEX = 8000;
-  SMALL_INDEX  = 13;
-{$endif}
-{$ifdef cpu86}
+{$ifdef fpc}
+  {$ifdef cpu68k}
+    BIG_INDEX = 8000;
+    SMALL_INDEX  = 13;
+  {$endif}
+  {$ifdef cpui386}
+    BIG_INDEX = 33000;
+    SMALL_INDEX = 13;     { value should not be aligned! }
+  {$endif}
+{$else}
   BIG_INDEX = 33000;
   SMALL_INDEX = 13;     { value should not be aligned! }
 {$endif}
@@ -58,38 +66,38 @@ program tcalcst6;
   RESULT_BOOLEAN = TRUE;
 
 type
-{$ifdef fpc}
+{$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;
-  
+
   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;
@@ -104,7 +112,7 @@ var
  value_u8bit : byte;
  value_u16bit : word;
  value_s32bit : longint;
-{$ifdef fpc}
+{$ifndef tp}
  global_class : tclass1;
  global_s64bit : int64;
  value_s64bit : int64;
@@ -129,8 +137,8 @@ var
       WriteLn('Failure.');
       halt(1);
     end;
-    
-    
+
+
     procedure clear_globals;
      begin
       global_u8bit := 0;
@@ -143,7 +151,7 @@ var
       global_bigstring := '';
       global_boolean := false;
       global_char := #0;
-{$ifdef fpc}
+{$ifndef tp}
       global_s64bit := 0;
       global_class := nil;
 {$endif}
@@ -159,7 +167,7 @@ var
       value_s64real  := 0.0;
       value_proc := nil;
       value_ptr := nil;
-{$ifdef fpc}
+{$ifndef tp}
       value_s64bit := 0;
       value_class := nil;
 {$endif}
@@ -173,8 +181,8 @@ var
       value_boolean := false;
       value_char:=#0;
      end;
-     
-   
+
+
   procedure testprocedure;
    begin
    end;
@@ -183,22 +191,22 @@ var
     begin
       getu8bit:=RESULT_U8BIT;
     end;
-    
+
    function getu16bit: word;
      begin
        getu16bit:=RESULT_U16BIT;
      end;
-     
+
    function gets32bit: longint;
     begin
       gets32bit:=RESULT_S32BIT;
     end;
-    
+
    function gets64bit: longint;
     begin
       gets64bit:=RESULT_S32BIT;
     end;
- 
+
 
    function gets32real: single;
     begin
@@ -218,7 +226,7 @@ var
      global_s32bit := v;
    end;
 
-{$ifdef fpc}
+{$ifndef tp}
   procedure proc_const_s64bit(const v: int64);safecall;
    begin
      global_s64bit:= v;
@@ -230,11 +238,11 @@ var
   begin
     for i:=0 to high(arr) do
      begin
-       case arr[i].vtype of 
+       case arr[i].vtype of
         vtInteger : global_u8bit := arr[i].vinteger and $ff;
         vtBoolean : global_boolean := arr[i].vboolean;
         vtChar : global_char := arr[i].vchar;
-        vtExtended : global_s64real := arr[i].VExtended^; 
+        vtExtended : global_s64real := arr[i].VExtended^;
         vtString :  global_bigstring := arr[i].VString^;
         vtPointer : ;
         vtPChar : global_ptr := arr[i].VPchar;
@@ -247,7 +255,7 @@ var
        end;
      end; {endfor}
   end;
-  
+
 
   procedure proc_const_smallarray_const_2(const arr : array of const);safecall;
   var
@@ -259,7 +267,7 @@ var
 
 {$endif}
 
-   
+
   procedure proc_const_smallrecord(const smallrec : tsmallrecord);safecall;
    begin
      if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then
@@ -278,8 +286,8 @@ var
      if A_D in smallset then
        global_u8bit := RESULT_U8BIT;
    end;
-   
-   
+
+
   procedure proc_const_largeset(const largeset : tlargeset);safecall;
    begin
      if 'I' in largeset then
@@ -292,29 +300,29 @@ var
      if s = RESULT_SMALLSTRING then
        global_u8bit := RESULT_u8BIT;
    end;
-    
+
 
   procedure proc_const_bigstring(const s:shortstring);safecall;
    begin
      if s = RESULT_BIGSTRING then
        global_u8bit := RESULT_u8BIT;
    end;
-   
-   
+
+
   procedure proc_const_smallarray(const arr : tsmallarray);safecall;
   begin
     if arr[SMALL_INDEX] = RESULT_U8BIT then
       global_u8bit := RESULT_U8BIT;
   end;
-  
+
   procedure proc_const_smallarray_open(const arr : array of byte);safecall;
   begin
     { form 0 to N-1 indexes in open arrays }
     if arr[SMALL_INDEX-1] = RESULT_U8BIT then
       global_u8bit := RESULT_U8BIT;
   end;
-  
-  
+
+
 
 
   procedure proc_const_formaldef_array(const buf);safecall;
@@ -336,7 +344,7 @@ var
      value_u8bit := b2;
    end;
 
-{$ifdef fpc}
+{$ifndef tp}
   procedure proc_const_s64bit_mixed(b1 : byte; const v: int64; b2: byte);safecall;
    begin
      global_s64bit:= v;
@@ -469,7 +477,7 @@ begin
   proc_const_s32bit(gets32bit);
   if global_s32bit <> RESULT_S32BIT then
     failed:=true;
-{$ifdef fpc}
+{$ifndef tp}
   proc_const_s64bit(gets64bit);
   if global_s64bit <> RESULT_S64BIT then
     failed:=true;
@@ -479,7 +487,7 @@ begin
     fail
   else
     WriteLn('Passed!');
-  
+
   write('Const parameter test (src : LOC_REFERENCE (recorddef)))...');
   clear_globals;
   clear_values;
@@ -490,45 +498,45 @@ begin
   proc_const_smallrecord(value_smallrec);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT);
   proc_const_largerecord(value_largerec);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
 
-    
+
   write('const parameter test (src : LOC_REFERENCE (setdef)))...');
   clear_globals;
   clear_values;
   failed := false;
-  
+
   value_smallset := [A_A,A_D];
   proc_const_smallset(value_smallset);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   value_largeset := ['I'];
   proc_const_largeset(value_largeset);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
 
-    
+
 
 
   write('const parameter test (src : LOC_REFERENCE (stringdef)))...');
@@ -540,7 +548,7 @@ begin
   proc_const_smallstring(value_smallstring);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   value_bigstring := RESULT_BIGSTRING;
@@ -554,13 +562,13 @@ begin
     WriteLn('Passed!');
 
 
-    
-    
+
+
   write('Const parameter test (src : LOC_REFERENCE (formaldef)))...');
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
   proc_const_formaldef_array(value_smallarray);
   if global_u8bit <> RESULT_U8BIT then
@@ -572,13 +580,13 @@ begin
     WriteLn('Passed!');
 
 
-    
+
   write('Const parameter test (src : LOC_REFERENCE (arraydef)))...');
-  
+
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
   proc_const_smallarray(value_smallarray);
   if global_u8bit <> RESULT_U8BIT then
@@ -592,7 +600,7 @@ begin
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
 
-{$ifdef fpc}
+{$ifndef tp}
   clear_globals;
   clear_values;
 
@@ -606,10 +614,10 @@ begin
   value_s64real:=RESULT_S64REAL;
   proc_const_smallarray_const_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real,
     value_boolean,value_class]);
-  
+
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if global_char <> RESULT_CHAR then
     failed := true;
   if global_boolean <> RESULT_BOOLEAN then
@@ -619,7 +627,7 @@ begin
   if global_bigstring <> RESULT_SMALLSTRING then
      failed := true;
   if global_ptr <> value_ptr then
-     failed := true; 
+     failed := true;
 {  if value_class <> global_class then
      failed := true;!!!!!!!!!!!!!!!!!!!!}
   if global_s64bit <> RESULT_S64BIT then
@@ -637,7 +645,7 @@ begin
     fail
   else
     WriteLn('Passed!');
-    
+
 
   {***************************** MIXED  TESTS *******************************}
   write('Mixed const parameter test (src : LOC_REGISTER (orddef)))...');
@@ -650,7 +658,7 @@ begin
     failed:=true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-{$ifdef fpc}
+{$ifndef tp}
   proc_const_s64bit_mixed(RESULT_U8BIT,gets64bit,RESULT_U8BIT);
   if global_s64bit <> RESULT_S64BIT then
     failed:=true;
@@ -786,7 +794,7 @@ begin
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
 
-{$ifdef fpc}
+{$ifndef tp}
   clear_globals;
   clear_values;
 
@@ -839,7 +847,10 @@ end.
 
 {
   $Log$
-  Revision 1.1  2002-04-13 17:47:06  carl
+  Revision 1.2  2002-05-13 13:45:36  peter
+    * updated to compile tests with kylix
+
+  Revision 1.1  2002/04/13 17:47:06  carl
   + constant parameter passing for different calling conventions
 
 }

tests/test/cg/tcalcst7.pp

@@ -19,11 +19,14 @@
 {****************************************************************}
 program tcalcst7;
 {$ifdef fpc}
-{$mode objfpc}
-{$INLINE ON}
+  {$mode objfpc}
+  {$INLINE ON}
 {$endif}
 {$R+}
 
+{$ifdef VER70}
+  {$define tp}
+{$endif}
 
 
  { REAL should map to single or double }
@@ -34,11 +37,16 @@ program tcalcst7;
 
  const
 { should be defined depending on CPU target }
-{$ifdef cpu68k}
-  BIG_INDEX = 8000;
-  SMALL_INDEX  = 13;
-{$endif}
-{$ifdef cpu86}
+{$ifdef fpc}
+  {$ifdef cpu68k}
+    BIG_INDEX = 8000;
+    SMALL_INDEX  = 13;
+  {$endif}
+  {$ifdef cpui386}
+    BIG_INDEX = 33000;
+    SMALL_INDEX = 13;     { value should not be aligned! }
+  {$endif}
+{$else}
   BIG_INDEX = 33000;
   SMALL_INDEX = 13;     { value should not be aligned! }
 {$endif}
@@ -58,38 +66,38 @@ program tcalcst7;
   RESULT_BOOLEAN = TRUE;
 
 type
-{$ifdef fpc}
+{$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;
-  
+
   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;
@@ -104,7 +112,7 @@ var
  value_u8bit : byte;
  value_u16bit : word;
  value_s32bit : longint;
-{$ifdef fpc}
+{$ifndef tp}
  global_class : tclass1;
  global_s64bit : int64;
  value_s64bit : int64;
@@ -129,8 +137,8 @@ var
       WriteLn('Failure.');
       halt(1);
     end;
-    
-    
+
+
     procedure clear_globals;
      begin
       global_u8bit := 0;
@@ -143,7 +151,7 @@ var
       global_bigstring := '';
       global_boolean := false;
       global_char := #0;
-{$ifdef fpc}
+{$ifndef tp}
       global_s64bit := 0;
       global_class := nil;
 {$endif}
@@ -159,7 +167,7 @@ var
       value_s64real  := 0.0;
       value_proc := nil;
       value_ptr := nil;
-{$ifdef fpc}
+{$ifndef tp}
       value_s64bit := 0;
       value_class := nil;
 {$endif}
@@ -173,8 +181,8 @@ var
       value_boolean := false;
       value_char:=#0;
      end;
-     
-   
+
+
   procedure testprocedure;
    begin
    end;
@@ -183,22 +191,22 @@ var
     begin
       getu8bit:=RESULT_U8BIT;
     end;
-    
+
    function getu16bit: word;
      begin
        getu16bit:=RESULT_U16BIT;
      end;
-     
+
    function gets32bit: longint;
     begin
       gets32bit:=RESULT_S32BIT;
     end;
-    
+
    function gets64bit: longint;
     begin
       gets64bit:=RESULT_S32BIT;
     end;
- 
+
 
    function gets32real: single;
     begin
@@ -218,7 +226,7 @@ var
      global_s32bit := v;
    end;
 
-{$ifdef fpc}
+{$ifndef tp}
   procedure proc_const_s64bit(const v: int64);register;
    begin
      global_s64bit:= v;
@@ -230,11 +238,11 @@ var
   begin
     for i:=0 to high(arr) do
      begin
-       case arr[i].vtype of 
+       case arr[i].vtype of
         vtInteger : global_u8bit := arr[i].vinteger and $ff;
         vtBoolean : global_boolean := arr[i].vboolean;
         vtChar : global_char := arr[i].vchar;
-        vtExtended : global_s64real := arr[i].VExtended^; 
+        vtExtended : global_s64real := arr[i].VExtended^;
         vtString :  global_bigstring := arr[i].VString^;
         vtPointer : ;
         vtPChar : global_ptr := arr[i].VPchar;
@@ -247,7 +255,7 @@ var
        end;
      end; {endfor}
   end;
-  
+
 
   procedure proc_const_smallarray_const_2(const arr : array of const);register;
   var
@@ -259,7 +267,7 @@ var
 
 {$endif}
 
-   
+
   procedure proc_const_smallrecord(const smallrec : tsmallrecord);register;
    begin
      if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then
@@ -278,8 +286,8 @@ var
      if A_D in smallset then
        global_u8bit := RESULT_U8BIT;
    end;
-   
-   
+
+
   procedure proc_const_largeset(const largeset : tlargeset);register;
    begin
      if 'I' in largeset then
@@ -292,29 +300,29 @@ var
      if s = RESULT_SMALLSTRING then
        global_u8bit := RESULT_u8BIT;
    end;
-    
+
 
   procedure proc_const_bigstring(const s:shortstring);register;
    begin
      if s = RESULT_BIGSTRING then
        global_u8bit := RESULT_u8BIT;
    end;
-   
-   
+
+
   procedure proc_const_smallarray(const arr : tsmallarray);register;
   begin
     if arr[SMALL_INDEX] = RESULT_U8BIT then
       global_u8bit := RESULT_U8BIT;
   end;
-  
+
   procedure proc_const_smallarray_open(const arr : array of byte);register;
   begin
     { form 0 to N-1 indexes in open arrays }
     if arr[SMALL_INDEX-1] = RESULT_U8BIT then
       global_u8bit := RESULT_U8BIT;
   end;
-  
-  
+
+
 
 
   procedure proc_const_formaldef_array(const buf);register;
@@ -336,7 +344,7 @@ var
      value_u8bit := b2;
    end;
 
-{$ifdef fpc}
+{$ifndef tp}
   procedure proc_const_s64bit_mixed(b1 : byte; const v: int64; b2: byte);register;
    begin
      global_s64bit:= v;
@@ -469,7 +477,7 @@ begin
   proc_const_s32bit(gets32bit);
   if global_s32bit <> RESULT_S32BIT then
     failed:=true;
-{$ifdef fpc}
+{$ifndef tp}
   proc_const_s64bit(gets64bit);
   if global_s64bit <> RESULT_S64BIT then
     failed:=true;
@@ -479,7 +487,7 @@ begin
     fail
   else
     WriteLn('Passed!');
-  
+
   write('Const parameter test (src : LOC_REFERENCE (recorddef)))...');
   clear_globals;
   clear_values;
@@ -490,45 +498,45 @@ begin
   proc_const_smallrecord(value_smallrec);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT);
   proc_const_largerecord(value_largerec);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
 
-    
+
   write('const parameter test (src : LOC_REFERENCE (setdef)))...');
   clear_globals;
   clear_values;
   failed := false;
-  
+
   value_smallset := [A_A,A_D];
   proc_const_smallset(value_smallset);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   value_largeset := ['I'];
   proc_const_largeset(value_largeset);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
 
-    
+
 
 
   write('const parameter test (src : LOC_REFERENCE (stringdef)))...');
@@ -540,7 +548,7 @@ begin
   proc_const_smallstring(value_smallstring);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   value_bigstring := RESULT_BIGSTRING;
@@ -554,13 +562,13 @@ begin
     WriteLn('Passed!');
 
 
-    
-    
+
+
   write('Const parameter test (src : LOC_REFERENCE (formaldef)))...');
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
   proc_const_formaldef_array(value_smallarray);
   if global_u8bit <> RESULT_U8BIT then
@@ -572,13 +580,13 @@ begin
     WriteLn('Passed!');
 
 
-    
+
   write('Const parameter test (src : LOC_REFERENCE (arraydef)))...');
-  
+
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
   proc_const_smallarray(value_smallarray);
   if global_u8bit <> RESULT_U8BIT then
@@ -592,7 +600,7 @@ begin
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
 
-{$ifdef fpc}
+{$ifndef tp}
   clear_globals;
   clear_values;
 
@@ -606,10 +614,10 @@ begin
   value_s64real:=RESULT_S64REAL;
   proc_const_smallarray_const_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real,
     value_boolean,value_class]);
-  
+
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if global_char <> RESULT_CHAR then
     failed := true;
   if global_boolean <> RESULT_BOOLEAN then
@@ -619,7 +627,7 @@ begin
   if global_bigstring <> RESULT_SMALLSTRING then
      failed := true;
   if global_ptr <> value_ptr then
-     failed := true; 
+     failed := true;
 {  if value_class <> global_class then
      failed := true;!!!!!!!!!!!!!!!!!!!!}
   if global_s64bit <> RESULT_S64BIT then
@@ -637,7 +645,7 @@ begin
     fail
   else
     WriteLn('Passed!');
-    
+
 
   {***************************** MIXED  TESTS *******************************}
   write('Mixed const parameter test (src : LOC_REGISTER (orddef)))...');
@@ -650,7 +658,7 @@ begin
     failed:=true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-{$ifdef fpc}
+{$ifndef tp}
   proc_const_s64bit_mixed(RESULT_U8BIT,gets64bit,RESULT_U8BIT);
   if global_s64bit <> RESULT_S64BIT then
     failed:=true;
@@ -786,7 +794,7 @@ begin
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
 
-{$ifdef fpc}
+{$ifndef tp}
   clear_globals;
   clear_values;
 
@@ -839,7 +847,10 @@ end.
 
 {
   $Log$
-  Revision 1.1  2002-04-13 17:47:06  carl
+  Revision 1.2  2002-05-13 13:45:36  peter
+    * updated to compile tests with kylix
+
+  Revision 1.1  2002/04/13 17:47:06  carl
   + constant parameter passing for different calling conventions
 
 }

tests/test/cg/tcalcst8.pp

@@ -19,11 +19,14 @@
 {****************************************************************}
 program tcalcst8;
 {$ifdef fpc}
-{$mode objfpc}
-{$INLINE ON}
+  {$mode objfpc}
+  {$INLINE ON}
 {$endif}
 {$R+}
 
+{$ifdef VER70}
+  {$define tp}
+{$endif}
 
 
  { REAL should map to single or double }
@@ -34,11 +37,16 @@ program tcalcst8;
 
  const
 { should be defined depending on CPU target }
-{$ifdef cpu68k}
-  BIG_INDEX = 8000;
-  SMALL_INDEX  = 13;
-{$endif}
-{$ifdef cpu86}
+{$ifdef fpc}
+  {$ifdef cpu68k}
+    BIG_INDEX = 8000;
+    SMALL_INDEX  = 13;
+  {$endif}
+  {$ifdef cpui386}
+    BIG_INDEX = 33000;
+    SMALL_INDEX = 13;     { value should not be aligned! }
+  {$endif}
+{$else}
   BIG_INDEX = 33000;
   SMALL_INDEX = 13;     { value should not be aligned! }
 {$endif}
@@ -58,38 +66,38 @@ program tcalcst8;
   RESULT_BOOLEAN = TRUE;
 
 type
-{$ifdef fpc}
+{$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;
-  
+
   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;
@@ -104,7 +112,7 @@ var
  value_u8bit : byte;
  value_u16bit : word;
  value_s32bit : longint;
-{$ifdef fpc}
+{$ifndef tp}
  global_class : tclass1;
  global_s64bit : int64;
  value_s64bit : int64;
@@ -129,8 +137,8 @@ var
       WriteLn('Failure.');
       halt(1);
     end;
-    
-    
+
+
     procedure clear_globals;
      begin
       global_u8bit := 0;
@@ -143,7 +151,7 @@ var
       global_bigstring := '';
       global_boolean := false;
       global_char := #0;
-{$ifdef fpc}
+{$ifndef tp}
       global_s64bit := 0;
       global_class := nil;
 {$endif}
@@ -159,7 +167,7 @@ var
       value_s64real  := 0.0;
       value_proc := nil;
       value_ptr := nil;
-{$ifdef fpc}
+{$ifndef tp}
       value_s64bit := 0;
       value_class := nil;
 {$endif}
@@ -173,8 +181,8 @@ var
       value_boolean := false;
       value_char:=#0;
      end;
-     
-   
+
+
   procedure testprocedure;
    begin
    end;
@@ -183,22 +191,22 @@ var
     begin
       getu8bit:=RESULT_U8BIT;
     end;
-    
+
    function getu16bit: word;
      begin
        getu16bit:=RESULT_U16BIT;
      end;
-     
+
    function gets32bit: longint;
     begin
       gets32bit:=RESULT_S32BIT;
     end;
-    
+
    function gets64bit: longint;
     begin
       gets64bit:=RESULT_S32BIT;
     end;
- 
+
 
    function gets32real: single;
     begin
@@ -218,7 +226,7 @@ var
      global_s32bit := v;
    end;
 
-{$ifdef fpc}
+{$ifndef tp}
   procedure proc_const_s64bit(const v: int64);stdcall;
    begin
      global_s64bit:= v;
@@ -230,11 +238,11 @@ var
   begin
     for i:=0 to high(arr) do
      begin
-       case arr[i].vtype of 
+       case arr[i].vtype of
         vtInteger : global_u8bit := arr[i].vinteger and $ff;
         vtBoolean : global_boolean := arr[i].vboolean;
         vtChar : global_char := arr[i].vchar;
-        vtExtended : global_s64real := arr[i].VExtended^; 
+        vtExtended : global_s64real := arr[i].VExtended^;
         vtString :  global_bigstring := arr[i].VString^;
         vtPointer : ;
         vtPChar : global_ptr := arr[i].VPchar;
@@ -247,7 +255,7 @@ var
        end;
      end; {endfor}
   end;
-  
+
 
   procedure proc_const_smallarray_const_2(const arr : array of const);stdcall;
   var
@@ -259,7 +267,7 @@ var
 
 {$endif}
 
-   
+
   procedure proc_const_smallrecord(const smallrec : tsmallrecord);stdcall;
    begin
      if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then
@@ -278,8 +286,8 @@ var
      if A_D in smallset then
        global_u8bit := RESULT_U8BIT;
    end;
-   
-   
+
+
   procedure proc_const_largeset(const largeset : tlargeset);stdcall;
    begin
      if 'I' in largeset then
@@ -292,29 +300,29 @@ var
      if s = RESULT_SMALLSTRING then
        global_u8bit := RESULT_u8BIT;
    end;
-    
+
 
   procedure proc_const_bigstring(const s:shortstring);stdcall;
    begin
      if s = RESULT_BIGSTRING then
        global_u8bit := RESULT_u8BIT;
    end;
-   
-   
+
+
   procedure proc_const_smallarray(const arr : tsmallarray);stdcall;
   begin
     if arr[SMALL_INDEX] = RESULT_U8BIT then
       global_u8bit := RESULT_U8BIT;
   end;
-  
+
   procedure proc_const_smallarray_open(const arr : array of byte);stdcall;
   begin
     { form 0 to N-1 indexes in open arrays }
     if arr[SMALL_INDEX-1] = RESULT_U8BIT then
       global_u8bit := RESULT_U8BIT;
   end;
-  
-  
+
+
 
 
   procedure proc_const_formaldef_array(const buf);stdcall;
@@ -336,7 +344,7 @@ var
      value_u8bit := b2;
    end;
 
-{$ifdef fpc}
+{$ifndef tp}
   procedure proc_const_s64bit_mixed(b1 : byte; const v: int64; b2: byte);stdcall;
    begin
      global_s64bit:= v;
@@ -469,7 +477,7 @@ begin
   proc_const_s32bit(gets32bit);
   if global_s32bit <> RESULT_S32BIT then
     failed:=true;
-{$ifdef fpc}
+{$ifndef tp}
   proc_const_s64bit(gets64bit);
   if global_s64bit <> RESULT_S64BIT then
     failed:=true;
@@ -479,7 +487,7 @@ begin
     fail
   else
     WriteLn('Passed!');
-  
+
   write('Const parameter test (src : LOC_REFERENCE (recorddef)))...');
   clear_globals;
   clear_values;
@@ -490,45 +498,45 @@ begin
   proc_const_smallrecord(value_smallrec);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT);
   proc_const_largerecord(value_largerec);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
 
-    
+
   write('const parameter test (src : LOC_REFERENCE (setdef)))...');
   clear_globals;
   clear_values;
   failed := false;
-  
+
   value_smallset := [A_A,A_D];
   proc_const_smallset(value_smallset);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   value_largeset := ['I'];
   proc_const_largeset(value_largeset);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
 
-    
+
 
 
   write('const parameter test (src : LOC_REFERENCE (stringdef)))...');
@@ -540,7 +548,7 @@ begin
   proc_const_smallstring(value_smallstring);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   value_bigstring := RESULT_BIGSTRING;
@@ -554,13 +562,13 @@ begin
     WriteLn('Passed!');
 
 
-    
-    
+
+
   write('Const parameter test (src : LOC_REFERENCE (formaldef)))...');
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
   proc_const_formaldef_array(value_smallarray);
   if global_u8bit <> RESULT_U8BIT then
@@ -572,13 +580,13 @@ begin
     WriteLn('Passed!');
 
 
-    
+
   write('Const parameter test (src : LOC_REFERENCE (arraydef)))...');
-  
+
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
   proc_const_smallarray(value_smallarray);
   if global_u8bit <> RESULT_U8BIT then
@@ -592,7 +600,7 @@ begin
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
 
-{$ifdef fpc}
+{$ifndef tp}
   clear_globals;
   clear_values;
 
@@ -606,10 +614,10 @@ begin
   value_s64real:=RESULT_S64REAL;
   proc_const_smallarray_const_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real,
     value_boolean,value_class]);
-  
+
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if global_char <> RESULT_CHAR then
     failed := true;
   if global_boolean <> RESULT_BOOLEAN then
@@ -619,7 +627,7 @@ begin
   if global_bigstring <> RESULT_SMALLSTRING then
      failed := true;
   if global_ptr <> value_ptr then
-     failed := true; 
+     failed := true;
 {  if value_class <> global_class then
      failed := true;!!!!!!!!!!!!!!!!!!!!}
   if global_s64bit <> RESULT_S64BIT then
@@ -637,7 +645,7 @@ begin
     fail
   else
     WriteLn('Passed!');
-    
+
 
   {***************************** MIXED  TESTS *******************************}
   write('Mixed const parameter test (src : LOC_REGISTER (orddef)))...');
@@ -650,7 +658,7 @@ begin
     failed:=true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-{$ifdef fpc}
+{$ifndef tp}
   proc_const_s64bit_mixed(RESULT_U8BIT,gets64bit,RESULT_U8BIT);
   if global_s64bit <> RESULT_S64BIT then
     failed:=true;
@@ -786,7 +794,7 @@ begin
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
 
-{$ifdef fpc}
+{$ifndef tp}
   clear_globals;
   clear_values;
 
@@ -839,7 +847,10 @@ end.
 
 {
   $Log$
-  Revision 1.1  2002-04-13 17:47:06  carl
+  Revision 1.2  2002-05-13 13:45:36  peter
+    * updated to compile tests with kylix
+
+  Revision 1.1  2002/04/13 17:47:06  carl
   + constant parameter passing for different calling conventions
 
 }

tests/test/cg/tcalcst9.pp

@@ -16,15 +16,18 @@
 {****************************************************************}
 { REMARKS: This tests a subset of the secondcalln() node         }
 {          (const parameters with saveregisters                  }
-{            calling convention)  }                              }
+{            calling convention)                                 }
 {****************************************************************}
 program tcalcst9;
 {$ifdef fpc}
-{$mode objfpc}
-{$INLINE ON}
+  {$mode objfpc}
+  {$INLINE ON}
 {$endif}
 {$R+}
 
+{$ifdef VER70}
+  {$define tp}
+{$endif}
 
 
  { REAL should map to single or double }
@@ -35,11 +38,16 @@ program tcalcst9;
 
  const
 { should be defined depending on CPU target }
-{$ifdef cpu68k}
-  BIG_INDEX = 8000;
-  SMALL_INDEX  = 13;
-{$endif}
-{$ifdef cpu86}
+{$ifdef fpc}
+  {$ifdef cpu68k}
+    BIG_INDEX = 8000;
+    SMALL_INDEX  = 13;
+  {$endif}
+  {$ifdef cpui386}
+    BIG_INDEX = 33000;
+    SMALL_INDEX = 13;     { value should not be aligned! }
+  {$endif}
+{$else}
   BIG_INDEX = 33000;
   SMALL_INDEX = 13;     { value should not be aligned! }
 {$endif}
@@ -59,38 +67,38 @@ program tcalcst9;
   RESULT_BOOLEAN = TRUE;
 
 type
-{$ifdef fpc}
+{$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;
-  
+
   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;
@@ -105,7 +113,7 @@ var
  value_u8bit : byte;
  value_u16bit : word;
  value_s32bit : longint;
-{$ifdef fpc}
+{$ifndef tp}
  global_class : tclass1;
  global_s64bit : int64;
  value_s64bit : int64;
@@ -130,8 +138,8 @@ var
       WriteLn('Failure.');
       halt(1);
     end;
-    
-    
+
+
     procedure clear_globals;
      begin
       global_u8bit := 0;
@@ -144,7 +152,7 @@ var
       global_bigstring := '';
       global_boolean := false;
       global_char := #0;
-{$ifdef fpc}
+{$ifndef tp}
       global_s64bit := 0;
       global_class := nil;
 {$endif}
@@ -160,7 +168,7 @@ var
       value_s64real  := 0.0;
       value_proc := nil;
       value_ptr := nil;
-{$ifdef fpc}
+{$ifndef tp}
       value_s64bit := 0;
       value_class := nil;
 {$endif}
@@ -174,8 +182,8 @@ var
       value_boolean := false;
       value_char:=#0;
      end;
-     
-   
+
+
   procedure testprocedure;
    begin
    end;
@@ -184,22 +192,22 @@ var
     begin
       getu8bit:=RESULT_U8BIT;
     end;
-    
+
    function getu16bit: word;
      begin
        getu16bit:=RESULT_U16BIT;
      end;
-     
+
    function gets32bit: longint;
     begin
       gets32bit:=RESULT_S32BIT;
     end;
-    
+
    function gets64bit: longint;
     begin
       gets64bit:=RESULT_S32BIT;
     end;
- 
+
 
    function gets32real: single;
     begin
@@ -219,7 +227,7 @@ var
      global_s32bit := v;
    end;
 
-{$ifdef fpc}
+{$ifndef tp}
   procedure proc_const_s64bit(const v: int64);saveregisters;
    begin
      global_s64bit:= v;
@@ -231,11 +239,11 @@ var
   begin
     for i:=0 to high(arr) do
      begin
-       case arr[i].vtype of 
+       case arr[i].vtype of
         vtInteger : global_u8bit := arr[i].vinteger and $ff;
         vtBoolean : global_boolean := arr[i].vboolean;
         vtChar : global_char := arr[i].vchar;
-        vtExtended : global_s64real := arr[i].VExtended^; 
+        vtExtended : global_s64real := arr[i].VExtended^;
         vtString :  global_bigstring := arr[i].VString^;
         vtPointer : ;
         vtPChar : global_ptr := arr[i].VPchar;
@@ -248,7 +256,7 @@ var
        end;
      end; {endfor}
   end;
-  
+
 
   procedure proc_const_smallarray_const_2(const arr : array of const);saveregisters;
   var
@@ -260,7 +268,7 @@ var
 
 {$endif}
 
-   
+
   procedure proc_const_smallrecord(const smallrec : tsmallrecord);saveregisters;
    begin
      if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then
@@ -279,8 +287,8 @@ var
      if A_D in smallset then
        global_u8bit := RESULT_U8BIT;
    end;
-   
-   
+
+
   procedure proc_const_largeset(const largeset : tlargeset);saveregisters;
    begin
      if 'I' in largeset then
@@ -293,29 +301,29 @@ var
      if s = RESULT_SMALLSTRING then
        global_u8bit := RESULT_u8BIT;
    end;
-    
+
 
   procedure proc_const_bigstring(const s:shortstring);saveregisters;
    begin
      if s = RESULT_BIGSTRING then
        global_u8bit := RESULT_u8BIT;
    end;
-   
-   
+
+
   procedure proc_const_smallarray(const arr : tsmallarray);saveregisters;
   begin
     if arr[SMALL_INDEX] = RESULT_U8BIT then
       global_u8bit := RESULT_U8BIT;
   end;
-  
+
   procedure proc_const_smallarray_open(const arr : array of byte);saveregisters;
   begin
     { form 0 to N-1 indexes in open arrays }
     if arr[SMALL_INDEX-1] = RESULT_U8BIT then
       global_u8bit := RESULT_U8BIT;
   end;
-  
-  
+
+
 
 
   procedure proc_const_formaldef_array(const buf);saveregisters;
@@ -337,7 +345,7 @@ var
      value_u8bit := b2;
    end;
 
-{$ifdef fpc}
+{$ifndef tp}
   procedure proc_const_s64bit_mixed(b1 : byte; const v: int64; b2: byte);saveregisters;
    begin
      global_s64bit:= v;
@@ -470,7 +478,7 @@ begin
   proc_const_s32bit(gets32bit);
   if global_s32bit <> RESULT_S32BIT then
     failed:=true;
-{$ifdef fpc}
+{$ifndef tp}
   proc_const_s64bit(gets64bit);
   if global_s64bit <> RESULT_S64BIT then
     failed:=true;
@@ -480,7 +488,7 @@ begin
     fail
   else
     WriteLn('Passed!');
-  
+
   write('Const parameter test (src : LOC_REFERENCE (recorddef)))...');
   clear_globals;
   clear_values;
@@ -491,45 +499,45 @@ begin
   proc_const_smallrecord(value_smallrec);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT);
   proc_const_largerecord(value_largerec);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
 
-    
+
   write('const parameter test (src : LOC_REFERENCE (setdef)))...');
   clear_globals;
   clear_values;
   failed := false;
-  
+
   value_smallset := [A_A,A_D];
   proc_const_smallset(value_smallset);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   value_largeset := ['I'];
   proc_const_largeset(value_largeset);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
 
-    
+
 
 
   write('const parameter test (src : LOC_REFERENCE (stringdef)))...');
@@ -541,7 +549,7 @@ begin
   proc_const_smallstring(value_smallstring);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   value_bigstring := RESULT_BIGSTRING;
@@ -555,13 +563,13 @@ begin
     WriteLn('Passed!');
 
 
-    
-    
+
+
   write('Const parameter test (src : LOC_REFERENCE (formaldef)))...');
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
   proc_const_formaldef_array(value_smallarray);
   if global_u8bit <> RESULT_U8BIT then
@@ -573,13 +581,13 @@ begin
     WriteLn('Passed!');
 
 
-    
+
   write('Const parameter test (src : LOC_REFERENCE (arraydef)))...');
-  
+
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
   proc_const_smallarray(value_smallarray);
   if global_u8bit <> RESULT_U8BIT then
@@ -593,7 +601,7 @@ begin
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
 
-{$ifdef fpc}
+{$ifndef tp}
   clear_globals;
   clear_values;
 
@@ -607,10 +615,10 @@ begin
   value_s64real:=RESULT_S64REAL;
   proc_const_smallarray_const_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real,
     value_boolean,value_class]);
-  
+
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if global_char <> RESULT_CHAR then
     failed := true;
   if global_boolean <> RESULT_BOOLEAN then
@@ -620,7 +628,7 @@ begin
   if global_bigstring <> RESULT_SMALLSTRING then
      failed := true;
   if global_ptr <> value_ptr then
-     failed := true; 
+     failed := true;
 {  if value_class <> global_class then
      failed := true;!!!!!!!!!!!!!!!!!!!!}
   if global_s64bit <> RESULT_S64BIT then
@@ -638,7 +646,7 @@ begin
     fail
   else
     WriteLn('Passed!');
-    
+
 
   {***************************** MIXED  TESTS *******************************}
   write('Mixed const parameter test (src : LOC_REGISTER (orddef)))...');
@@ -651,7 +659,7 @@ begin
     failed:=true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-{$ifdef fpc}
+{$ifndef tp}
   proc_const_s64bit_mixed(RESULT_U8BIT,gets64bit,RESULT_U8BIT);
   if global_s64bit <> RESULT_S64BIT then
     failed:=true;
@@ -787,7 +795,7 @@ begin
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
 
-{$ifdef fpc}
+{$ifndef tp}
   clear_globals;
   clear_values;
 
@@ -840,7 +848,10 @@ end.
 
 {
   $Log$
-  Revision 1.1  2002-04-13 17:47:06  carl
+  Revision 1.2  2002-05-13 13:45:36  peter
+    * updated to compile tests with kylix
+
+  Revision 1.1  2002/04/13 17:47:06  carl
   + constant parameter passing for different calling conventions
 
 }

tests/test/cg/tcalval1.pp

@@ -26,6 +26,9 @@ program tcalval1;
 {$R+}
 {$P-}
 
+{$ifdef VER70}
+  {$define tp}
+{$endif}
 
 
  { REAL should map to single or double }
@@ -36,11 +39,16 @@ program tcalval1;
 
  const
 { should be defined depending on CPU target }
-{$ifdef cpu68k}
-  BIG_INDEX = 8000;
-  SMALL_INDEX  = 13;
-{$endif}
-{$ifdef cpu86}
+{$ifdef fpc}
+  {$ifdef cpu68k}
+    BIG_INDEX = 8000;
+    SMALL_INDEX  = 13;
+  {$endif}
+  {$ifdef cpui386}
+    BIG_INDEX = 33000;
+    SMALL_INDEX = 13;     { value should not be aligned! }
+  {$endif}
+{$else}
   BIG_INDEX = 33000;
   SMALL_INDEX = 13;     { value should not be aligned! }
 {$endif}
@@ -58,40 +66,40 @@ program tcalval1;
   RESULT_SMALLSTRING = 'H';
   RESULT_CHAR = 'I';
   RESULT_BOOLEAN = TRUE;
-  
+
 type
-{$ifdef fpc}
+{$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;
-  
+
   tsmallarray = packed array[1..SMALL_INDEX] of byte;
-  
-  tsmallsetenum = 
+
+  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;
@@ -103,7 +111,7 @@ var
  global_bigstring : shortstring;
  global_boolean : boolean;
  global_char : char;
-{$ifdef fpc}
+{$ifndef tp}
  global_class : tclass1;
  global_s64bit : int64;
  value_s64bit : int64;
@@ -125,14 +133,14 @@ var
  value_smallarray : tsmallarray;
  value_boolean : boolean;
  value_char : char;
- 
+
     procedure fail;
     begin
       WriteLn('Failure.');
       halt(1);
     end;
-    
-    
+
+
     procedure clear_globals;
      begin
       global_u8bit := 0;
@@ -145,13 +153,13 @@ var
       global_bigstring := '';
       global_boolean := false;
       global_char := #0;
-{$ifdef fpc}
+{$ifndef tp}
       global_s64bit := 0;
       global_class := nil;
 {$endif}
      end;
-     
-     
+
+
     procedure clear_values;
      begin
       value_u8bit := 0;
@@ -170,37 +178,37 @@ var
       fillchar(value_smallarray, sizeof(value_smallarray), #0);
       value_boolean := false;
       value_char:=#0;
-{$ifdef fpc}
+{$ifndef tp}
       value_s64bit := 0;
       value_class := nil;
 {$endif}
      end;
 
-   
+
   procedure testprocedure;
    begin
    end;
- 
+
    function getu8bit : byte;
     begin
       getu8bit:=RESULT_U8BIT;
     end;
-    
+
    function getu16bit: word;
      begin
        getu16bit:=RESULT_U16BIT;
      end;
-     
+
    function gets32bit: longint;
     begin
       gets32bit:=RESULT_S32BIT;
     end;
-    
+
    function gets64bit: longint;
     begin
       gets64bit:=RESULT_S32BIT;
     end;
- 
+
 
    function gets32real: single;
     begin
@@ -234,8 +242,8 @@ var
    end;
 
 
-   
-   
+
+
   procedure proc_value_bool8bit(v: boolean);
    begin
      { boolean should be 8-bit always! }
@@ -260,13 +268,13 @@ var
    begin
      global_s32real := v;
    end;
-   
+
   procedure proc_value_s64real(v: double);
    begin
      global_s64real:= v;
    end;
-   
-   
+
+
   procedure proc_value_pointerdef(p : pchar);
    begin
      global_ptr:=p;
@@ -277,23 +285,23 @@ var
    begin
      global_proc:=p;
    end;
-   
-   
 
-   
+
+
+
   procedure proc_value_smallrecord(smallrec : tsmallrecord);
    begin
      if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then
        global_u8bit := RESULT_U8BIT;
    end;
-   
+
 
   procedure proc_value_largerecord(largerec : tlargerecord);
    begin
      if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then
        global_u8bit := RESULT_U8BIT;
    end;
-   
+
   procedure proc_value_smallset(smallset : tsmallset);
    begin
      if A_D in smallset then
@@ -306,13 +314,13 @@ var
      if 'I' in largeset then
        global_u8bit := RESULT_U8BIT;
    end;
-   
+
   procedure proc_value_smallstring(s:tsmallstring);
    begin
      if s = RESULT_SMALLSTRING then
        global_u8bit := RESULT_u8BIT;
    end;
-    
+
 
   procedure proc_value_bigstring(s:shortstring);
    begin
@@ -326,7 +334,7 @@ var
     if arr[SMALL_INDEX] = RESULT_U8BIT then
       global_u8bit := RESULT_U8BIT;
   end;
-  
+
   procedure proc_value_smallarray_open(arr : array of byte);
   begin
     { form 0 to N-1 indexes in open arrays }
@@ -334,7 +342,7 @@ var
       global_u8bit := RESULT_U8BIT;
   end;
 
-{$ifdef fpc}
+{$ifndef tp}
   procedure proc_value_classrefdef(obj : tclass1);
    begin
      global_class:=obj;
@@ -347,11 +355,11 @@ var
   begin
     for i:=0 to high(arr) do
      begin
-       case arr[i].vtype of 
+       case arr[i].vtype of
         vtInteger : global_u8bit := arr[i].vinteger and $ff;
         vtBoolean : global_boolean := arr[i].vboolean;
         vtChar : global_char := arr[i].vchar;
-        vtExtended : global_s64real := arr[i].VExtended^; 
+        vtExtended : global_s64real := arr[i].VExtended^;
         vtString :  global_bigstring := arr[i].VString^;
         vtPointer : ;
         vtPChar : global_ptr := arr[i].VPchar;
@@ -364,7 +372,7 @@ var
        end;
      end; {endfor}
   end;
-  
+
 
   procedure proc_value_smallarray_const_2(arr : array of const);
   var
@@ -381,7 +389,7 @@ var
 {$endif}
 
  {********************************* MIXED PARAMETERS *************************}
- 
+
   procedure proc_value_u8bit_mixed(b1 : byte; v: byte; b2: byte);
    begin
      global_u8bit := v;
@@ -401,10 +409,10 @@ var
      global_s32bit := v;
      value_u8bit := b2;
    end;
-   
 
-   
-   
+
+
+
   procedure proc_value_bool8bit_mixed(b1: byte; v: boolean; b2: byte);
    begin
      { boolean should be 8-bit always! }
@@ -433,14 +441,14 @@ var
      global_s32real := v;
      value_u8bit := b2;
    end;
-   
+
   procedure proc_value_s64real_mixed(b1: byte; v: double; b2: byte);
    begin
      global_s64real:= v;
      value_u8bit := b2;
    end;
-   
-   
+
+
   procedure proc_value_pointerdef_mixed(b1: byte; p : pchar; b2: byte);
    begin
      global_ptr:=p;
@@ -453,8 +461,8 @@ var
      global_proc:=p;
      value_u8bit := b2;
    end;
-   
-   
+
+
 
 
   procedure proc_value_smallrecord_mixed(b1: byte; smallrec : tsmallrecord; b2: byte);
@@ -463,7 +471,7 @@ var
        global_u8bit := RESULT_U8BIT;
      value_u8bit := b2;
    end;
-   
+
 
   procedure proc_value_largerecord_mixed(b1: byte; largerec : tlargerecord; b2: byte);
    begin
@@ -471,14 +479,14 @@ var
        global_u8bit := RESULT_U8BIT;
      value_u8bit := b2;
    end;
-   
+
   procedure proc_value_smallset_mixed(b1: byte; smallset : tsmallset; b2: byte);
    begin
      if A_D in smallset then
        global_u8bit := RESULT_U8BIT;
      value_u8bit := b2;
    end;
-   
+
 
   procedure proc_value_largeset_mixed(b1: byte; largeset : tlargeset; b2: byte);
    begin
@@ -486,14 +494,14 @@ var
        global_u8bit := RESULT_U8BIT;
      value_u8bit := b2;
    end;
-   
+
   procedure proc_value_smallstring_mixed(b1: byte; s:tsmallstring; b2: byte);
    begin
      if s = RESULT_SMALLSTRING then
        global_u8bit := RESULT_u8BIT;
      value_u8bit := b2;
    end;
-    
+
 
   procedure proc_value_bigstring_mixed(b1: byte; s:shortstring; b2: byte);
    begin
@@ -501,7 +509,7 @@ var
        global_u8bit := RESULT_u8BIT;
      value_u8bit := b2;
    end;
-   
+
 
   procedure proc_value_smallarray_mixed(b1: byte; arr : tsmallarray; b2: byte);
   begin
@@ -509,7 +517,7 @@ var
       global_u8bit := RESULT_U8BIT;
      value_u8bit := b2;
   end;
-  
+
   procedure proc_value_smallarray_open_mixed(b1: byte; arr : array of byte; b2: byte);
   begin
     { form 0 to N-1 indexes in open arrays }
@@ -518,7 +526,7 @@ var
      value_u8bit := b2;
   end;
 
-{$ifdef fpc}
+{$ifndef tp}
   procedure proc_value_classrefdef_mixed(b1: byte; obj : tclass1; b2: byte);
    begin
      global_class:=obj;
@@ -532,18 +540,18 @@ var
      value_u8bit := b2;
    end;
 
-  
+
   procedure proc_value_smallarray_const_1_mixed(b1: byte; arr : array of const; b2: byte);
   var
    i: integer;
   begin
     for i:=0 to high(arr) do
      begin
-       case arr[i].vtype of 
+       case arr[i].vtype of
         vtInteger : global_u8bit := arr[i].vinteger and $ff;
         vtBoolean : global_boolean := arr[i].vboolean;
         vtChar : global_char := arr[i].vchar;
-        vtExtended : global_s64real := arr[i].VExtended^; 
+        vtExtended : global_s64real := arr[i].VExtended^;
         vtString :  global_bigstring := arr[i].VString^;
         vtPointer : ;
         vtPChar : global_ptr := arr[i].VPchar;
@@ -557,7 +565,7 @@ var
      end; {endfor}
      value_u8bit := b2;
   end;
-  
+
 
   procedure proc_value_smallarray_const_2_mixed(b1: byte; arr : array of const; b2: byte);
   var
@@ -575,9 +583,9 @@ Begin
   {***************************** NORMAL TESTS *******************************}
   clear_globals;
   clear_values;
-  
+
   failed:=false;
-  
+
   { LOC_REGISTER }
   write('Value parameter test (src : LOC_REGISTER)...');
   proc_value_u8bit(getu8bit);
@@ -589,7 +597,7 @@ Begin
   proc_value_s32bit(gets32bit);
   if global_s32bit <> RESULT_S32BIT then
     failed:=true;
-{$ifdef fpc}
+{$ifndef tp}
   proc_value_s64bit(gets64bit);
   if global_s64bit <> RESULT_S64BIT then
     failed:=true;
@@ -598,9 +606,9 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
-    
-  { LOC_FPUREGISTER }  
+
+
+  { LOC_FPUREGISTER }
   clear_globals;
   clear_values;
   failed:=false;
@@ -615,22 +623,22 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
 
-  { LOC_MEM, LOC_REFERENCE orddef } 
+
+  { LOC_MEM, LOC_REFERENCE orddef }
   clear_globals;
   clear_values;
   value_u8bit := RESULT_U8BIT;
   value_u16bit := RESULT_U16BIT;
   value_s32bit := RESULT_S32BIT;
-{$ifdef fpc}
+{$ifndef tp}
   value_s64bit := RESULT_S64BIT;
 {$endif}
   value_s32real := RESULT_S32REAL;
   value_s64real  := RESULT_S64REAL;
 
   failed:=false;
-  
+
   { LOC_REFERENCE }
   write('Value parameter test (src : LOC_REFERENCE (orddef/enumdef)))...');
   proc_value_u8bit(value_u8bit);
@@ -642,7 +650,7 @@ Begin
   proc_value_s32bit(value_s32bit);
   if global_s32bit <> RESULT_S32BIT then
     failed:=true;
-{$ifdef fpc}
+{$ifndef tp}
   proc_value_s64bit(value_s64bit);
   if global_s64bit <> RESULT_S64BIT then
     failed:=true;
@@ -651,9 +659,9 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
-    
-  { LOC_REFERENCE }  
+
+
+  { LOC_REFERENCE }
   clear_globals;
   failed:=false;
   write('Value parameter test (src : LOC_REFERENCE (floatdef))...');
@@ -667,7 +675,7 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
+
 
 
   write('Value parameter test (src : LOC_REFERENCE (pointer))...');
@@ -680,12 +688,12 @@ Begin
     failed := true;
 
 
-  value_proc := {$ifdef fpc}@{$endif}testprocedure;
+  value_proc := {$ifndef tp}@{$endif}testprocedure;
   proc_value_procvardef(value_proc);
   if {$ifndef fpc}@{$endif}value_proc <> {$ifndef fpc}@{$endif}global_proc then
     failed := true;
 
-{$ifdef fpc}
+{$ifndef tp}
   value_class := tclass1.create;
   proc_value_classrefdef(value_class);
   if value_class <> global_class then
@@ -709,7 +717,7 @@ Begin
   proc_value_bool8bit(value_u8bit = 0);
   if global_u8bit <> RESULT_BOOL8BIT then
     failed:=true;
-{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x 
+{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x
   proc_value_bool16bit(value_s64bit < 0);
   if global_u16bit <> RESULT_BOOL16BIT then
     failed:=true;
@@ -723,7 +731,7 @@ Begin
 
 
 
-{$ifdef fpc}
+{$ifndef tp}
   clear_globals;
   clear_values;
   failed:=false;
@@ -731,7 +739,7 @@ Begin
   proc_value_bool8bit(value_s64bit = 0);
   if global_u8bit <> RESULT_BOOL8BIT then
     failed:=true;
-{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x 
+{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x
   proc_value_bool16bit(value_s64bit < 0);
   if global_u16bit <> RESULT_BOOL16BIT then
     failed:=true;
@@ -767,38 +775,38 @@ Begin
   proc_value_largerecord(value_largerec);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
-    
-    
+
+
   write('Value parameter test (src : LOC_REFERENCE (setdef)))...');
   clear_globals;
   clear_values;
   failed := false;
-  
+
   value_smallset := [A_A,A_D];
   proc_value_smallset(value_smallset);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   value_largeset := ['I'];
   proc_value_largeset(value_largeset);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
 
-    
+
 
 
   write('Value parameter test (src : LOC_REFERENCE (stringdef)))...');
@@ -810,14 +818,14 @@ Begin
   proc_value_smallstring(value_smallstring);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   value_bigstring := RESULT_BIGSTRING;
   proc_value_bigstring(value_bigstring);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
@@ -827,14 +835,14 @@ Begin
 
   { open array by value with cdecl modifier!!!!!!!!!!!!!!!!!!!!!!!!!!!}
   { DON'T KNOW WHY/HOW TO TEST!!!!!                                   }
-  
-  
+
+
   write('Value parameter test (src : LOC_REFERENCE (arraydef)))...');
-  
+
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   fillchar(value_smallarray,sizeof(value_smallarray),#0);
   value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
   proc_value_smallarray(value_smallarray);
@@ -850,7 +858,7 @@ Begin
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
 
-{$ifdef fpc}
+{$ifndef tp}
   clear_globals;
   clear_values;
 
@@ -864,10 +872,10 @@ Begin
   value_s64real:=RESULT_S64REAL;
   proc_value_smallarray_const_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real,
     value_boolean,value_class]);
-  
+
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if global_char <> RESULT_CHAR then
     failed := true;
   if global_boolean <> RESULT_BOOLEAN then
@@ -899,9 +907,9 @@ Begin
   {***************************** MIXED  TESTS *******************************}
   clear_globals;
   clear_values;
-  
+
   failed:=false;
-  
+
   { LOC_REGISTER }
   write('Mixed value parameter test (src : LOC_REGISTER)...');
   proc_value_u8bit_mixed(byte(NOT RESULT_U8BIT),getu8bit,RESULT_U8BIT);
@@ -919,7 +927,7 @@ Begin
     failed:=true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-{$ifdef fpc}
+{$ifndef tp}
   proc_value_s64bit_mixed(byte(NOT RESULT_U8BIT),gets64bit,RESULT_U8BIT);
   if global_s64bit <> RESULT_S64BIT then
     failed:=true;
@@ -931,9 +939,9 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
-    
-  { LOC_FPUREGISTER }  
+
+
+  { LOC_FPUREGISTER }
   clear_globals;
   clear_values;
   failed:=false;
@@ -952,22 +960,22 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
 
-  { LOC_MEM, LOC_REFERENCE orddef } 
+
+  { LOC_MEM, LOC_REFERENCE orddef }
   clear_globals;
   clear_values;
   value_u8bit := RESULT_U8BIT;
   value_u16bit := RESULT_U16BIT;
   value_s32bit := RESULT_S32BIT;
-{$ifdef fpc}
+{$ifndef tp}
   value_s64bit := RESULT_S64BIT;
 {$endif}
   value_s32real := RESULT_S32REAL;
   value_s64real  := RESULT_S64REAL;
 
   failed:=false;
-  
+
   { LOC_REFERENCE }
   write('Mixed value parameter test (src : LOC_REFERENCE (orddef/enumdef)))...');
   proc_value_u8bit_mixed(byte(NOT RESULT_U8BIT),value_u8bit, RESULT_U8BIT);
@@ -985,7 +993,7 @@ Begin
     failed:=true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-{$ifdef fpc}
+{$ifndef tp}
   proc_value_s64bit_mixed(byte(NOT RESULT_U8BIT), value_s64bit, RESULT_U8BIT);
   if global_s64bit <> RESULT_S64BIT then
     failed:=true;
@@ -997,9 +1005,9 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
-    
-  { LOC_REFERENCE }  
+
+
+  { LOC_REFERENCE }
   clear_globals;
   failed:=false;
   write('Mixed value parameter test (src : LOC_REFERENCE (floatdef))...');
@@ -1018,7 +1026,7 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
+
 
 
   write('Mixed value parameter test (src : LOC_REFERENCE (pointer))...');
@@ -1033,12 +1041,12 @@ Begin
     failed := true;
 
 
-  value_proc := {$ifdef fpc}@{$endif}testprocedure;
+  value_proc := {$ifndef tp}@{$endif}testprocedure;
   proc_value_procvardef_mixed(byte(NOT RESULT_U8BIT), value_proc, RESULT_U8BIT);
   if {$ifndef fpc}@{$endif}value_proc <> {$ifndef fpc}@{$endif}global_proc then
     failed := true;
 
-{$ifdef fpc}
+{$ifndef tp}
   value_class := tclass1.create;
   proc_value_classrefdef_mixed(byte(NOT RESULT_U8BIT), value_class, RESULT_U8BIT);
   if value_class <> global_class then
@@ -1066,7 +1074,7 @@ Begin
     failed:=true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x 
+{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x
   proc_value_bool16bit(value_s64bit < 0);
   if global_u16bit <> RESULT_BOOL16BIT then
     failed:=true;
@@ -1079,8 +1087,8 @@ Begin
     WriteLn('Passed!');
 
 
-    
-{$ifdef fpc}
+
+{$ifndef tp}
   clear_globals;
   clear_values;
   failed:=false;
@@ -1090,7 +1098,7 @@ Begin
     failed:=true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x 
+{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x
   proc_value_bool16bit(value_s64bit < 0);
   if global_u16bit <> RESULT_BOOL16BIT then
     failed:=true;
@@ -1102,7 +1110,7 @@ Begin
   else
     WriteLn('Passed!');
 {$endif}
-     
+
   { arraydef,
     recorddef,
     objectdef,
@@ -1130,26 +1138,26 @@ Begin
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
-    
-    
+
+
   write('Mixed value parameter test (src : LOC_REFERENCE (setdef)))...');
   clear_globals;
   clear_values;
   failed := false;
-  
+
   value_smallset := [A_A,A_D];
   proc_value_smallset_mixed(byte(NOT RESULT_U8BIT), value_smallset, RESULT_U8BIT);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   value_largeset := ['I'];
@@ -1158,14 +1166,14 @@ Begin
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
 
-    
+
 
 
   write('Mixed value parameter test (src : LOC_REFERENCE (stringdef)))...');
@@ -1179,7 +1187,7 @@ Begin
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   value_bigstring := RESULT_BIGSTRING;
@@ -1188,7 +1196,7 @@ Begin
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
@@ -1198,14 +1206,14 @@ Begin
 
   { open array by value with cdecl modifier!!!!!!!!!!!!!!!!!!!!!!!!!!!}
   { DON'T KNOW WHY/HOW TO TEST!!!!!                                   }
-  
-  
+
+
   write('Mixed value parameter test (src : LOC_REFERENCE (arraydef)))...');
-  
+
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   fillchar(value_smallarray,sizeof(value_smallarray),#0);
   value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
   proc_value_smallarray_mixed(byte(NOT RESULT_U8BIT), value_smallarray, RESULT_U8BIT);
@@ -1225,7 +1233,7 @@ Begin
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
 
-{$ifdef fpc}
+{$ifndef tp}
   clear_globals;
   clear_values;
 
@@ -1242,10 +1250,10 @@ Begin
      RESULT_U8BIT);
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-  
+
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if global_char <> RESULT_CHAR then
     failed := true;
   if global_boolean <> RESULT_BOOLEAN then
@@ -1255,7 +1263,7 @@ Begin
   if global_bigstring <> RESULT_SMALLSTRING then
      failed := true;
   if global_ptr <> value_ptr then
-     failed := true; 
+     failed := true;
 {  if value_class <> global_class then
      failed := true;!!!!!!!!!!!!!!!!!!!!}
   if global_s64bit <> RESULT_S64BIT then
@@ -1275,13 +1283,16 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
+
 end.
 
 
 {
   $Log$
-  Revision 1.1  2002-04-10 16:33:18  carl
+  Revision 1.2  2002-05-13 13:45:37  peter
+    * updated to compile tests with kylix
+
+  Revision 1.1  2002/04/10 16:33:18  carl
   + first tries at first calln testing
 
 }

tests/test/cg/tcalval2.pp

@@ -24,6 +24,9 @@ program tcalval2;
 {$R+}
 {$P-}
 
+{$ifdef VER70}
+  {$define tp}
+{$endif}
 
 
  { REAL should map to single or double }
@@ -34,11 +37,16 @@ program tcalval2;
 
  const
 { should be defined depending on CPU target }
-{$ifdef cpu68k}
-  BIG_INDEX = 8000;
-  SMALL_INDEX  = 13;
-{$endif}
-{$ifdef cpui386}
+{$ifdef fpc}
+  {$ifdef cpu68k}
+    BIG_INDEX = 8000;
+    SMALL_INDEX  = 13;
+  {$endif}
+  {$ifdef cpui386}
+    BIG_INDEX = 33000;
+    SMALL_INDEX = 13;     { value should not be aligned! }
+  {$endif}
+{$else}
   BIG_INDEX = 33000;
   SMALL_INDEX = 13;     { value should not be aligned! }
 {$endif}
@@ -56,36 +64,36 @@ program tcalval2;
   RESULT_SMALLSTRING = 'H';
   RESULT_CHAR = 'I';
   RESULT_BOOLEAN = TRUE;
-  
-type 
+
+type
   tclass1 = class
   end;
-  
+
   tprocedure = procedure;
-  
+
   tsmallrecord = packed record
     b: byte;
     w: word;
   end;
-  
+
   tlargerecord = packed record
     b: array[1..BIG_INDEX] of byte;
   end;
-  
+
   tsmallarray = packed array[1..SMALL_INDEX] of byte;
-  
-  tsmallsetenum = 
+
+  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;
@@ -117,14 +125,14 @@ var
  value_smallarray : tsmallarray;
  value_boolean : boolean;
  value_char : char;
- 
+
     procedure fail;
     begin
       WriteLn('Failure.');
       halt(1);
     end;
-    
-    
+
+
     procedure clear_globals;
      begin
       global_u8bit := 0;
@@ -140,8 +148,8 @@ var
       global_boolean := false;
       global_char := #0;
      end;
-     
-     
+
+
     procedure clear_values;
      begin
       value_u8bit := 0;
@@ -163,32 +171,32 @@ var
       value_boolean := false;
       value_char:=#0;
      end;
-     
-   
+
+
   procedure testprocedure;
    begin
    end;
- 
+
    function getu8bit : byte;
     begin
       getu8bit:=RESULT_U8BIT;
     end;
-    
+
    function getu16bit: word;
      begin
        getu16bit:=RESULT_U16BIT;
      end;
-     
+
    function gets32bit: longint;
     begin
       gets32bit:=RESULT_S32BIT;
     end;
-    
+
    function gets64bit: longint;
     begin
       gets64bit:=RESULT_S32BIT;
     end;
- 
+
 
    function gets32real: single;
     begin
@@ -217,7 +225,7 @@ var
    begin
      global_s32bit := v;
    end;
-   
+
   procedure proc_value_s64bit_inline(v: int64);inline;
    begin
      global_s64bit:= v;
@@ -227,7 +235,7 @@ var
    begin
      global_s32real := v;
    end;
-   
+
   procedure proc_value_s64real_inline(v: double);inline;
    begin
      global_s64real:= v;
@@ -243,8 +251,8 @@ var
    begin
      global_proc:=p;
    end;
-   
-   
+
+
   procedure proc_value_classrefdef_inline(obj : tclass1);inline;
    begin
      global_class:=obj;
@@ -275,43 +283,43 @@ var
      if A_D in smallset then
        global_u8bit := RESULT_U8BIT;
    end;
-   
-   
+
+
   procedure proc_value_largeset_inline(largeset : tlargeset);inline;
    begin
      if 'I' in largeset then
        global_u8bit := RESULT_U8BIT;
    end;
-   
+
 
   procedure proc_value_smallstring_inline(s:tsmallstring);inline;
    begin
      if s = RESULT_SMALLSTRING then
        global_u8bit := RESULT_u8BIT;
    end;
-    
+
 
   procedure proc_value_bigstring_inline(s:shortstring);inline;
    begin
      if s = RESULT_BIGSTRING then
        global_u8bit := RESULT_u8BIT;
    end;
-   
-   
+
+
   procedure proc_value_smallarray_inline(arr : tsmallarray);inline;
   begin
     if arr[SMALL_INDEX] = RESULT_U8BIT then
       global_u8bit := RESULT_U8BIT;
   end;
-  
+
   procedure proc_value_smallarray_open_inline(arr : array of byte);inline;
   begin
     { form 0 to N-1 indexes in open arrays }
     if arr[SMALL_INDEX-1] = RESULT_U8BIT then
       global_u8bit := RESULT_U8BIT;
   end;
-  
-  
+
+
   procedure proc_value_smallarray_const_1_inline(arr : array of const);inline;
   var
    i: integer;
@@ -321,17 +329,17 @@ var
         global_s64bit := arr[2].vInt64^;
         global_char := arr[3].vchar;
         global_bigstring := arr[4].VString^;
-        global_s64real := arr[5].VExtended^; 
-        
+        global_s64real := arr[5].VExtended^;
+
         global_boolean := arr[6].vboolean;
 (*
     for i:=0 to high(arr) do
      begin
-       case arr[i].vtype of 
+       case arr[i].vtype of
         vtInteger : global_u8bit := arr[i].vinteger and $ff;
         vtBoolean : global_boolean := arr[i].vboolean;
         vtChar : global_char := arr[i].vchar;
-        vtExtended : global_s64real := arr[i].VExtended^; 
+        vtExtended : global_s64real := arr[i].VExtended^;
         vtString :  global_bigstring := arr[i].VString^;
         vtPointer : ;
         vtPChar : global_ptr := arr[i].VPchar;
@@ -343,9 +351,9 @@ var
           RunError(255);
        end;
      end; {endfor}
-*)     
+*)
   end;
-  
+
 
   procedure proc_value_smallarray_const_2_inline(arr : array of const);inline;
   var
@@ -354,7 +362,7 @@ var
      if high(arr)<0 then
        global_u8bit := RESULT_U8BIT;
   end;
-   
+
 
 var
  failed: boolean;
@@ -393,7 +401,7 @@ begin
   proc_value_s64real_inline(gets64real);
   if trunc(global_s64real) <> trunc(RESULT_S64REAL) then
     failed:=true;
-    
+
   if failed then
     fail
   else
@@ -429,7 +437,7 @@ begin
   proc_value_s64real_inline(value_s64real);
   if trunc(global_s64real) <> trunc(RESULT_S64REAL) then
     failed:=true;
-    
+
   if failed then
     fail
   else
@@ -473,7 +481,7 @@ begin
     fail
   else
     WriteLn('Passed!');
-    
+
   write('(Inline) Value parameter test (src : LOC_REFERENCE (recorddef)))...');
   failed := false;
 
@@ -484,14 +492,14 @@ begin
   proc_value_smallrecord_inline(value_smallrec);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT);
   proc_value_largerecord_inline(value_largerec);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
@@ -506,14 +514,14 @@ begin
   proc_value_smallset_inline(value_smallset);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   value_largeset := ['I'];
   proc_value_largeset_inline(value_largeset);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
@@ -528,14 +536,14 @@ begin
   proc_value_smallstring_inline(value_smallstring);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   value_bigstring := RESULT_BIGSTRING;
   proc_value_bigstring_inline(value_bigstring);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
@@ -545,7 +553,7 @@ begin
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
   proc_value_smallarray_inline(value_smallarray);
   if global_u8bit <> RESULT_U8BIT then
@@ -561,7 +569,7 @@ begin
 
   clear_globals;
   clear_values;
-  
+
   value_u8bit := RESULT_U8BIT;
   value_ptr := RESULT_PCHAR;
   value_s64bit := RESULT_S64BIT;
@@ -571,10 +579,10 @@ begin
   value_char := RESULT_CHAR;
   value_s64real:=RESULT_S64REAL;
   proc_value_smallarray_const_1_inline([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real,value_boolean,value_class]);
-  
+
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if global_char <> RESULT_CHAR then
     failed := true;
   if global_boolean <> RESULT_BOOLEAN then
@@ -584,7 +592,7 @@ begin
   if global_bigstring <> RESULT_SMALLSTRING then
      failed := true;
   if global_ptr <> value_ptr then
-     failed := true; 
+     failed := true;
 {  if value_class <> global_class then
      failed := true;!!!!!!!!!!!!!!!!!!!!}
   if global_s64bit <> RESULT_S64BIT then

tests/test/cg/tcalval3.pp

@@ -26,6 +26,9 @@ program tcalval3;
 {$R+}
 {$P-}
 
+{$ifdef VER70}
+  {$define tp}
+{$endif}
 
 
  { REAL should map to single or double }
@@ -36,11 +39,16 @@ program tcalval3;
 
  const
 { should be defined depending on CPU target }
-{$ifdef cpu68k}
-  BIG_INDEX = 8000;
-  SMALL_INDEX  = 13;
-{$endif}
-{$ifdef cpu86}
+{$ifdef fpc}
+  {$ifdef cpu68k}
+    BIG_INDEX = 8000;
+    SMALL_INDEX  = 13;
+  {$endif}
+  {$ifdef cpui386}
+    BIG_INDEX = 33000;
+    SMALL_INDEX = 13;     { value should not be aligned! }
+  {$endif}
+{$else}
   BIG_INDEX = 33000;
   SMALL_INDEX = 13;     { value should not be aligned! }
 {$endif}
@@ -58,40 +66,40 @@ program tcalval3;
   RESULT_SMALLSTRING = 'H';
   RESULT_CHAR = 'I';
   RESULT_BOOLEAN = TRUE;
-  
+
 type
-{$ifdef fpc}
+{$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;
-  
+
   tsmallarray = packed array[1..SMALL_INDEX] of byte;
-  
-  tsmallsetenum = 
+
+  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;
@@ -103,7 +111,7 @@ var
  global_bigstring : shortstring;
  global_boolean : boolean;
  global_char : char;
-{$ifdef fpc}
+{$ifndef tp}
  global_class : tclass1;
  global_s64bit : int64;
  value_s64bit : int64;
@@ -125,14 +133,14 @@ var
  value_smallarray : tsmallarray;
  value_boolean : boolean;
  value_char : char;
- 
+
     procedure fail;
     begin
       WriteLn('Failure.');
       halt(1);
     end;
-    
-    
+
+
     procedure clear_globals;
      begin
       global_u8bit := 0;
@@ -145,13 +153,13 @@ var
       global_bigstring := '';
       global_boolean := false;
       global_char := #0;
-{$ifdef fpc}
+{$ifndef tp}
       global_s64bit := 0;
       global_class := nil;
 {$endif}
      end;
-     
-     
+
+
     procedure clear_values;
      begin
       value_u8bit := 0;
@@ -170,37 +178,37 @@ var
       fillchar(value_smallarray, sizeof(value_smallarray), #0);
       value_boolean := false;
       value_char:=#0;
-{$ifdef fpc}
+{$ifndef tp}
       value_s64bit := 0;
       value_class := nil;
 {$endif}
      end;
 
-   
+
   procedure testprocedure;
    begin
    end;
- 
+
    function getu8bit : byte;
     begin
       getu8bit:=RESULT_U8BIT;
     end;
-    
+
    function getu16bit: word;
      begin
        getu16bit:=RESULT_U16BIT;
      end;
-     
+
    function gets32bit: longint;
     begin
       gets32bit:=RESULT_S32BIT;
     end;
-    
+
    function gets64bit: longint;
     begin
       gets64bit:=RESULT_S32BIT;
     end;
- 
+
 
    function gets32real: single;
     begin
@@ -234,8 +242,8 @@ var
    end;
 
 
-   
-   
+
+
   procedure proc_value_bool8bit(v: boolean);pascal;
    begin
      { boolean should be 8-bit always! }
@@ -260,13 +268,13 @@ var
    begin
      global_s32real := v;
    end;
-   
+
   procedure proc_value_s64real(v: double);pascal;
    begin
      global_s64real:= v;
    end;
-   
-   
+
+
   procedure proc_value_pointerdef(p : pchar);pascal;
    begin
      global_ptr:=p;
@@ -277,23 +285,23 @@ var
    begin
      global_proc:=p;
    end;
-   
-   
 
-   
+
+
+
   procedure proc_value_smallrecord(smallrec : tsmallrecord);pascal;
    begin
      if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then
        global_u8bit := RESULT_U8BIT;
    end;
-   
+
 
   procedure proc_value_largerecord(largerec : tlargerecord);pascal;
    begin
      if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then
        global_u8bit := RESULT_U8BIT;
    end;
-   
+
   procedure proc_value_smallset(smallset : tsmallset);pascal;
    begin
      if A_D in smallset then
@@ -306,13 +314,13 @@ var
      if 'I' in largeset then
        global_u8bit := RESULT_U8BIT;
    end;
-   
+
   procedure proc_value_smallstring(s:tsmallstring);pascal;
    begin
      if s = RESULT_SMALLSTRING then
        global_u8bit := RESULT_u8BIT;
    end;
-    
+
 
   procedure proc_value_bigstring(s:shortstring);pascal;
    begin
@@ -326,7 +334,7 @@ var
     if arr[SMALL_INDEX] = RESULT_U8BIT then
       global_u8bit := RESULT_U8BIT;
   end;
-  
+
   procedure proc_value_smallarray_open(arr : array of byte);pascal;
   begin
     { form 0 to N-1 indexes in open arrays }
@@ -334,7 +342,7 @@ var
       global_u8bit := RESULT_U8BIT;
   end;
 
-{$ifdef fpc}
+{$ifndef tp}
   procedure proc_value_classrefdef(obj : tclass1);pascal;
    begin
      global_class:=obj;
@@ -347,11 +355,11 @@ var
   begin
     for i:=0 to high(arr) do
      begin
-       case arr[i].vtype of 
+       case arr[i].vtype of
         vtInteger : global_u8bit := arr[i].vinteger and $ff;
         vtBoolean : global_boolean := arr[i].vboolean;
         vtChar : global_char := arr[i].vchar;
-        vtExtended : global_s64real := arr[i].VExtended^; 
+        vtExtended : global_s64real := arr[i].VExtended^;
         vtString :  global_bigstring := arr[i].VString^;
         vtPointer : ;
         vtPChar : global_ptr := arr[i].VPchar;
@@ -364,7 +372,7 @@ var
        end;
      end; {endfor}
   end;
-  
+
 
   procedure proc_value_smallarray_const_2(arr : array of const);pascal;
   var
@@ -381,7 +389,7 @@ var
 {$endif}
 
  {********************************* MIXED PARAMETERS *************************}
- 
+
   procedure proc_value_u8bit_mixed(b1 : byte; v: byte; b2: byte);pascal;
    begin
      global_u8bit := v;
@@ -401,10 +409,10 @@ var
      global_s32bit := v;
      value_u8bit := b2;
    end;
-   
 
-   
-   
+
+
+
   procedure proc_value_bool8bit_mixed(b1: byte; v: boolean; b2: byte);pascal;
    begin
      { boolean should be 8-bit always! }
@@ -433,14 +441,14 @@ var
      global_s32real := v;
      value_u8bit := b2;
    end;
-   
+
   procedure proc_value_s64real_mixed(b1: byte; v: double; b2: byte);pascal;
    begin
      global_s64real:= v;
      value_u8bit := b2;
    end;
-   
-   
+
+
   procedure proc_value_pointerdef_mixed(b1: byte; p : pchar; b2: byte);pascal;
    begin
      global_ptr:=p;
@@ -453,8 +461,8 @@ var
      global_proc:=p;
      value_u8bit := b2;
    end;
-   
-   
+
+
 
 
   procedure proc_value_smallrecord_mixed(b1: byte; smallrec : tsmallrecord; b2: byte);pascal;
@@ -463,7 +471,7 @@ var
        global_u8bit := RESULT_U8BIT;
      value_u8bit := b2;
    end;
-   
+
 
   procedure proc_value_largerecord_mixed(b1: byte; largerec : tlargerecord; b2: byte);pascal;
    begin
@@ -471,14 +479,14 @@ var
        global_u8bit := RESULT_U8BIT;
      value_u8bit := b2;
    end;
-   
+
   procedure proc_value_smallset_mixed(b1: byte; smallset : tsmallset; b2: byte);pascal;
    begin
      if A_D in smallset then
        global_u8bit := RESULT_U8BIT;
      value_u8bit := b2;
    end;
-   
+
 
   procedure proc_value_largeset_mixed(b1: byte; largeset : tlargeset; b2: byte);pascal;
    begin
@@ -486,14 +494,14 @@ var
        global_u8bit := RESULT_U8BIT;
      value_u8bit := b2;
    end;
-   
+
   procedure proc_value_smallstring_mixed(b1: byte; s:tsmallstring; b2: byte);pascal;
    begin
      if s = RESULT_SMALLSTRING then
        global_u8bit := RESULT_u8BIT;
      value_u8bit := b2;
    end;
-    
+
 
   procedure proc_value_bigstring_mixed(b1: byte; s:shortstring; b2: byte);pascal;
    begin
@@ -501,7 +509,7 @@ var
        global_u8bit := RESULT_u8BIT;
      value_u8bit := b2;
    end;
-   
+
 
   procedure proc_value_smallarray_mixed(b1: byte; arr : tsmallarray; b2: byte);pascal;
   begin
@@ -509,7 +517,7 @@ var
       global_u8bit := RESULT_U8BIT;
      value_u8bit := b2;
   end;
-  
+
   procedure proc_value_smallarray_open_mixed(b1: byte; arr : array of byte; b2: byte);pascal;
   begin
     { form 0 to N-1 indexes in open arrays }
@@ -518,7 +526,7 @@ var
      value_u8bit := b2;
   end;
 
-{$ifdef fpc}
+{$ifndef tp}
   procedure proc_value_classrefdef_mixed(b1: byte; obj : tclass1; b2: byte);pascal;
    begin
      global_class:=obj;
@@ -532,18 +540,18 @@ var
      value_u8bit := b2;
    end;
 
-  
+
   procedure proc_value_smallarray_const_1_mixed(b1: byte; arr : array of const; b2: byte);pascal;
   var
    i: integer;
   begin
     for i:=0 to high(arr) do
      begin
-       case arr[i].vtype of 
+       case arr[i].vtype of
         vtInteger : global_u8bit := arr[i].vinteger and $ff;
         vtBoolean : global_boolean := arr[i].vboolean;
         vtChar : global_char := arr[i].vchar;
-        vtExtended : global_s64real := arr[i].VExtended^; 
+        vtExtended : global_s64real := arr[i].VExtended^;
         vtString :  global_bigstring := arr[i].VString^;
         vtPointer : ;
         vtPChar : global_ptr := arr[i].VPchar;
@@ -557,7 +565,7 @@ var
      end; {endfor}
      value_u8bit := b2;
   end;
-  
+
 
   procedure proc_value_smallarray_const_2_mixed(b1: byte; arr : array of const; b2: byte);pascal;
   var
@@ -569,7 +577,7 @@ var
   end;
 {$endif}
 
- 
+
 
 var
  failed: boolean;
@@ -577,9 +585,9 @@ Begin
   {***************************** NORMAL TESTS *******************************}
   clear_globals;
   clear_values;
-  
+
   failed:=false;
-  
+
   { LOC_REGISTER }
   write('Value parameter test (src : LOC_REGISTER)...');
   proc_value_u8bit(getu8bit);
@@ -591,7 +599,7 @@ Begin
   proc_value_s32bit(gets32bit);
   if global_s32bit <> RESULT_S32BIT then
     failed:=true;
-{$ifdef fpc}
+{$ifndef tp}
   proc_value_s64bit(gets64bit);
   if global_s64bit <> RESULT_S64BIT then
     failed:=true;
@@ -600,9 +608,9 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
-    
-  { LOC_FPUREGISTER }  
+
+
+  { LOC_FPUREGISTER }
   clear_globals;
   clear_values;
   failed:=false;
@@ -617,22 +625,22 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
 
-  { LOC_MEM, LOC_REFERENCE orddef } 
+
+  { LOC_MEM, LOC_REFERENCE orddef }
   clear_globals;
   clear_values;
   value_u8bit := RESULT_U8BIT;
   value_u16bit := RESULT_U16BIT;
   value_s32bit := RESULT_S32BIT;
-{$ifdef fpc}
+{$ifndef tp}
   value_s64bit := RESULT_S64BIT;
 {$endif}
   value_s32real := RESULT_S32REAL;
   value_s64real  := RESULT_S64REAL;
 
   failed:=false;
-  
+
   { LOC_REFERENCE }
   write('Value parameter test (src : LOC_REFERENCE (orddef/enumdef)))...');
   proc_value_u8bit(value_u8bit);
@@ -644,7 +652,7 @@ Begin
   proc_value_s32bit(value_s32bit);
   if global_s32bit <> RESULT_S32BIT then
     failed:=true;
-{$ifdef fpc}
+{$ifndef tp}
   proc_value_s64bit(value_s64bit);
   if global_s64bit <> RESULT_S64BIT then
     failed:=true;
@@ -653,9 +661,9 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
-    
-  { LOC_REFERENCE }  
+
+
+  { LOC_REFERENCE }
   clear_globals;
   failed:=false;
   write('Value parameter test (src : LOC_REFERENCE (floatdef))...');
@@ -669,7 +677,7 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
+
 
 
   write('Value parameter test (src : LOC_REFERENCE (pointer))...');
@@ -682,12 +690,12 @@ Begin
     failed := true;
 
 
-  value_proc := {$ifdef fpc}@{$endif}testprocedure;
+  value_proc := {$ifndef tp}@{$endif}testprocedure;
   proc_value_procvardef(value_proc);
   if {$ifndef fpc}@{$endif}value_proc <> {$ifndef fpc}@{$endif}global_proc then
     failed := true;
 
-{$ifdef fpc}
+{$ifndef tp}
   value_class := tclass1.create;
   proc_value_classrefdef(value_class);
   if value_class <> global_class then
@@ -711,7 +719,7 @@ Begin
   proc_value_bool8bit(value_u8bit = 0);
   if global_u8bit <> RESULT_BOOL8BIT then
     failed:=true;
-{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x 
+{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x
   proc_value_bool16bit(value_s64bit < 0);
   if global_u16bit <> RESULT_BOOL16BIT then
     failed:=true;
@@ -725,7 +733,7 @@ Begin
 
 
 
-{$ifdef fpc}
+{$ifndef tp}
   clear_globals;
   clear_values;
   failed:=false;
@@ -733,7 +741,7 @@ Begin
   proc_value_bool8bit(value_s64bit = 0);
   if global_u8bit <> RESULT_BOOL8BIT then
     failed:=true;
-{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x 
+{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x
   proc_value_bool16bit(value_s64bit < 0);
   if global_u16bit <> RESULT_BOOL16BIT then
     failed:=true;
@@ -769,38 +777,38 @@ Begin
   proc_value_largerecord(value_largerec);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
-    
-    
+
+
   write('Value parameter test (src : LOC_REFERENCE (setdef)))...');
   clear_globals;
   clear_values;
   failed := false;
-  
+
   value_smallset := [A_A,A_D];
   proc_value_smallset(value_smallset);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   value_largeset := ['I'];
   proc_value_largeset(value_largeset);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
 
-    
+
 
 
   write('Value parameter test (src : LOC_REFERENCE (stringdef)))...');
@@ -812,14 +820,14 @@ Begin
   proc_value_smallstring(value_smallstring);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   value_bigstring := RESULT_BIGSTRING;
   proc_value_bigstring(value_bigstring);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
@@ -829,14 +837,14 @@ Begin
 
   { open array by value with cdecl modifier!!!!!!!!!!!!!!!!!!!!!!!!!!!}
   { DON'T KNOW WHY/HOW TO TEST!!!!!                                   }
-  
-  
+
+
   write('Value parameter test (src : LOC_REFERENCE (arraydef)))...');
-  
+
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   fillchar(value_smallarray,sizeof(value_smallarray),#0);
   value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
   proc_value_smallarray(value_smallarray);
@@ -852,7 +860,7 @@ Begin
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
 
-{$ifdef fpc}
+{$ifndef tp}
   clear_globals;
   clear_values;
 
@@ -866,10 +874,10 @@ Begin
   value_s64real:=RESULT_S64REAL;
   proc_value_smallarray_const_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real,
     value_boolean,value_class]);
-  
+
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if global_char <> RESULT_CHAR then
     failed := true;
   if global_boolean <> RESULT_BOOLEAN then
@@ -901,9 +909,9 @@ Begin
   {***************************** MIXED  TESTS *******************************}
   clear_globals;
   clear_values;
-  
+
   failed:=false;
-  
+
   { LOC_REGISTER }
   write('Mixed value parameter test (src : LOC_REGISTER)...');
   proc_value_u8bit_mixed(byte(NOT RESULT_U8BIT),getu8bit,RESULT_U8BIT);
@@ -921,7 +929,7 @@ Begin
     failed:=true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-{$ifdef fpc}
+{$ifndef tp}
   proc_value_s64bit_mixed(byte(NOT RESULT_U8BIT),gets64bit,RESULT_U8BIT);
   if global_s64bit <> RESULT_S64BIT then
     failed:=true;
@@ -933,9 +941,9 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
-    
-  { LOC_FPUREGISTER }  
+
+
+  { LOC_FPUREGISTER }
   clear_globals;
   clear_values;
   failed:=false;
@@ -954,22 +962,22 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
 
-  { LOC_MEM, LOC_REFERENCE orddef } 
+
+  { LOC_MEM, LOC_REFERENCE orddef }
   clear_globals;
   clear_values;
   value_u8bit := RESULT_U8BIT;
   value_u16bit := RESULT_U16BIT;
   value_s32bit := RESULT_S32BIT;
-{$ifdef fpc}
+{$ifndef tp}
   value_s64bit := RESULT_S64BIT;
 {$endif}
   value_s32real := RESULT_S32REAL;
   value_s64real  := RESULT_S64REAL;
 
   failed:=false;
-  
+
   { LOC_REFERENCE }
   write('Mixed value parameter test (src : LOC_REFERENCE (orddef/enumdef)))...');
   proc_value_u8bit_mixed(byte(NOT RESULT_U8BIT),value_u8bit, RESULT_U8BIT);
@@ -987,7 +995,7 @@ Begin
     failed:=true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-{$ifdef fpc}
+{$ifndef tp}
   proc_value_s64bit_mixed(byte(NOT RESULT_U8BIT), value_s64bit, RESULT_U8BIT);
   if global_s64bit <> RESULT_S64BIT then
     failed:=true;
@@ -999,9 +1007,9 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
-    
-  { LOC_REFERENCE }  
+
+
+  { LOC_REFERENCE }
   clear_globals;
   failed:=false;
   write('Mixed value parameter test (src : LOC_REFERENCE (floatdef))...');
@@ -1020,7 +1028,7 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
+
 
 
   write('Mixed value parameter test (src : LOC_REFERENCE (pointer))...');
@@ -1035,12 +1043,12 @@ Begin
     failed := true;
 
 
-  value_proc := {$ifdef fpc}@{$endif}testprocedure;
+  value_proc := {$ifndef tp}@{$endif}testprocedure;
   proc_value_procvardef_mixed(byte(NOT RESULT_U8BIT), value_proc, RESULT_U8BIT);
   if {$ifndef fpc}@{$endif}value_proc <> {$ifndef fpc}@{$endif}global_proc then
     failed := true;
 
-{$ifdef fpc}
+{$ifndef tp}
   value_class := tclass1.create;
   proc_value_classrefdef_mixed(byte(NOT RESULT_U8BIT), value_class, RESULT_U8BIT);
   if value_class <> global_class then
@@ -1068,7 +1076,7 @@ Begin
     failed:=true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x 
+{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x
   proc_value_bool16bit(value_s64bit < 0);
   if global_u16bit <> RESULT_BOOL16BIT then
     failed:=true;
@@ -1081,8 +1089,8 @@ Begin
     WriteLn('Passed!');
 
 
-    
-{$ifdef fpc}
+
+{$ifndef tp}
   clear_globals;
   clear_values;
   failed:=false;
@@ -1092,7 +1100,7 @@ Begin
     failed:=true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x 
+{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x
   proc_value_bool16bit(value_s64bit < 0);
   if global_u16bit <> RESULT_BOOL16BIT then
     failed:=true;
@@ -1104,7 +1112,7 @@ Begin
   else
     WriteLn('Passed!');
 {$endif}
-     
+
   { arraydef,
     recorddef,
     objectdef,
@@ -1132,26 +1140,26 @@ Begin
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
-    
-    
+
+
   write('Mixed value parameter test (src : LOC_REFERENCE (setdef)))...');
   clear_globals;
   clear_values;
   failed := false;
-  
+
   value_smallset := [A_A,A_D];
   proc_value_smallset_mixed(byte(NOT RESULT_U8BIT), value_smallset, RESULT_U8BIT);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   value_largeset := ['I'];
@@ -1160,14 +1168,14 @@ Begin
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
 
-    
+
 
 
   write('Mixed value parameter test (src : LOC_REFERENCE (stringdef)))...');
@@ -1181,7 +1189,7 @@ Begin
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   value_bigstring := RESULT_BIGSTRING;
@@ -1190,7 +1198,7 @@ Begin
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
@@ -1200,14 +1208,14 @@ Begin
 
   { open array by value with cdecl modifier!!!!!!!!!!!!!!!!!!!!!!!!!!!}
   { DON'T KNOW WHY/HOW TO TEST!!!!!                                   }
-  
-  
+
+
   write('Mixed value parameter test (src : LOC_REFERENCE (arraydef)))...');
-  
+
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   fillchar(value_smallarray,sizeof(value_smallarray),#0);
   value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
   proc_value_smallarray_mixed(byte(NOT RESULT_U8BIT), value_smallarray, RESULT_U8BIT);
@@ -1227,7 +1235,7 @@ Begin
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
 
-{$ifdef fpc}
+{$ifndef tp}
   clear_globals;
   clear_values;
 
@@ -1244,10 +1252,10 @@ Begin
      RESULT_U8BIT);
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-  
+
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if global_char <> RESULT_CHAR then
     failed := true;
   if global_boolean <> RESULT_BOOLEAN then
@@ -1257,7 +1265,7 @@ Begin
   if global_bigstring <> RESULT_SMALLSTRING then
      failed := true;
   if global_ptr <> value_ptr then
-     failed := true; 
+     failed := true;
 {  if value_class <> global_class then
      failed := true;!!!!!!!!!!!!!!!!!!!!}
   if global_s64bit <> RESULT_S64BIT then
@@ -1277,13 +1285,16 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
+
 end.
 
 
 {
   $Log$
-  Revision 1.1  2002-04-13 17:49:45  carl
+  Revision 1.2  2002-05-13 13:45:37  peter
+    * updated to compile tests with kylix
+
+  Revision 1.1  2002/04/13 17:49:45  carl
   + value parameter passing for different calling conventions
 
   Revision 1.1  2002/04/10 16:33:18  carl

tests/test/cg/tcalval4.pp

@@ -26,6 +26,9 @@ program tcalval4;
 {$R+}
 {$P-}
 
+{$ifdef VER70}
+  {$define tp}
+{$endif}
 
 
  { REAL should map to single or double }
@@ -36,11 +39,16 @@ program tcalval4;
 
  const
 { should be defined depending on CPU target }
-{$ifdef cpu68k}
-  BIG_INDEX = 8000;
-  SMALL_INDEX  = 13;
-{$endif}
-{$ifdef cpu86}
+{$ifdef fpc}
+  {$ifdef cpu68k}
+    BIG_INDEX = 8000;
+    SMALL_INDEX  = 13;
+  {$endif}
+  {$ifdef cpui386}
+    BIG_INDEX = 33000;
+    SMALL_INDEX = 13;     { value should not be aligned! }
+  {$endif}
+{$else}
   BIG_INDEX = 33000;
   SMALL_INDEX = 13;     { value should not be aligned! }
 {$endif}
@@ -58,40 +66,40 @@ program tcalval4;
   RESULT_SMALLSTRING = 'H';
   RESULT_CHAR = 'I';
   RESULT_BOOLEAN = TRUE;
-  
+
 type
-{$ifdef fpc}
+{$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;
-  
+
   tsmallarray = packed array[1..SMALL_INDEX] of byte;
-  
-  tsmallsetenum = 
+
+  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;
@@ -103,7 +111,7 @@ var
  global_bigstring : shortstring;
  global_boolean : boolean;
  global_char : char;
-{$ifdef fpc}
+{$ifndef tp}
  global_class : tclass1;
  global_s64bit : int64;
  value_s64bit : int64;
@@ -125,14 +133,14 @@ var
  value_smallarray : tsmallarray;
  value_boolean : boolean;
  value_char : char;
- 
+
     procedure fail;
     begin
       WriteLn('Failure.');
       halt(1);
     end;
-    
-    
+
+
     procedure clear_globals;
      begin
       global_u8bit := 0;
@@ -145,13 +153,13 @@ var
       global_bigstring := '';
       global_boolean := false;
       global_char := #0;
-{$ifdef fpc}
+{$ifndef tp}
       global_s64bit := 0;
       global_class := nil;
 {$endif}
      end;
-     
-     
+
+
     procedure clear_values;
      begin
       value_u8bit := 0;
@@ -170,37 +178,37 @@ var
       fillchar(value_smallarray, sizeof(value_smallarray), #0);
       value_boolean := false;
       value_char:=#0;
-{$ifdef fpc}
+{$ifndef tp}
       value_s64bit := 0;
       value_class := nil;
 {$endif}
      end;
 
-   
+
   procedure testprocedure;
    begin
    end;
- 
+
    function getu8bit : byte;
     begin
       getu8bit:=RESULT_U8BIT;
     end;
-    
+
    function getu16bit: word;
      begin
        getu16bit:=RESULT_U16BIT;
      end;
-     
+
    function gets32bit: longint;
     begin
       gets32bit:=RESULT_S32BIT;
     end;
-    
+
    function gets64bit: longint;
     begin
       gets64bit:=RESULT_S32BIT;
     end;
- 
+
 
    function gets32real: single;
     begin
@@ -234,8 +242,8 @@ var
    end;
 
 
-   
-   
+
+
   procedure proc_value_bool8bit(v: boolean);cdecl;
    begin
      { boolean should be 8-bit always! }
@@ -260,13 +268,13 @@ var
    begin
      global_s32real := v;
    end;
-   
+
   procedure proc_value_s64real(v: double);cdecl;
    begin
      global_s64real:= v;
    end;
-   
-   
+
+
   procedure proc_value_pointerdef(p : pchar);cdecl;
    begin
      global_ptr:=p;
@@ -277,23 +285,23 @@ var
    begin
      global_proc:=p;
    end;
-   
-   
 
-   
+
+
+
   procedure proc_value_smallrecord(smallrec : tsmallrecord);cdecl;
    begin
      if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then
        global_u8bit := RESULT_U8BIT;
    end;
-   
+
 
   procedure proc_value_largerecord(largerec : tlargerecord);cdecl;
    begin
      if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then
        global_u8bit := RESULT_U8BIT;
    end;
-   
+
   procedure proc_value_smallset(smallset : tsmallset);cdecl;
    begin
      if A_D in smallset then
@@ -306,13 +314,13 @@ var
      if 'I' in largeset then
        global_u8bit := RESULT_U8BIT;
    end;
-   
+
   procedure proc_value_smallstring(s:tsmallstring);cdecl;
    begin
      if s = RESULT_SMALLSTRING then
        global_u8bit := RESULT_u8BIT;
    end;
-    
+
 
   procedure proc_value_bigstring(s:shortstring);cdecl;
    begin
@@ -326,7 +334,7 @@ var
     if arr[SMALL_INDEX] = RESULT_U8BIT then
       global_u8bit := RESULT_U8BIT;
   end;
-  
+
   procedure proc_value_smallarray_open(arr : array of byte);cdecl;
   begin
     { form 0 to N-1 indexes in open arrays }
@@ -334,7 +342,7 @@ var
       global_u8bit := RESULT_U8BIT;
   end;
 
-{$ifdef fpc}
+{$ifndef tp}
   procedure proc_value_classrefdef(obj : tclass1);cdecl;
    begin
      global_class:=obj;
@@ -347,11 +355,11 @@ var
   begin
     for i:=0 to high(arr) do
      begin
-       case arr[i].vtype of 
+       case arr[i].vtype of
         vtInteger : global_u8bit := arr[i].vinteger and $ff;
         vtBoolean : global_boolean := arr[i].vboolean;
         vtChar : global_char := arr[i].vchar;
-        vtExtended : global_s64real := arr[i].VExtended^; 
+        vtExtended : global_s64real := arr[i].VExtended^;
         vtString :  global_bigstring := arr[i].VString^;
         vtPointer : ;
         vtPChar : global_ptr := arr[i].VPchar;
@@ -364,7 +372,7 @@ var
        end;
      end; {endfor}
   end;
-  
+
 
   procedure proc_value_smallarray_const_2(arr : array of const);cdecl;
   var
@@ -381,7 +389,7 @@ var
 {$endif}
 
  {********************************* MIXED PARAMETERS *************************}
- 
+
   procedure proc_value_u8bit_mixed(b1 : byte; v: byte; b2: byte);cdecl;
    begin
      global_u8bit := v;
@@ -401,10 +409,10 @@ var
      global_s32bit := v;
      value_u8bit := b2;
    end;
-   
 
-   
-   
+
+
+
   procedure proc_value_bool8bit_mixed(b1: byte; v: boolean; b2: byte);cdecl;
    begin
      { boolean should be 8-bit always! }
@@ -433,14 +441,14 @@ var
      global_s32real := v;
      value_u8bit := b2;
    end;
-   
+
   procedure proc_value_s64real_mixed(b1: byte; v: double; b2: byte);cdecl;
    begin
      global_s64real:= v;
      value_u8bit := b2;
    end;
-   
-   
+
+
   procedure proc_value_pointerdef_mixed(b1: byte; p : pchar; b2: byte);cdecl;
    begin
      global_ptr:=p;
@@ -453,8 +461,8 @@ var
      global_proc:=p;
      value_u8bit := b2;
    end;
-   
-   
+
+
 
 
   procedure proc_value_smallrecord_mixed(b1: byte; smallrec : tsmallrecord; b2: byte);cdecl;
@@ -463,7 +471,7 @@ var
        global_u8bit := RESULT_U8BIT;
      value_u8bit := b2;
    end;
-   
+
 
   procedure proc_value_largerecord_mixed(b1: byte; largerec : tlargerecord; b2: byte);cdecl;
    begin
@@ -471,14 +479,14 @@ var
        global_u8bit := RESULT_U8BIT;
      value_u8bit := b2;
    end;
-   
+
   procedure proc_value_smallset_mixed(b1: byte; smallset : tsmallset; b2: byte);cdecl;
    begin
      if A_D in smallset then
        global_u8bit := RESULT_U8BIT;
      value_u8bit := b2;
    end;
-   
+
 
   procedure proc_value_largeset_mixed(b1: byte; largeset : tlargeset; b2: byte);cdecl;
    begin
@@ -486,14 +494,14 @@ var
        global_u8bit := RESULT_U8BIT;
      value_u8bit := b2;
    end;
-   
+
   procedure proc_value_smallstring_mixed(b1: byte; s:tsmallstring; b2: byte);cdecl;
    begin
      if s = RESULT_SMALLSTRING then
        global_u8bit := RESULT_u8BIT;
      value_u8bit := b2;
    end;
-    
+
 
   procedure proc_value_bigstring_mixed(b1: byte; s:shortstring; b2: byte);cdecl;
    begin
@@ -501,7 +509,7 @@ var
        global_u8bit := RESULT_u8BIT;
      value_u8bit := b2;
    end;
-   
+
 
   procedure proc_value_smallarray_mixed(b1: byte; arr : tsmallarray; b2: byte);cdecl;
   begin
@@ -509,7 +517,7 @@ var
       global_u8bit := RESULT_U8BIT;
      value_u8bit := b2;
   end;
-  
+
   procedure proc_value_smallarray_open_mixed(b1: byte; arr : array of byte; b2: byte);cdecl;
   begin
     { form 0 to N-1 indexes in open arrays }
@@ -518,7 +526,7 @@ var
      value_u8bit := b2;
   end;
 
-{$ifdef fpc}
+{$ifndef tp}
   procedure proc_value_classrefdef_mixed(b1: byte; obj : tclass1; b2: byte);cdecl;
    begin
      global_class:=obj;
@@ -532,18 +540,18 @@ var
      value_u8bit := b2;
    end;
 
-  
+
   procedure proc_value_smallarray_const_1_mixed(b1: byte; arr : array of const; b2: byte);cdecl;
   var
    i: integer;
   begin
     for i:=0 to high(arr) do
      begin
-       case arr[i].vtype of 
+       case arr[i].vtype of
         vtInteger : global_u8bit := arr[i].vinteger and $ff;
         vtBoolean : global_boolean := arr[i].vboolean;
         vtChar : global_char := arr[i].vchar;
-        vtExtended : global_s64real := arr[i].VExtended^; 
+        vtExtended : global_s64real := arr[i].VExtended^;
         vtString :  global_bigstring := arr[i].VString^;
         vtPointer : ;
         vtPChar : global_ptr := arr[i].VPchar;
@@ -557,7 +565,7 @@ var
      end; {endfor}
      value_u8bit := b2;
   end;
-  
+
 
   procedure proc_value_smallarray_const_2_mixed(b1: byte; arr : array of const; b2: byte);cdecl;
   var
@@ -569,7 +577,7 @@ var
   end;
 {$endif}
 
- 
+
 
 var
  failed: boolean;
@@ -577,9 +585,9 @@ Begin
   {***************************** NORMAL TESTS *******************************}
   clear_globals;
   clear_values;
-  
+
   failed:=false;
-  
+
   { LOC_REGISTER }
   write('Value parameter test (src : LOC_REGISTER)...');
   proc_value_u8bit(getu8bit);
@@ -591,7 +599,7 @@ Begin
   proc_value_s32bit(gets32bit);
   if global_s32bit <> RESULT_S32BIT then
     failed:=true;
-{$ifdef fpc}
+{$ifndef tp}
   proc_value_s64bit(gets64bit);
   if global_s64bit <> RESULT_S64BIT then
     failed:=true;
@@ -600,9 +608,9 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
-    
-  { LOC_FPUREGISTER }  
+
+
+  { LOC_FPUREGISTER }
   clear_globals;
   clear_values;
   failed:=false;
@@ -617,22 +625,22 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
 
-  { LOC_MEM, LOC_REFERENCE orddef } 
+
+  { LOC_MEM, LOC_REFERENCE orddef }
   clear_globals;
   clear_values;
   value_u8bit := RESULT_U8BIT;
   value_u16bit := RESULT_U16BIT;
   value_s32bit := RESULT_S32BIT;
-{$ifdef fpc}
+{$ifndef tp}
   value_s64bit := RESULT_S64BIT;
 {$endif}
   value_s32real := RESULT_S32REAL;
   value_s64real  := RESULT_S64REAL;
 
   failed:=false;
-  
+
   { LOC_REFERENCE }
   write('Value parameter test (src : LOC_REFERENCE (orddef/enumdef)))...');
   proc_value_u8bit(value_u8bit);
@@ -644,7 +652,7 @@ Begin
   proc_value_s32bit(value_s32bit);
   if global_s32bit <> RESULT_S32BIT then
     failed:=true;
-{$ifdef fpc}
+{$ifndef tp}
   proc_value_s64bit(value_s64bit);
   if global_s64bit <> RESULT_S64BIT then
     failed:=true;
@@ -653,9 +661,9 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
-    
-  { LOC_REFERENCE }  
+
+
+  { LOC_REFERENCE }
   clear_globals;
   failed:=false;
   write('Value parameter test (src : LOC_REFERENCE (floatdef))...');
@@ -669,7 +677,7 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
+
 
 
   write('Value parameter test (src : LOC_REFERENCE (pointer))...');
@@ -682,12 +690,12 @@ Begin
     failed := true;
 
 
-  value_proc := {$ifdef fpc}@{$endif}testprocedure;
+  value_proc := {$ifndef tp}@{$endif}testprocedure;
   proc_value_procvardef(value_proc);
   if {$ifndef fpc}@{$endif}value_proc <> {$ifndef fpc}@{$endif}global_proc then
     failed := true;
 
-{$ifdef fpc}
+{$ifndef tp}
   value_class := tclass1.create;
   proc_value_classrefdef(value_class);
   if value_class <> global_class then
@@ -711,7 +719,7 @@ Begin
   proc_value_bool8bit(value_u8bit = 0);
   if global_u8bit <> RESULT_BOOL8BIT then
     failed:=true;
-{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x 
+{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x
   proc_value_bool16bit(value_s64bit < 0);
   if global_u16bit <> RESULT_BOOL16BIT then
     failed:=true;
@@ -725,7 +733,7 @@ Begin
 
 
 
-{$ifdef fpc}
+{$ifndef tp}
   clear_globals;
   clear_values;
   failed:=false;
@@ -733,7 +741,7 @@ Begin
   proc_value_bool8bit(value_s64bit = 0);
   if global_u8bit <> RESULT_BOOL8BIT then
     failed:=true;
-{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x 
+{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x
   proc_value_bool16bit(value_s64bit < 0);
   if global_u16bit <> RESULT_BOOL16BIT then
     failed:=true;
@@ -769,38 +777,38 @@ Begin
   proc_value_largerecord(value_largerec);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
-    
-    
+
+
   write('Value parameter test (src : LOC_REFERENCE (setdef)))...');
   clear_globals;
   clear_values;
   failed := false;
-  
+
   value_smallset := [A_A,A_D];
   proc_value_smallset(value_smallset);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   value_largeset := ['I'];
   proc_value_largeset(value_largeset);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
 
-    
+
 
 
   write('Value parameter test (src : LOC_REFERENCE (stringdef)))...');
@@ -812,14 +820,14 @@ Begin
   proc_value_smallstring(value_smallstring);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   value_bigstring := RESULT_BIGSTRING;
   proc_value_bigstring(value_bigstring);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
@@ -829,14 +837,14 @@ Begin
 
   { open array by value with cdecl modifier!!!!!!!!!!!!!!!!!!!!!!!!!!!}
   { DON'T KNOW WHY/HOW TO TEST!!!!!                                   }
-  
-  
+
+
   write('Value parameter test (src : LOC_REFERENCE (arraydef)))...');
-  
+
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   fillchar(value_smallarray,sizeof(value_smallarray),#0);
   value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
   proc_value_smallarray(value_smallarray);
@@ -852,7 +860,7 @@ Begin
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
 
-{$ifdef fpc}
+{$ifndef tp}
   clear_globals;
   clear_values;
 
@@ -866,10 +874,10 @@ Begin
   value_s64real:=RESULT_S64REAL;
   proc_value_smallarray_const_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real,
     value_boolean,value_class]);
-  
+
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if global_char <> RESULT_CHAR then
     failed := true;
   if global_boolean <> RESULT_BOOLEAN then
@@ -901,9 +909,9 @@ Begin
   {***************************** MIXED  TESTS *******************************}
   clear_globals;
   clear_values;
-  
+
   failed:=false;
-  
+
   { LOC_REGISTER }
   write('Mixed value parameter test (src : LOC_REGISTER)...');
   proc_value_u8bit_mixed(byte(NOT RESULT_U8BIT),getu8bit,RESULT_U8BIT);
@@ -921,7 +929,7 @@ Begin
     failed:=true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-{$ifdef fpc}
+{$ifndef tp}
   proc_value_s64bit_mixed(byte(NOT RESULT_U8BIT),gets64bit,RESULT_U8BIT);
   if global_s64bit <> RESULT_S64BIT then
     failed:=true;
@@ -933,9 +941,9 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
-    
-  { LOC_FPUREGISTER }  
+
+
+  { LOC_FPUREGISTER }
   clear_globals;
   clear_values;
   failed:=false;
@@ -954,22 +962,22 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
 
-  { LOC_MEM, LOC_REFERENCE orddef } 
+
+  { LOC_MEM, LOC_REFERENCE orddef }
   clear_globals;
   clear_values;
   value_u8bit := RESULT_U8BIT;
   value_u16bit := RESULT_U16BIT;
   value_s32bit := RESULT_S32BIT;
-{$ifdef fpc}
+{$ifndef tp}
   value_s64bit := RESULT_S64BIT;
 {$endif}
   value_s32real := RESULT_S32REAL;
   value_s64real  := RESULT_S64REAL;
 
   failed:=false;
-  
+
   { LOC_REFERENCE }
   write('Mixed value parameter test (src : LOC_REFERENCE (orddef/enumdef)))...');
   proc_value_u8bit_mixed(byte(NOT RESULT_U8BIT),value_u8bit, RESULT_U8BIT);
@@ -987,7 +995,7 @@ Begin
     failed:=true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-{$ifdef fpc}
+{$ifndef tp}
   proc_value_s64bit_mixed(byte(NOT RESULT_U8BIT), value_s64bit, RESULT_U8BIT);
   if global_s64bit <> RESULT_S64BIT then
     failed:=true;
@@ -999,9 +1007,9 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
-    
-  { LOC_REFERENCE }  
+
+
+  { LOC_REFERENCE }
   clear_globals;
   failed:=false;
   write('Mixed value parameter test (src : LOC_REFERENCE (floatdef))...');
@@ -1020,7 +1028,7 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
+
 
 
   write('Mixed value parameter test (src : LOC_REFERENCE (pointer))...');
@@ -1035,12 +1043,12 @@ Begin
     failed := true;
 
 
-  value_proc := {$ifdef fpc}@{$endif}testprocedure;
+  value_proc := {$ifndef tp}@{$endif}testprocedure;
   proc_value_procvardef_mixed(byte(NOT RESULT_U8BIT), value_proc, RESULT_U8BIT);
   if {$ifndef fpc}@{$endif}value_proc <> {$ifndef fpc}@{$endif}global_proc then
     failed := true;
 
-{$ifdef fpc}
+{$ifndef tp}
   value_class := tclass1.create;
   proc_value_classrefdef_mixed(byte(NOT RESULT_U8BIT), value_class, RESULT_U8BIT);
   if value_class <> global_class then
@@ -1068,7 +1076,7 @@ Begin
     failed:=true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x 
+{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x
   proc_value_bool16bit(value_s64bit < 0);
   if global_u16bit <> RESULT_BOOL16BIT then
     failed:=true;
@@ -1081,8 +1089,8 @@ Begin
     WriteLn('Passed!');
 
 
-    
-{$ifdef fpc}
+
+{$ifndef tp}
   clear_globals;
   clear_values;
   failed:=false;
@@ -1092,7 +1100,7 @@ Begin
     failed:=true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x 
+{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x
   proc_value_bool16bit(value_s64bit < 0);
   if global_u16bit <> RESULT_BOOL16BIT then
     failed:=true;
@@ -1104,7 +1112,7 @@ Begin
   else
     WriteLn('Passed!');
 {$endif}
-     
+
   { arraydef,
     recorddef,
     objectdef,
@@ -1132,26 +1140,26 @@ Begin
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
-    
-    
+
+
   write('Mixed value parameter test (src : LOC_REFERENCE (setdef)))...');
   clear_globals;
   clear_values;
   failed := false;
-  
+
   value_smallset := [A_A,A_D];
   proc_value_smallset_mixed(byte(NOT RESULT_U8BIT), value_smallset, RESULT_U8BIT);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   value_largeset := ['I'];
@@ -1160,14 +1168,14 @@ Begin
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
 
-    
+
 
 
   write('Mixed value parameter test (src : LOC_REFERENCE (stringdef)))...');
@@ -1181,7 +1189,7 @@ Begin
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   value_bigstring := RESULT_BIGSTRING;
@@ -1190,7 +1198,7 @@ Begin
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
@@ -1200,14 +1208,14 @@ Begin
 
   { open array by value with cdecl modifier!!!!!!!!!!!!!!!!!!!!!!!!!!!}
   { DON'T KNOW WHY/HOW TO TEST!!!!!                                   }
-  
-  
+
+
   write('Mixed value parameter test (src : LOC_REFERENCE (arraydef)))...');
-  
+
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   fillchar(value_smallarray,sizeof(value_smallarray),#0);
   value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
   proc_value_smallarray_mixed(byte(NOT RESULT_U8BIT), value_smallarray, RESULT_U8BIT);
@@ -1227,7 +1235,7 @@ Begin
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
 
-{$ifdef fpc}
+{$ifndef tp}
   clear_globals;
   clear_values;
 
@@ -1244,10 +1252,10 @@ Begin
      RESULT_U8BIT);
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-  
+
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if global_char <> RESULT_CHAR then
     failed := true;
   if global_boolean <> RESULT_BOOLEAN then
@@ -1257,7 +1265,7 @@ Begin
   if global_bigstring <> RESULT_SMALLSTRING then
      failed := true;
   if global_ptr <> value_ptr then
-     failed := true; 
+     failed := true;
 {  if value_class <> global_class then
      failed := true;!!!!!!!!!!!!!!!!!!!!}
   if global_s64bit <> RESULT_S64BIT then
@@ -1277,13 +1285,16 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
+
 end.
 
 
 {
   $Log$
-  Revision 1.1  2002-04-13 17:49:45  carl
+  Revision 1.2  2002-05-13 13:45:37  peter
+    * updated to compile tests with kylix
+
+  Revision 1.1  2002/04/13 17:49:45  carl
   + value parameter passing for different calling conventions
 
 }

tests/test/cg/tcalval5.pp

@@ -26,6 +26,9 @@ program tcalval5;
 {$R+}
 {$P-}
 
+{$ifdef VER70}
+  {$define tp}
+{$endif}
 
 
  { REAL should map to single or double }
@@ -36,11 +39,16 @@ program tcalval5;
 
  const
 { should be defined depending on CPU target }
-{$ifdef cpu68k}
-  BIG_INDEX = 8000;
-  SMALL_INDEX  = 13;
-{$endif}
-{$ifdef cpu86}
+{$ifdef fpc}
+  {$ifdef cpu68k}
+    BIG_INDEX = 8000;
+    SMALL_INDEX  = 13;
+  {$endif}
+  {$ifdef cpui386}
+    BIG_INDEX = 33000;
+    SMALL_INDEX = 13;     { value should not be aligned! }
+  {$endif}
+{$else}
   BIG_INDEX = 33000;
   SMALL_INDEX = 13;     { value should not be aligned! }
 {$endif}
@@ -58,40 +66,40 @@ program tcalval5;
   RESULT_SMALLSTRING = 'H';
   RESULT_CHAR = 'I';
   RESULT_BOOLEAN = TRUE;
-  
+
 type
-{$ifdef fpc}
+{$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;
-  
+
   tsmallarray = packed array[1..SMALL_INDEX] of byte;
-  
-  tsmallsetenum = 
+
+  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;
@@ -103,7 +111,7 @@ var
  global_bigstring : shortstring;
  global_boolean : boolean;
  global_char : char;
-{$ifdef fpc}
+{$ifndef tp}
  global_class : tclass1;
  global_s64bit : int64;
  value_s64bit : int64;
@@ -125,14 +133,14 @@ var
  value_smallarray : tsmallarray;
  value_boolean : boolean;
  value_char : char;
- 
+
     procedure fail;
     begin
       WriteLn('Failure.');
       halt(1);
     end;
-    
-    
+
+
     procedure clear_globals;
      begin
       global_u8bit := 0;
@@ -145,13 +153,13 @@ var
       global_bigstring := '';
       global_boolean := false;
       global_char := #0;
-{$ifdef fpc}
+{$ifndef tp}
       global_s64bit := 0;
       global_class := nil;
 {$endif}
      end;
-     
-     
+
+
     procedure clear_values;
      begin
       value_u8bit := 0;
@@ -170,37 +178,37 @@ var
       fillchar(value_smallarray, sizeof(value_smallarray), #0);
       value_boolean := false;
       value_char:=#0;
-{$ifdef fpc}
+{$ifndef tp}
       value_s64bit := 0;
       value_class := nil;
 {$endif}
      end;
 
-   
+
   procedure testprocedure;
    begin
    end;
- 
+
    function getu8bit : byte;
     begin
       getu8bit:=RESULT_U8BIT;
     end;
-    
+
    function getu16bit: word;
      begin
        getu16bit:=RESULT_U16BIT;
      end;
-     
+
    function gets32bit: longint;
     begin
       gets32bit:=RESULT_S32BIT;
     end;
-    
+
    function gets64bit: longint;
     begin
       gets64bit:=RESULT_S32BIT;
     end;
- 
+
 
    function gets32real: single;
     begin
@@ -234,8 +242,8 @@ var
    end;
 
 
-   
-   
+
+
   procedure proc_value_bool8bit(v: boolean);popstack;
    begin
      { boolean should be 8-bit always! }
@@ -260,13 +268,13 @@ var
    begin
      global_s32real := v;
    end;
-   
+
   procedure proc_value_s64real(v: double);popstack;
    begin
      global_s64real:= v;
    end;
-   
-   
+
+
   procedure proc_value_pointerdef(p : pchar);popstack;
    begin
      global_ptr:=p;
@@ -277,23 +285,23 @@ var
    begin
      global_proc:=p;
    end;
-   
-   
 
-   
+
+
+
   procedure proc_value_smallrecord(smallrec : tsmallrecord);popstack;
    begin
      if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then
        global_u8bit := RESULT_U8BIT;
    end;
-   
+
 
   procedure proc_value_largerecord(largerec : tlargerecord);popstack;
    begin
      if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then
        global_u8bit := RESULT_U8BIT;
    end;
-   
+
   procedure proc_value_smallset(smallset : tsmallset);popstack;
    begin
      if A_D in smallset then
@@ -306,13 +314,13 @@ var
      if 'I' in largeset then
        global_u8bit := RESULT_U8BIT;
    end;
-   
+
   procedure proc_value_smallstring(s:tsmallstring);popstack;
    begin
      if s = RESULT_SMALLSTRING then
        global_u8bit := RESULT_u8BIT;
    end;
-    
+
 
   procedure proc_value_bigstring(s:shortstring);popstack;
    begin
@@ -326,7 +334,7 @@ var
     if arr[SMALL_INDEX] = RESULT_U8BIT then
       global_u8bit := RESULT_U8BIT;
   end;
-  
+
   procedure proc_value_smallarray_open(arr : array of byte);popstack;
   begin
     { form 0 to N-1 indexes in open arrays }
@@ -334,7 +342,7 @@ var
       global_u8bit := RESULT_U8BIT;
   end;
 
-{$ifdef fpc}
+{$ifndef tp}
   procedure proc_value_classrefdef(obj : tclass1);popstack;
    begin
      global_class:=obj;
@@ -347,11 +355,11 @@ var
   begin
     for i:=0 to high(arr) do
      begin
-       case arr[i].vtype of 
+       case arr[i].vtype of
         vtInteger : global_u8bit := arr[i].vinteger and $ff;
         vtBoolean : global_boolean := arr[i].vboolean;
         vtChar : global_char := arr[i].vchar;
-        vtExtended : global_s64real := arr[i].VExtended^; 
+        vtExtended : global_s64real := arr[i].VExtended^;
         vtString :  global_bigstring := arr[i].VString^;
         vtPointer : ;
         vtPChar : global_ptr := arr[i].VPchar;
@@ -364,7 +372,7 @@ var
        end;
      end; {endfor}
   end;
-  
+
 
   procedure proc_value_smallarray_const_2(arr : array of const);popstack;
   var
@@ -381,7 +389,7 @@ var
 {$endif}
 
  {********************************* MIXED PARAMETERS *************************}
- 
+
   procedure proc_value_u8bit_mixed(b1 : byte; v: byte; b2: byte);popstack;
    begin
      global_u8bit := v;
@@ -401,10 +409,10 @@ var
      global_s32bit := v;
      value_u8bit := b2;
    end;
-   
 
-   
-   
+
+
+
   procedure proc_value_bool8bit_mixed(b1: byte; v: boolean; b2: byte);popstack;
    begin
      { boolean should be 8-bit always! }
@@ -433,14 +441,14 @@ var
      global_s32real := v;
      value_u8bit := b2;
    end;
-   
+
   procedure proc_value_s64real_mixed(b1: byte; v: double; b2: byte);popstack;
    begin
      global_s64real:= v;
      value_u8bit := b2;
    end;
-   
-   
+
+
   procedure proc_value_pointerdef_mixed(b1: byte; p : pchar; b2: byte);popstack;
    begin
      global_ptr:=p;
@@ -453,8 +461,8 @@ var
      global_proc:=p;
      value_u8bit := b2;
    end;
-   
-   
+
+
 
 
   procedure proc_value_smallrecord_mixed(b1: byte; smallrec : tsmallrecord; b2: byte);popstack;
@@ -463,7 +471,7 @@ var
        global_u8bit := RESULT_U8BIT;
      value_u8bit := b2;
    end;
-   
+
 
   procedure proc_value_largerecord_mixed(b1: byte; largerec : tlargerecord; b2: byte);popstack;
    begin
@@ -471,14 +479,14 @@ var
        global_u8bit := RESULT_U8BIT;
      value_u8bit := b2;
    end;
-   
+
   procedure proc_value_smallset_mixed(b1: byte; smallset : tsmallset; b2: byte);popstack;
    begin
      if A_D in smallset then
        global_u8bit := RESULT_U8BIT;
      value_u8bit := b2;
    end;
-   
+
 
   procedure proc_value_largeset_mixed(b1: byte; largeset : tlargeset; b2: byte);popstack;
    begin
@@ -486,14 +494,14 @@ var
        global_u8bit := RESULT_U8BIT;
      value_u8bit := b2;
    end;
-   
+
   procedure proc_value_smallstring_mixed(b1: byte; s:tsmallstring; b2: byte);popstack;
    begin
      if s = RESULT_SMALLSTRING then
        global_u8bit := RESULT_u8BIT;
      value_u8bit := b2;
    end;
-    
+
 
   procedure proc_value_bigstring_mixed(b1: byte; s:shortstring; b2: byte);popstack;
    begin
@@ -501,7 +509,7 @@ var
        global_u8bit := RESULT_u8BIT;
      value_u8bit := b2;
    end;
-   
+
 
   procedure proc_value_smallarray_mixed(b1: byte; arr : tsmallarray; b2: byte);popstack;
   begin
@@ -509,7 +517,7 @@ var
       global_u8bit := RESULT_U8BIT;
      value_u8bit := b2;
   end;
-  
+
   procedure proc_value_smallarray_open_mixed(b1: byte; arr : array of byte; b2: byte);popstack;
   begin
     { form 0 to N-1 indexes in open arrays }
@@ -518,7 +526,7 @@ var
      value_u8bit := b2;
   end;
 
-{$ifdef fpc}
+{$ifndef tp}
   procedure proc_value_classrefdef_mixed(b1: byte; obj : tclass1; b2: byte);popstack;
    begin
      global_class:=obj;
@@ -532,18 +540,18 @@ var
      value_u8bit := b2;
    end;
 
-  
+
   procedure proc_value_smallarray_const_1_mixed(b1: byte; arr : array of const; b2: byte);popstack;
   var
    i: integer;
   begin
     for i:=0 to high(arr) do
      begin
-       case arr[i].vtype of 
+       case arr[i].vtype of
         vtInteger : global_u8bit := arr[i].vinteger and $ff;
         vtBoolean : global_boolean := arr[i].vboolean;
         vtChar : global_char := arr[i].vchar;
-        vtExtended : global_s64real := arr[i].VExtended^; 
+        vtExtended : global_s64real := arr[i].VExtended^;
         vtString :  global_bigstring := arr[i].VString^;
         vtPointer : ;
         vtPChar : global_ptr := arr[i].VPchar;
@@ -557,7 +565,7 @@ var
      end; {endfor}
      value_u8bit := b2;
   end;
-  
+
 
   procedure proc_value_smallarray_const_2_mixed(b1: byte; arr : array of const; b2: byte);popstack;
   var
@@ -569,7 +577,7 @@ var
   end;
 {$endif}
 
- 
+
 
 var
  failed: boolean;
@@ -577,9 +585,9 @@ Begin
   {***************************** NORMAL TESTS *******************************}
   clear_globals;
   clear_values;
-  
+
   failed:=false;
-  
+
   { LOC_REGISTER }
   write('Value parameter test (src : LOC_REGISTER)...');
   proc_value_u8bit(getu8bit);
@@ -591,7 +599,7 @@ Begin
   proc_value_s32bit(gets32bit);
   if global_s32bit <> RESULT_S32BIT then
     failed:=true;
-{$ifdef fpc}
+{$ifndef tp}
   proc_value_s64bit(gets64bit);
   if global_s64bit <> RESULT_S64BIT then
     failed:=true;
@@ -600,9 +608,9 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
-    
-  { LOC_FPUREGISTER }  
+
+
+  { LOC_FPUREGISTER }
   clear_globals;
   clear_values;
   failed:=false;
@@ -617,22 +625,22 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
 
-  { LOC_MEM, LOC_REFERENCE orddef } 
+
+  { LOC_MEM, LOC_REFERENCE orddef }
   clear_globals;
   clear_values;
   value_u8bit := RESULT_U8BIT;
   value_u16bit := RESULT_U16BIT;
   value_s32bit := RESULT_S32BIT;
-{$ifdef fpc}
+{$ifndef tp}
   value_s64bit := RESULT_S64BIT;
 {$endif}
   value_s32real := RESULT_S32REAL;
   value_s64real  := RESULT_S64REAL;
 
   failed:=false;
-  
+
   { LOC_REFERENCE }
   write('Value parameter test (src : LOC_REFERENCE (orddef/enumdef)))...');
   proc_value_u8bit(value_u8bit);
@@ -644,7 +652,7 @@ Begin
   proc_value_s32bit(value_s32bit);
   if global_s32bit <> RESULT_S32BIT then
     failed:=true;
-{$ifdef fpc}
+{$ifndef tp}
   proc_value_s64bit(value_s64bit);
   if global_s64bit <> RESULT_S64BIT then
     failed:=true;
@@ -653,9 +661,9 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
-    
-  { LOC_REFERENCE }  
+
+
+  { LOC_REFERENCE }
   clear_globals;
   failed:=false;
   write('Value parameter test (src : LOC_REFERENCE (floatdef))...');
@@ -669,7 +677,7 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
+
 
 
   write('Value parameter test (src : LOC_REFERENCE (pointer))...');
@@ -682,12 +690,12 @@ Begin
     failed := true;
 
 
-  value_proc := {$ifdef fpc}@{$endif}testprocedure;
+  value_proc := {$ifndef tp}@{$endif}testprocedure;
   proc_value_procvardef(value_proc);
   if {$ifndef fpc}@{$endif}value_proc <> {$ifndef fpc}@{$endif}global_proc then
     failed := true;
 
-{$ifdef fpc}
+{$ifndef tp}
   value_class := tclass1.create;
   proc_value_classrefdef(value_class);
   if value_class <> global_class then
@@ -711,7 +719,7 @@ Begin
   proc_value_bool8bit(value_u8bit = 0);
   if global_u8bit <> RESULT_BOOL8BIT then
     failed:=true;
-{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x 
+{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x
   proc_value_bool16bit(value_s64bit < 0);
   if global_u16bit <> RESULT_BOOL16BIT then
     failed:=true;
@@ -725,7 +733,7 @@ Begin
 
 
 
-{$ifdef fpc}
+{$ifndef tp}
   clear_globals;
   clear_values;
   failed:=false;
@@ -733,7 +741,7 @@ Begin
   proc_value_bool8bit(value_s64bit = 0);
   if global_u8bit <> RESULT_BOOL8BIT then
     failed:=true;
-{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x 
+{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x
   proc_value_bool16bit(value_s64bit < 0);
   if global_u16bit <> RESULT_BOOL16BIT then
     failed:=true;
@@ -769,38 +777,38 @@ Begin
   proc_value_largerecord(value_largerec);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
-    
-    
+
+
   write('Value parameter test (src : LOC_REFERENCE (setdef)))...');
   clear_globals;
   clear_values;
   failed := false;
-  
+
   value_smallset := [A_A,A_D];
   proc_value_smallset(value_smallset);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   value_largeset := ['I'];
   proc_value_largeset(value_largeset);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
 
-    
+
 
 
   write('Value parameter test (src : LOC_REFERENCE (stringdef)))...');
@@ -812,14 +820,14 @@ Begin
   proc_value_smallstring(value_smallstring);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   value_bigstring := RESULT_BIGSTRING;
   proc_value_bigstring(value_bigstring);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
@@ -829,14 +837,14 @@ Begin
 
   { open array by value with cdecl modifier!!!!!!!!!!!!!!!!!!!!!!!!!!!}
   { DON'T KNOW WHY/HOW TO TEST!!!!!                                   }
-  
-  
+
+
   write('Value parameter test (src : LOC_REFERENCE (arraydef)))...');
-  
+
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   fillchar(value_smallarray,sizeof(value_smallarray),#0);
   value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
   proc_value_smallarray(value_smallarray);
@@ -852,7 +860,7 @@ Begin
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
 
-{$ifdef fpc}
+{$ifndef tp}
   clear_globals;
   clear_values;
 
@@ -866,10 +874,10 @@ Begin
   value_s64real:=RESULT_S64REAL;
   proc_value_smallarray_const_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real,
     value_boolean,value_class]);
-  
+
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if global_char <> RESULT_CHAR then
     failed := true;
   if global_boolean <> RESULT_BOOLEAN then
@@ -901,9 +909,9 @@ Begin
   {***************************** MIXED  TESTS *******************************}
   clear_globals;
   clear_values;
-  
+
   failed:=false;
-  
+
   { LOC_REGISTER }
   write('Mixed value parameter test (src : LOC_REGISTER)...');
   proc_value_u8bit_mixed(byte(NOT RESULT_U8BIT),getu8bit,RESULT_U8BIT);
@@ -921,7 +929,7 @@ Begin
     failed:=true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-{$ifdef fpc}
+{$ifndef tp}
   proc_value_s64bit_mixed(byte(NOT RESULT_U8BIT),gets64bit,RESULT_U8BIT);
   if global_s64bit <> RESULT_S64BIT then
     failed:=true;
@@ -933,9 +941,9 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
-    
-  { LOC_FPUREGISTER }  
+
+
+  { LOC_FPUREGISTER }
   clear_globals;
   clear_values;
   failed:=false;
@@ -954,22 +962,22 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
 
-  { LOC_MEM, LOC_REFERENCE orddef } 
+
+  { LOC_MEM, LOC_REFERENCE orddef }
   clear_globals;
   clear_values;
   value_u8bit := RESULT_U8BIT;
   value_u16bit := RESULT_U16BIT;
   value_s32bit := RESULT_S32BIT;
-{$ifdef fpc}
+{$ifndef tp}
   value_s64bit := RESULT_S64BIT;
 {$endif}
   value_s32real := RESULT_S32REAL;
   value_s64real  := RESULT_S64REAL;
 
   failed:=false;
-  
+
   { LOC_REFERENCE }
   write('Mixed value parameter test (src : LOC_REFERENCE (orddef/enumdef)))...');
   proc_value_u8bit_mixed(byte(NOT RESULT_U8BIT),value_u8bit, RESULT_U8BIT);
@@ -987,7 +995,7 @@ Begin
     failed:=true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-{$ifdef fpc}
+{$ifndef tp}
   proc_value_s64bit_mixed(byte(NOT RESULT_U8BIT), value_s64bit, RESULT_U8BIT);
   if global_s64bit <> RESULT_S64BIT then
     failed:=true;
@@ -999,9 +1007,9 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
-    
-  { LOC_REFERENCE }  
+
+
+  { LOC_REFERENCE }
   clear_globals;
   failed:=false;
   write('Mixed value parameter test (src : LOC_REFERENCE (floatdef))...');
@@ -1020,7 +1028,7 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
+
 
 
   write('Mixed value parameter test (src : LOC_REFERENCE (pointer))...');
@@ -1035,12 +1043,12 @@ Begin
     failed := true;
 
 
-  value_proc := {$ifdef fpc}@{$endif}testprocedure;
+  value_proc := {$ifndef tp}@{$endif}testprocedure;
   proc_value_procvardef_mixed(byte(NOT RESULT_U8BIT), value_proc, RESULT_U8BIT);
   if {$ifndef fpc}@{$endif}value_proc <> {$ifndef fpc}@{$endif}global_proc then
     failed := true;
 
-{$ifdef fpc}
+{$ifndef tp}
   value_class := tclass1.create;
   proc_value_classrefdef_mixed(byte(NOT RESULT_U8BIT), value_class, RESULT_U8BIT);
   if value_class <> global_class then
@@ -1068,7 +1076,7 @@ Begin
     failed:=true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x 
+{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x
   proc_value_bool16bit(value_s64bit < 0);
   if global_u16bit <> RESULT_BOOL16BIT then
     failed:=true;
@@ -1081,8 +1089,8 @@ Begin
     WriteLn('Passed!');
 
 
-    
-{$ifdef fpc}
+
+{$ifndef tp}
   clear_globals;
   clear_values;
   failed:=false;
@@ -1092,7 +1100,7 @@ Begin
     failed:=true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x 
+{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x
   proc_value_bool16bit(value_s64bit < 0);
   if global_u16bit <> RESULT_BOOL16BIT then
     failed:=true;
@@ -1104,7 +1112,7 @@ Begin
   else
     WriteLn('Passed!');
 {$endif}
-     
+
   { arraydef,
     recorddef,
     objectdef,
@@ -1132,26 +1140,26 @@ Begin
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
-    
-    
+
+
   write('Mixed value parameter test (src : LOC_REFERENCE (setdef)))...');
   clear_globals;
   clear_values;
   failed := false;
-  
+
   value_smallset := [A_A,A_D];
   proc_value_smallset_mixed(byte(NOT RESULT_U8BIT), value_smallset, RESULT_U8BIT);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   value_largeset := ['I'];
@@ -1160,14 +1168,14 @@ Begin
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
 
-    
+
 
 
   write('Mixed value parameter test (src : LOC_REFERENCE (stringdef)))...');
@@ -1181,7 +1189,7 @@ Begin
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   value_bigstring := RESULT_BIGSTRING;
@@ -1190,7 +1198,7 @@ Begin
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
@@ -1200,14 +1208,14 @@ Begin
 
   { open array by value with cdecl modifier!!!!!!!!!!!!!!!!!!!!!!!!!!!}
   { DON'T KNOW WHY/HOW TO TEST!!!!!                                   }
-  
-  
+
+
   write('Mixed value parameter test (src : LOC_REFERENCE (arraydef)))...');
-  
+
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   fillchar(value_smallarray,sizeof(value_smallarray),#0);
   value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
   proc_value_smallarray_mixed(byte(NOT RESULT_U8BIT), value_smallarray, RESULT_U8BIT);
@@ -1227,7 +1235,7 @@ Begin
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
 
-{$ifdef fpc}
+{$ifndef tp}
   clear_globals;
   clear_values;
 
@@ -1244,10 +1252,10 @@ Begin
      RESULT_U8BIT);
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-  
+
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if global_char <> RESULT_CHAR then
     failed := true;
   if global_boolean <> RESULT_BOOLEAN then
@@ -1257,7 +1265,7 @@ Begin
   if global_bigstring <> RESULT_SMALLSTRING then
      failed := true;
   if global_ptr <> value_ptr then
-     failed := true; 
+     failed := true;
 {  if value_class <> global_class then
      failed := true;!!!!!!!!!!!!!!!!!!!!}
   if global_s64bit <> RESULT_S64BIT then
@@ -1277,13 +1285,16 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
+
 end.
 
 
 {
   $Log$
-  Revision 1.1  2002-04-13 17:49:45  carl
+  Revision 1.2  2002-05-13 13:45:37  peter
+    * updated to compile tests with kylix
+
+  Revision 1.1  2002/04/13 17:49:45  carl
   + value parameter passing for different calling conventions
 
 }

tests/test/cg/tcalval6.pp

@@ -26,6 +26,9 @@ program tcalval6;
 {$R+}
 {$P-}
 
+{$ifdef VER70}
+  {$define tp}
+{$endif}
 
 
  { REAL should map to single or double }
@@ -36,11 +39,16 @@ program tcalval6;
 
  const
 { should be defined depending on CPU target }
-{$ifdef cpu68k}
-  BIG_INDEX = 8000;
-  SMALL_INDEX  = 13;
-{$endif}
-{$ifdef cpu86}
+{$ifdef fpc}
+  {$ifdef cpu68k}
+    BIG_INDEX = 8000;
+    SMALL_INDEX  = 13;
+  {$endif}
+  {$ifdef cpui386}
+    BIG_INDEX = 33000;
+    SMALL_INDEX = 13;     { value should not be aligned! }
+  {$endif}
+{$else}
   BIG_INDEX = 33000;
   SMALL_INDEX = 13;     { value should not be aligned! }
 {$endif}
@@ -58,40 +66,40 @@ program tcalval6;
   RESULT_SMALLSTRING = 'H';
   RESULT_CHAR = 'I';
   RESULT_BOOLEAN = TRUE;
-  
+
 type
-{$ifdef fpc}
+{$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;
-  
+
   tsmallarray = packed array[1..SMALL_INDEX] of byte;
-  
-  tsmallsetenum = 
+
+  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;
@@ -103,7 +111,7 @@ var
  global_bigstring : shortstring;
  global_boolean : boolean;
  global_char : char;
-{$ifdef fpc}
+{$ifndef tp}
  global_class : tclass1;
  global_s64bit : int64;
  value_s64bit : int64;
@@ -125,14 +133,14 @@ var
  value_smallarray : tsmallarray;
  value_boolean : boolean;
  value_char : char;
- 
+
     procedure fail;
     begin
       WriteLn('Failure.');
       halt(1);
     end;
-    
-    
+
+
     procedure clear_globals;
      begin
       global_u8bit := 0;
@@ -145,13 +153,13 @@ var
       global_bigstring := '';
       global_boolean := false;
       global_char := #0;
-{$ifdef fpc}
+{$ifndef tp}
       global_s64bit := 0;
       global_class := nil;
 {$endif}
      end;
-     
-     
+
+
     procedure clear_values;
      begin
       value_u8bit := 0;
@@ -170,37 +178,37 @@ var
       fillchar(value_smallarray, sizeof(value_smallarray), #0);
       value_boolean := false;
       value_char:=#0;
-{$ifdef fpc}
+{$ifndef tp}
       value_s64bit := 0;
       value_class := nil;
 {$endif}
      end;
 
-   
+
   procedure testprocedure;
    begin
    end;
- 
+
    function getu8bit : byte;
     begin
       getu8bit:=RESULT_U8BIT;
     end;
-    
+
    function getu16bit: word;
      begin
        getu16bit:=RESULT_U16BIT;
      end;
-     
+
    function gets32bit: longint;
     begin
       gets32bit:=RESULT_S32BIT;
     end;
-    
+
    function gets64bit: longint;
     begin
       gets64bit:=RESULT_S32BIT;
     end;
- 
+
 
    function gets32real: single;
     begin
@@ -234,8 +242,8 @@ var
    end;
 
 
-   
-   
+
+
   procedure proc_value_bool8bit(v: boolean);safecall;
    begin
      { boolean should be 8-bit always! }
@@ -260,13 +268,13 @@ var
    begin
      global_s32real := v;
    end;
-   
+
   procedure proc_value_s64real(v: double);safecall;
    begin
      global_s64real:= v;
    end;
-   
-   
+
+
   procedure proc_value_pointerdef(p : pchar);safecall;
    begin
      global_ptr:=p;
@@ -277,23 +285,23 @@ var
    begin
      global_proc:=p;
    end;
-   
-   
 
-   
+
+
+
   procedure proc_value_smallrecord(smallrec : tsmallrecord);safecall;
    begin
      if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then
        global_u8bit := RESULT_U8BIT;
    end;
-   
+
 
   procedure proc_value_largerecord(largerec : tlargerecord);safecall;
    begin
      if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then
        global_u8bit := RESULT_U8BIT;
    end;
-   
+
   procedure proc_value_smallset(smallset : tsmallset);safecall;
    begin
      if A_D in smallset then
@@ -306,13 +314,13 @@ var
      if 'I' in largeset then
        global_u8bit := RESULT_U8BIT;
    end;
-   
+
   procedure proc_value_smallstring(s:tsmallstring);safecall;
    begin
      if s = RESULT_SMALLSTRING then
        global_u8bit := RESULT_u8BIT;
    end;
-    
+
 
   procedure proc_value_bigstring(s:shortstring);safecall;
    begin
@@ -326,7 +334,7 @@ var
     if arr[SMALL_INDEX] = RESULT_U8BIT then
       global_u8bit := RESULT_U8BIT;
   end;
-  
+
   procedure proc_value_smallarray_open(arr : array of byte);safecall;
   begin
     { form 0 to N-1 indexes in open arrays }
@@ -334,7 +342,7 @@ var
       global_u8bit := RESULT_U8BIT;
   end;
 
-{$ifdef fpc}
+{$ifndef tp}
   procedure proc_value_classrefdef(obj : tclass1);safecall;
    begin
      global_class:=obj;
@@ -347,11 +355,11 @@ var
   begin
     for i:=0 to high(arr) do
      begin
-       case arr[i].vtype of 
+       case arr[i].vtype of
         vtInteger : global_u8bit := arr[i].vinteger and $ff;
         vtBoolean : global_boolean := arr[i].vboolean;
         vtChar : global_char := arr[i].vchar;
-        vtExtended : global_s64real := arr[i].VExtended^; 
+        vtExtended : global_s64real := arr[i].VExtended^;
         vtString :  global_bigstring := arr[i].VString^;
         vtPointer : ;
         vtPChar : global_ptr := arr[i].VPchar;
@@ -364,7 +372,7 @@ var
        end;
      end; {endfor}
   end;
-  
+
 
   procedure proc_value_smallarray_const_2(arr : array of const);safecall;
   var
@@ -381,7 +389,7 @@ var
 {$endif}
 
  {********************************* MIXED PARAMETERS *************************}
- 
+
   procedure proc_value_u8bit_mixed(b1 : byte; v: byte; b2: byte);safecall;
    begin
      global_u8bit := v;
@@ -401,10 +409,10 @@ var
      global_s32bit := v;
      value_u8bit := b2;
    end;
-   
 
-   
-   
+
+
+
   procedure proc_value_bool8bit_mixed(b1: byte; v: boolean; b2: byte);safecall;
    begin
      { boolean should be 8-bit always! }
@@ -433,14 +441,14 @@ var
      global_s32real := v;
      value_u8bit := b2;
    end;
-   
+
   procedure proc_value_s64real_mixed(b1: byte; v: double; b2: byte);safecall;
    begin
      global_s64real:= v;
      value_u8bit := b2;
    end;
-   
-   
+
+
   procedure proc_value_pointerdef_mixed(b1: byte; p : pchar; b2: byte);safecall;
    begin
      global_ptr:=p;
@@ -453,8 +461,8 @@ var
      global_proc:=p;
      value_u8bit := b2;
    end;
-   
-   
+
+
 
 
   procedure proc_value_smallrecord_mixed(b1: byte; smallrec : tsmallrecord; b2: byte);safecall;
@@ -463,7 +471,7 @@ var
        global_u8bit := RESULT_U8BIT;
      value_u8bit := b2;
    end;
-   
+
 
   procedure proc_value_largerecord_mixed(b1: byte; largerec : tlargerecord; b2: byte);safecall;
    begin
@@ -471,14 +479,14 @@ var
        global_u8bit := RESULT_U8BIT;
      value_u8bit := b2;
    end;
-   
+
   procedure proc_value_smallset_mixed(b1: byte; smallset : tsmallset; b2: byte);safecall;
    begin
      if A_D in smallset then
        global_u8bit := RESULT_U8BIT;
      value_u8bit := b2;
    end;
-   
+
 
   procedure proc_value_largeset_mixed(b1: byte; largeset : tlargeset; b2: byte);safecall;
    begin
@@ -486,14 +494,14 @@ var
        global_u8bit := RESULT_U8BIT;
      value_u8bit := b2;
    end;
-   
+
   procedure proc_value_smallstring_mixed(b1: byte; s:tsmallstring; b2: byte);safecall;
    begin
      if s = RESULT_SMALLSTRING then
        global_u8bit := RESULT_u8BIT;
      value_u8bit := b2;
    end;
-    
+
 
   procedure proc_value_bigstring_mixed(b1: byte; s:shortstring; b2: byte);safecall;
    begin
@@ -501,7 +509,7 @@ var
        global_u8bit := RESULT_u8BIT;
      value_u8bit := b2;
    end;
-   
+
 
   procedure proc_value_smallarray_mixed(b1: byte; arr : tsmallarray; b2: byte);safecall;
   begin
@@ -509,7 +517,7 @@ var
       global_u8bit := RESULT_U8BIT;
      value_u8bit := b2;
   end;
-  
+
   procedure proc_value_smallarray_open_mixed(b1: byte; arr : array of byte; b2: byte);safecall;
   begin
     { form 0 to N-1 indexes in open arrays }
@@ -518,7 +526,7 @@ var
      value_u8bit := b2;
   end;
 
-{$ifdef fpc}
+{$ifndef tp}
   procedure proc_value_classrefdef_mixed(b1: byte; obj : tclass1; b2: byte);safecall;
    begin
      global_class:=obj;
@@ -532,18 +540,18 @@ var
      value_u8bit := b2;
    end;
 
-  
+
   procedure proc_value_smallarray_const_1_mixed(b1: byte; arr : array of const; b2: byte);safecall;
   var
    i: integer;
   begin
     for i:=0 to high(arr) do
      begin
-       case arr[i].vtype of 
+       case arr[i].vtype of
         vtInteger : global_u8bit := arr[i].vinteger and $ff;
         vtBoolean : global_boolean := arr[i].vboolean;
         vtChar : global_char := arr[i].vchar;
-        vtExtended : global_s64real := arr[i].VExtended^; 
+        vtExtended : global_s64real := arr[i].VExtended^;
         vtString :  global_bigstring := arr[i].VString^;
         vtPointer : ;
         vtPChar : global_ptr := arr[i].VPchar;
@@ -557,7 +565,7 @@ var
      end; {endfor}
      value_u8bit := b2;
   end;
-  
+
 
   procedure proc_value_smallarray_const_2_mixed(b1: byte; arr : array of const; b2: byte);safecall;
   var
@@ -569,7 +577,7 @@ var
   end;
 {$endif}
 
- 
+
 
 var
  failed: boolean;
@@ -577,9 +585,9 @@ Begin
   {***************************** NORMAL TESTS *******************************}
   clear_globals;
   clear_values;
-  
+
   failed:=false;
-  
+
   { LOC_REGISTER }
   write('Value parameter test (src : LOC_REGISTER)...');
   proc_value_u8bit(getu8bit);
@@ -591,7 +599,7 @@ Begin
   proc_value_s32bit(gets32bit);
   if global_s32bit <> RESULT_S32BIT then
     failed:=true;
-{$ifdef fpc}
+{$ifndef tp}
   proc_value_s64bit(gets64bit);
   if global_s64bit <> RESULT_S64BIT then
     failed:=true;
@@ -600,9 +608,9 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
-    
-  { LOC_FPUREGISTER }  
+
+
+  { LOC_FPUREGISTER }
   clear_globals;
   clear_values;
   failed:=false;
@@ -617,22 +625,22 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
 
-  { LOC_MEM, LOC_REFERENCE orddef } 
+
+  { LOC_MEM, LOC_REFERENCE orddef }
   clear_globals;
   clear_values;
   value_u8bit := RESULT_U8BIT;
   value_u16bit := RESULT_U16BIT;
   value_s32bit := RESULT_S32BIT;
-{$ifdef fpc}
+{$ifndef tp}
   value_s64bit := RESULT_S64BIT;
 {$endif}
   value_s32real := RESULT_S32REAL;
   value_s64real  := RESULT_S64REAL;
 
   failed:=false;
-  
+
   { LOC_REFERENCE }
   write('Value parameter test (src : LOC_REFERENCE (orddef/enumdef)))...');
   proc_value_u8bit(value_u8bit);
@@ -644,7 +652,7 @@ Begin
   proc_value_s32bit(value_s32bit);
   if global_s32bit <> RESULT_S32BIT then
     failed:=true;
-{$ifdef fpc}
+{$ifndef tp}
   proc_value_s64bit(value_s64bit);
   if global_s64bit <> RESULT_S64BIT then
     failed:=true;
@@ -653,9 +661,9 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
-    
-  { LOC_REFERENCE }  
+
+
+  { LOC_REFERENCE }
   clear_globals;
   failed:=false;
   write('Value parameter test (src : LOC_REFERENCE (floatdef))...');
@@ -669,7 +677,7 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
+
 
 
   write('Value parameter test (src : LOC_REFERENCE (pointer))...');
@@ -682,12 +690,12 @@ Begin
     failed := true;
 
 
-  value_proc := {$ifdef fpc}@{$endif}testprocedure;
+  value_proc := {$ifndef tp}@{$endif}testprocedure;
   proc_value_procvardef(value_proc);
   if {$ifndef fpc}@{$endif}value_proc <> {$ifndef fpc}@{$endif}global_proc then
     failed := true;
 
-{$ifdef fpc}
+{$ifndef tp}
   value_class := tclass1.create;
   proc_value_classrefdef(value_class);
   if value_class <> global_class then
@@ -711,7 +719,7 @@ Begin
   proc_value_bool8bit(value_u8bit = 0);
   if global_u8bit <> RESULT_BOOL8BIT then
     failed:=true;
-{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x 
+{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x
   proc_value_bool16bit(value_s64bit < 0);
   if global_u16bit <> RESULT_BOOL16BIT then
     failed:=true;
@@ -725,7 +733,7 @@ Begin
 
 
 
-{$ifdef fpc}
+{$ifndef tp}
   clear_globals;
   clear_values;
   failed:=false;
@@ -733,7 +741,7 @@ Begin
   proc_value_bool8bit(value_s64bit = 0);
   if global_u8bit <> RESULT_BOOL8BIT then
     failed:=true;
-{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x 
+{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x
   proc_value_bool16bit(value_s64bit < 0);
   if global_u16bit <> RESULT_BOOL16BIT then
     failed:=true;
@@ -769,38 +777,38 @@ Begin
   proc_value_largerecord(value_largerec);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
-    
-    
+
+
   write('Value parameter test (src : LOC_REFERENCE (setdef)))...');
   clear_globals;
   clear_values;
   failed := false;
-  
+
   value_smallset := [A_A,A_D];
   proc_value_smallset(value_smallset);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   value_largeset := ['I'];
   proc_value_largeset(value_largeset);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
 
-    
+
 
 
   write('Value parameter test (src : LOC_REFERENCE (stringdef)))...');
@@ -812,14 +820,14 @@ Begin
   proc_value_smallstring(value_smallstring);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   value_bigstring := RESULT_BIGSTRING;
   proc_value_bigstring(value_bigstring);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
@@ -829,14 +837,14 @@ Begin
 
   { open array by value with cdecl modifier!!!!!!!!!!!!!!!!!!!!!!!!!!!}
   { DON'T KNOW WHY/HOW TO TEST!!!!!                                   }
-  
-  
+
+
   write('Value parameter test (src : LOC_REFERENCE (arraydef)))...');
-  
+
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   fillchar(value_smallarray,sizeof(value_smallarray),#0);
   value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
   proc_value_smallarray(value_smallarray);
@@ -852,7 +860,7 @@ Begin
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
 
-{$ifdef fpc}
+{$ifndef tp}
   clear_globals;
   clear_values;
 
@@ -866,10 +874,10 @@ Begin
   value_s64real:=RESULT_S64REAL;
   proc_value_smallarray_const_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real,
     value_boolean,value_class]);
-  
+
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if global_char <> RESULT_CHAR then
     failed := true;
   if global_boolean <> RESULT_BOOLEAN then
@@ -901,9 +909,9 @@ Begin
   {***************************** MIXED  TESTS *******************************}
   clear_globals;
   clear_values;
-  
+
   failed:=false;
-  
+
   { LOC_REGISTER }
   write('Mixed value parameter test (src : LOC_REGISTER)...');
   proc_value_u8bit_mixed(byte(NOT RESULT_U8BIT),getu8bit,RESULT_U8BIT);
@@ -921,7 +929,7 @@ Begin
     failed:=true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-{$ifdef fpc}
+{$ifndef tp}
   proc_value_s64bit_mixed(byte(NOT RESULT_U8BIT),gets64bit,RESULT_U8BIT);
   if global_s64bit <> RESULT_S64BIT then
     failed:=true;
@@ -933,9 +941,9 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
-    
-  { LOC_FPUREGISTER }  
+
+
+  { LOC_FPUREGISTER }
   clear_globals;
   clear_values;
   failed:=false;
@@ -954,22 +962,22 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
 
-  { LOC_MEM, LOC_REFERENCE orddef } 
+
+  { LOC_MEM, LOC_REFERENCE orddef }
   clear_globals;
   clear_values;
   value_u8bit := RESULT_U8BIT;
   value_u16bit := RESULT_U16BIT;
   value_s32bit := RESULT_S32BIT;
-{$ifdef fpc}
+{$ifndef tp}
   value_s64bit := RESULT_S64BIT;
 {$endif}
   value_s32real := RESULT_S32REAL;
   value_s64real  := RESULT_S64REAL;
 
   failed:=false;
-  
+
   { LOC_REFERENCE }
   write('Mixed value parameter test (src : LOC_REFERENCE (orddef/enumdef)))...');
   proc_value_u8bit_mixed(byte(NOT RESULT_U8BIT),value_u8bit, RESULT_U8BIT);
@@ -987,7 +995,7 @@ Begin
     failed:=true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-{$ifdef fpc}
+{$ifndef tp}
   proc_value_s64bit_mixed(byte(NOT RESULT_U8BIT), value_s64bit, RESULT_U8BIT);
   if global_s64bit <> RESULT_S64BIT then
     failed:=true;
@@ -999,9 +1007,9 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
-    
-  { LOC_REFERENCE }  
+
+
+  { LOC_REFERENCE }
   clear_globals;
   failed:=false;
   write('Mixed value parameter test (src : LOC_REFERENCE (floatdef))...');
@@ -1020,7 +1028,7 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
+
 
 
   write('Mixed value parameter test (src : LOC_REFERENCE (pointer))...');
@@ -1035,12 +1043,12 @@ Begin
     failed := true;
 
 
-  value_proc := {$ifdef fpc}@{$endif}testprocedure;
+  value_proc := {$ifndef tp}@{$endif}testprocedure;
   proc_value_procvardef_mixed(byte(NOT RESULT_U8BIT), value_proc, RESULT_U8BIT);
   if {$ifndef fpc}@{$endif}value_proc <> {$ifndef fpc}@{$endif}global_proc then
     failed := true;
 
-{$ifdef fpc}
+{$ifndef tp}
   value_class := tclass1.create;
   proc_value_classrefdef_mixed(byte(NOT RESULT_U8BIT), value_class, RESULT_U8BIT);
   if value_class <> global_class then
@@ -1068,7 +1076,7 @@ Begin
     failed:=true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x 
+{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x
   proc_value_bool16bit(value_s64bit < 0);
   if global_u16bit <> RESULT_BOOL16BIT then
     failed:=true;
@@ -1081,8 +1089,8 @@ Begin
     WriteLn('Passed!');
 
 
-    
-{$ifdef fpc}
+
+{$ifndef tp}
   clear_globals;
   clear_values;
   failed:=false;
@@ -1092,7 +1100,7 @@ Begin
     failed:=true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x 
+{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x
   proc_value_bool16bit(value_s64bit < 0);
   if global_u16bit <> RESULT_BOOL16BIT then
     failed:=true;
@@ -1104,7 +1112,7 @@ Begin
   else
     WriteLn('Passed!');
 {$endif}
-     
+
   { arraydef,
     recorddef,
     objectdef,
@@ -1132,26 +1140,26 @@ Begin
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
-    
-    
+
+
   write('Mixed value parameter test (src : LOC_REFERENCE (setdef)))...');
   clear_globals;
   clear_values;
   failed := false;
-  
+
   value_smallset := [A_A,A_D];
   proc_value_smallset_mixed(byte(NOT RESULT_U8BIT), value_smallset, RESULT_U8BIT);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   value_largeset := ['I'];
@@ -1160,14 +1168,14 @@ Begin
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
 
-    
+
 
 
   write('Mixed value parameter test (src : LOC_REFERENCE (stringdef)))...');
@@ -1181,7 +1189,7 @@ Begin
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   value_bigstring := RESULT_BIGSTRING;
@@ -1190,7 +1198,7 @@ Begin
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
@@ -1200,14 +1208,14 @@ Begin
 
   { open array by value with cdecl modifier!!!!!!!!!!!!!!!!!!!!!!!!!!!}
   { DON'T KNOW WHY/HOW TO TEST!!!!!                                   }
-  
-  
+
+
   write('Mixed value parameter test (src : LOC_REFERENCE (arraydef)))...');
-  
+
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   fillchar(value_smallarray,sizeof(value_smallarray),#0);
   value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
   proc_value_smallarray_mixed(byte(NOT RESULT_U8BIT), value_smallarray, RESULT_U8BIT);
@@ -1227,7 +1235,7 @@ Begin
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
 
-{$ifdef fpc}
+{$ifndef tp}
   clear_globals;
   clear_values;
 
@@ -1244,10 +1252,10 @@ Begin
      RESULT_U8BIT);
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-  
+
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if global_char <> RESULT_CHAR then
     failed := true;
   if global_boolean <> RESULT_BOOLEAN then
@@ -1257,7 +1265,7 @@ Begin
   if global_bigstring <> RESULT_SMALLSTRING then
      failed := true;
   if global_ptr <> value_ptr then
-     failed := true; 
+     failed := true;
 {  if value_class <> global_class then
      failed := true;!!!!!!!!!!!!!!!!!!!!}
   if global_s64bit <> RESULT_S64BIT then
@@ -1277,13 +1285,16 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
+
 end.
 
 
 {
   $Log$
-  Revision 1.1  2002-04-13 17:49:45  carl
+  Revision 1.2  2002-05-13 13:45:38  peter
+    * updated to compile tests with kylix
+
+  Revision 1.1  2002/04/13 17:49:45  carl
   + value parameter passing for different calling conventions
 
 }

tests/test/cg/tcalval7.pp

@@ -26,6 +26,9 @@ program tcalval7;
 {$R+}
 {$P-}
 
+{$ifdef VER70}
+  {$define tp}
+{$endif}
 
 
  { REAL should map to single or double }
@@ -36,11 +39,16 @@ program tcalval7;
 
  const
 { should be defined depending on CPU target }
-{$ifdef cpu68k}
-  BIG_INDEX = 8000;
-  SMALL_INDEX  = 13;
-{$endif}
-{$ifdef cpu86}
+{$ifdef fpc}
+  {$ifdef cpu68k}
+    BIG_INDEX = 8000;
+    SMALL_INDEX  = 13;
+  {$endif}
+  {$ifdef cpui386}
+    BIG_INDEX = 33000;
+    SMALL_INDEX = 13;     { value should not be aligned! }
+  {$endif}
+{$else}
   BIG_INDEX = 33000;
   SMALL_INDEX = 13;     { value should not be aligned! }
 {$endif}
@@ -58,40 +66,40 @@ program tcalval7;
   RESULT_SMALLSTRING = 'H';
   RESULT_CHAR = 'I';
   RESULT_BOOLEAN = TRUE;
-  
+
 type
-{$ifdef fpc}
+{$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;
-  
+
   tsmallarray = packed array[1..SMALL_INDEX] of byte;
-  
-  tsmallsetenum = 
+
+  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;
@@ -103,7 +111,7 @@ var
  global_bigstring : shortstring;
  global_boolean : boolean;
  global_char : char;
-{$ifdef fpc}
+{$ifndef tp}
  global_class : tclass1;
  global_s64bit : int64;
  value_s64bit : int64;
@@ -125,14 +133,14 @@ var
  value_smallarray : tsmallarray;
  value_boolean : boolean;
  value_char : char;
- 
+
     procedure fail;
     begin
       WriteLn('Failure.');
       halt(1);
     end;
-    
-    
+
+
     procedure clear_globals;
      begin
       global_u8bit := 0;
@@ -145,13 +153,13 @@ var
       global_bigstring := '';
       global_boolean := false;
       global_char := #0;
-{$ifdef fpc}
+{$ifndef tp}
       global_s64bit := 0;
       global_class := nil;
 {$endif}
      end;
-     
-     
+
+
     procedure clear_values;
      begin
       value_u8bit := 0;
@@ -170,37 +178,37 @@ var
       fillchar(value_smallarray, sizeof(value_smallarray), #0);
       value_boolean := false;
       value_char:=#0;
-{$ifdef fpc}
+{$ifndef tp}
       value_s64bit := 0;
       value_class := nil;
 {$endif}
      end;
 
-   
+
   procedure testprocedure;
    begin
    end;
- 
+
    function getu8bit : byte;
     begin
       getu8bit:=RESULT_U8BIT;
     end;
-    
+
    function getu16bit: word;
      begin
        getu16bit:=RESULT_U16BIT;
      end;
-     
+
    function gets32bit: longint;
     begin
       gets32bit:=RESULT_S32BIT;
     end;
-    
+
    function gets64bit: longint;
     begin
       gets64bit:=RESULT_S32BIT;
     end;
- 
+
 
    function gets32real: single;
     begin
@@ -234,8 +242,8 @@ var
    end;
 
 
-   
-   
+
+
   procedure proc_value_bool8bit(v: boolean);register;
    begin
      { boolean should be 8-bit always! }
@@ -260,13 +268,13 @@ var
    begin
      global_s32real := v;
    end;
-   
+
   procedure proc_value_s64real(v: double);register;
    begin
      global_s64real:= v;
    end;
-   
-   
+
+
   procedure proc_value_pointerdef(p : pchar);register;
    begin
      global_ptr:=p;
@@ -277,23 +285,23 @@ var
    begin
      global_proc:=p;
    end;
-   
-   
 
-   
+
+
+
   procedure proc_value_smallrecord(smallrec : tsmallrecord);register;
    begin
      if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then
        global_u8bit := RESULT_U8BIT;
    end;
-   
+
 
   procedure proc_value_largerecord(largerec : tlargerecord);register;
    begin
      if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then
        global_u8bit := RESULT_U8BIT;
    end;
-   
+
   procedure proc_value_smallset(smallset : tsmallset);register;
    begin
      if A_D in smallset then
@@ -306,13 +314,13 @@ var
      if 'I' in largeset then
        global_u8bit := RESULT_U8BIT;
    end;
-   
+
   procedure proc_value_smallstring(s:tsmallstring);register;
    begin
      if s = RESULT_SMALLSTRING then
        global_u8bit := RESULT_u8BIT;
    end;
-    
+
 
   procedure proc_value_bigstring(s:shortstring);register;
    begin
@@ -326,7 +334,7 @@ var
     if arr[SMALL_INDEX] = RESULT_U8BIT then
       global_u8bit := RESULT_U8BIT;
   end;
-  
+
   procedure proc_value_smallarray_open(arr : array of byte);register;
   begin
     { form 0 to N-1 indexes in open arrays }
@@ -334,7 +342,7 @@ var
       global_u8bit := RESULT_U8BIT;
   end;
 
-{$ifdef fpc}
+{$ifndef tp}
   procedure proc_value_classrefdef(obj : tclass1);register;
    begin
      global_class:=obj;
@@ -347,11 +355,11 @@ var
   begin
     for i:=0 to high(arr) do
      begin
-       case arr[i].vtype of 
+       case arr[i].vtype of
         vtInteger : global_u8bit := arr[i].vinteger and $ff;
         vtBoolean : global_boolean := arr[i].vboolean;
         vtChar : global_char := arr[i].vchar;
-        vtExtended : global_s64real := arr[i].VExtended^; 
+        vtExtended : global_s64real := arr[i].VExtended^;
         vtString :  global_bigstring := arr[i].VString^;
         vtPointer : ;
         vtPChar : global_ptr := arr[i].VPchar;
@@ -364,7 +372,7 @@ var
        end;
      end; {endfor}
   end;
-  
+
 
   procedure proc_value_smallarray_const_2(arr : array of const);register;
   var
@@ -381,7 +389,7 @@ var
 {$endif}
 
  {********************************* MIXED PARAMETERS *************************}
- 
+
   procedure proc_value_u8bit_mixed(b1 : byte; v: byte; b2: byte);register;
    begin
      global_u8bit := v;
@@ -401,10 +409,10 @@ var
      global_s32bit := v;
      value_u8bit := b2;
    end;
-   
 
-   
-   
+
+
+
   procedure proc_value_bool8bit_mixed(b1: byte; v: boolean; b2: byte);register;
    begin
      { boolean should be 8-bit always! }
@@ -433,14 +441,14 @@ var
      global_s32real := v;
      value_u8bit := b2;
    end;
-   
+
   procedure proc_value_s64real_mixed(b1: byte; v: double; b2: byte);register;
    begin
      global_s64real:= v;
      value_u8bit := b2;
    end;
-   
-   
+
+
   procedure proc_value_pointerdef_mixed(b1: byte; p : pchar; b2: byte);register;
    begin
      global_ptr:=p;
@@ -453,8 +461,8 @@ var
      global_proc:=p;
      value_u8bit := b2;
    end;
-   
-   
+
+
 
 
   procedure proc_value_smallrecord_mixed(b1: byte; smallrec : tsmallrecord; b2: byte);register;
@@ -463,7 +471,7 @@ var
        global_u8bit := RESULT_U8BIT;
      value_u8bit := b2;
    end;
-   
+
 
   procedure proc_value_largerecord_mixed(b1: byte; largerec : tlargerecord; b2: byte);register;
    begin
@@ -471,14 +479,14 @@ var
        global_u8bit := RESULT_U8BIT;
      value_u8bit := b2;
    end;
-   
+
   procedure proc_value_smallset_mixed(b1: byte; smallset : tsmallset; b2: byte);register;
    begin
      if A_D in smallset then
        global_u8bit := RESULT_U8BIT;
      value_u8bit := b2;
    end;
-   
+
 
   procedure proc_value_largeset_mixed(b1: byte; largeset : tlargeset; b2: byte);register;
    begin
@@ -486,14 +494,14 @@ var
        global_u8bit := RESULT_U8BIT;
      value_u8bit := b2;
    end;
-   
+
   procedure proc_value_smallstring_mixed(b1: byte; s:tsmallstring; b2: byte);register;
    begin
      if s = RESULT_SMALLSTRING then
        global_u8bit := RESULT_u8BIT;
      value_u8bit := b2;
    end;
-    
+
 
   procedure proc_value_bigstring_mixed(b1: byte; s:shortstring; b2: byte);register;
    begin
@@ -501,7 +509,7 @@ var
        global_u8bit := RESULT_u8BIT;
      value_u8bit := b2;
    end;
-   
+
 
   procedure proc_value_smallarray_mixed(b1: byte; arr : tsmallarray; b2: byte);register;
   begin
@@ -509,7 +517,7 @@ var
       global_u8bit := RESULT_U8BIT;
      value_u8bit := b2;
   end;
-  
+
   procedure proc_value_smallarray_open_mixed(b1: byte; arr : array of byte; b2: byte);register;
   begin
     { form 0 to N-1 indexes in open arrays }
@@ -518,7 +526,7 @@ var
      value_u8bit := b2;
   end;
 
-{$ifdef fpc}
+{$ifndef tp}
   procedure proc_value_classrefdef_mixed(b1: byte; obj : tclass1; b2: byte);register;
    begin
      global_class:=obj;
@@ -532,18 +540,18 @@ var
      value_u8bit := b2;
    end;
 
-  
+
   procedure proc_value_smallarray_const_1_mixed(b1: byte; arr : array of const; b2: byte);register;
   var
    i: integer;
   begin
     for i:=0 to high(arr) do
      begin
-       case arr[i].vtype of 
+       case arr[i].vtype of
         vtInteger : global_u8bit := arr[i].vinteger and $ff;
         vtBoolean : global_boolean := arr[i].vboolean;
         vtChar : global_char := arr[i].vchar;
-        vtExtended : global_s64real := arr[i].VExtended^; 
+        vtExtended : global_s64real := arr[i].VExtended^;
         vtString :  global_bigstring := arr[i].VString^;
         vtPointer : ;
         vtPChar : global_ptr := arr[i].VPchar;
@@ -557,7 +565,7 @@ var
      end; {endfor}
      value_u8bit := b2;
   end;
-  
+
 
   procedure proc_value_smallarray_const_2_mixed(b1: byte; arr : array of const; b2: byte);register;
   var
@@ -569,7 +577,7 @@ var
   end;
 {$endif}
 
- 
+
 
 var
  failed: boolean;
@@ -577,9 +585,9 @@ Begin
   {***************************** NORMAL TESTS *******************************}
   clear_globals;
   clear_values;
-  
+
   failed:=false;
-  
+
   { LOC_REGISTER }
   write('Value parameter test (src : LOC_REGISTER)...');
   proc_value_u8bit(getu8bit);
@@ -591,7 +599,7 @@ Begin
   proc_value_s32bit(gets32bit);
   if global_s32bit <> RESULT_S32BIT then
     failed:=true;
-{$ifdef fpc}
+{$ifndef tp}
   proc_value_s64bit(gets64bit);
   if global_s64bit <> RESULT_S64BIT then
     failed:=true;
@@ -600,9 +608,9 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
-    
-  { LOC_FPUREGISTER }  
+
+
+  { LOC_FPUREGISTER }
   clear_globals;
   clear_values;
   failed:=false;
@@ -617,22 +625,22 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
 
-  { LOC_MEM, LOC_REFERENCE orddef } 
+
+  { LOC_MEM, LOC_REFERENCE orddef }
   clear_globals;
   clear_values;
   value_u8bit := RESULT_U8BIT;
   value_u16bit := RESULT_U16BIT;
   value_s32bit := RESULT_S32BIT;
-{$ifdef fpc}
+{$ifndef tp}
   value_s64bit := RESULT_S64BIT;
 {$endif}
   value_s32real := RESULT_S32REAL;
   value_s64real  := RESULT_S64REAL;
 
   failed:=false;
-  
+
   { LOC_REFERENCE }
   write('Value parameter test (src : LOC_REFERENCE (orddef/enumdef)))...');
   proc_value_u8bit(value_u8bit);
@@ -644,7 +652,7 @@ Begin
   proc_value_s32bit(value_s32bit);
   if global_s32bit <> RESULT_S32BIT then
     failed:=true;
-{$ifdef fpc}
+{$ifndef tp}
   proc_value_s64bit(value_s64bit);
   if global_s64bit <> RESULT_S64BIT then
     failed:=true;
@@ -653,9 +661,9 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
-    
-  { LOC_REFERENCE }  
+
+
+  { LOC_REFERENCE }
   clear_globals;
   failed:=false;
   write('Value parameter test (src : LOC_REFERENCE (floatdef))...');
@@ -669,7 +677,7 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
+
 
 
   write('Value parameter test (src : LOC_REFERENCE (pointer))...');
@@ -682,12 +690,12 @@ Begin
     failed := true;
 
 
-  value_proc := {$ifdef fpc}@{$endif}testprocedure;
+  value_proc := {$ifndef tp}@{$endif}testprocedure;
   proc_value_procvardef(value_proc);
   if {$ifndef fpc}@{$endif}value_proc <> {$ifndef fpc}@{$endif}global_proc then
     failed := true;
 
-{$ifdef fpc}
+{$ifndef tp}
   value_class := tclass1.create;
   proc_value_classrefdef(value_class);
   if value_class <> global_class then
@@ -711,7 +719,7 @@ Begin
   proc_value_bool8bit(value_u8bit = 0);
   if global_u8bit <> RESULT_BOOL8BIT then
     failed:=true;
-{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x 
+{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x
   proc_value_bool16bit(value_s64bit < 0);
   if global_u16bit <> RESULT_BOOL16BIT then
     failed:=true;
@@ -725,7 +733,7 @@ Begin
 
 
 
-{$ifdef fpc}
+{$ifndef tp}
   clear_globals;
   clear_values;
   failed:=false;
@@ -733,7 +741,7 @@ Begin
   proc_value_bool8bit(value_s64bit = 0);
   if global_u8bit <> RESULT_BOOL8BIT then
     failed:=true;
-{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x 
+{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x
   proc_value_bool16bit(value_s64bit < 0);
   if global_u16bit <> RESULT_BOOL16BIT then
     failed:=true;
@@ -769,38 +777,38 @@ Begin
   proc_value_largerecord(value_largerec);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
-    
-    
+
+
   write('Value parameter test (src : LOC_REFERENCE (setdef)))...');
   clear_globals;
   clear_values;
   failed := false;
-  
+
   value_smallset := [A_A,A_D];
   proc_value_smallset(value_smallset);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   value_largeset := ['I'];
   proc_value_largeset(value_largeset);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
 
-    
+
 
 
   write('Value parameter test (src : LOC_REFERENCE (stringdef)))...');
@@ -812,14 +820,14 @@ Begin
   proc_value_smallstring(value_smallstring);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   value_bigstring := RESULT_BIGSTRING;
   proc_value_bigstring(value_bigstring);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
@@ -829,14 +837,14 @@ Begin
 
   { open array by value with cdecl modifier!!!!!!!!!!!!!!!!!!!!!!!!!!!}
   { DON'T KNOW WHY/HOW TO TEST!!!!!                                   }
-  
-  
+
+
   write('Value parameter test (src : LOC_REFERENCE (arraydef)))...');
-  
+
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   fillchar(value_smallarray,sizeof(value_smallarray),#0);
   value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
   proc_value_smallarray(value_smallarray);
@@ -852,7 +860,7 @@ Begin
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
 
-{$ifdef fpc}
+{$ifndef tp}
   clear_globals;
   clear_values;
 
@@ -866,10 +874,10 @@ Begin
   value_s64real:=RESULT_S64REAL;
   proc_value_smallarray_const_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real,
     value_boolean,value_class]);
-  
+
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if global_char <> RESULT_CHAR then
     failed := true;
   if global_boolean <> RESULT_BOOLEAN then
@@ -901,9 +909,9 @@ Begin
   {***************************** MIXED  TESTS *******************************}
   clear_globals;
   clear_values;
-  
+
   failed:=false;
-  
+
   { LOC_REGISTER }
   write('Mixed value parameter test (src : LOC_REGISTER)...');
   proc_value_u8bit_mixed(byte(NOT RESULT_U8BIT),getu8bit,RESULT_U8BIT);
@@ -921,7 +929,7 @@ Begin
     failed:=true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-{$ifdef fpc}
+{$ifndef tp}
   proc_value_s64bit_mixed(byte(NOT RESULT_U8BIT),gets64bit,RESULT_U8BIT);
   if global_s64bit <> RESULT_S64BIT then
     failed:=true;
@@ -933,9 +941,9 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
-    
-  { LOC_FPUREGISTER }  
+
+
+  { LOC_FPUREGISTER }
   clear_globals;
   clear_values;
   failed:=false;
@@ -954,22 +962,22 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
 
-  { LOC_MEM, LOC_REFERENCE orddef } 
+
+  { LOC_MEM, LOC_REFERENCE orddef }
   clear_globals;
   clear_values;
   value_u8bit := RESULT_U8BIT;
   value_u16bit := RESULT_U16BIT;
   value_s32bit := RESULT_S32BIT;
-{$ifdef fpc}
+{$ifndef tp}
   value_s64bit := RESULT_S64BIT;
 {$endif}
   value_s32real := RESULT_S32REAL;
   value_s64real  := RESULT_S64REAL;
 
   failed:=false;
-  
+
   { LOC_REFERENCE }
   write('Mixed value parameter test (src : LOC_REFERENCE (orddef/enumdef)))...');
   proc_value_u8bit_mixed(byte(NOT RESULT_U8BIT),value_u8bit, RESULT_U8BIT);
@@ -987,7 +995,7 @@ Begin
     failed:=true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-{$ifdef fpc}
+{$ifndef tp}
   proc_value_s64bit_mixed(byte(NOT RESULT_U8BIT), value_s64bit, RESULT_U8BIT);
   if global_s64bit <> RESULT_S64BIT then
     failed:=true;
@@ -999,9 +1007,9 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
-    
-  { LOC_REFERENCE }  
+
+
+  { LOC_REFERENCE }
   clear_globals;
   failed:=false;
   write('Mixed value parameter test (src : LOC_REFERENCE (floatdef))...');
@@ -1020,7 +1028,7 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
+
 
 
   write('Mixed value parameter test (src : LOC_REFERENCE (pointer))...');
@@ -1035,12 +1043,12 @@ Begin
     failed := true;
 
 
-  value_proc := {$ifdef fpc}@{$endif}testprocedure;
+  value_proc := {$ifndef tp}@{$endif}testprocedure;
   proc_value_procvardef_mixed(byte(NOT RESULT_U8BIT), value_proc, RESULT_U8BIT);
   if {$ifndef fpc}@{$endif}value_proc <> {$ifndef fpc}@{$endif}global_proc then
     failed := true;
 
-{$ifdef fpc}
+{$ifndef tp}
   value_class := tclass1.create;
   proc_value_classrefdef_mixed(byte(NOT RESULT_U8BIT), value_class, RESULT_U8BIT);
   if value_class <> global_class then
@@ -1068,7 +1076,7 @@ Begin
     failed:=true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x 
+{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x
   proc_value_bool16bit(value_s64bit < 0);
   if global_u16bit <> RESULT_BOOL16BIT then
     failed:=true;
@@ -1081,8 +1089,8 @@ Begin
     WriteLn('Passed!');
 
 
-    
-{$ifdef fpc}
+
+{$ifndef tp}
   clear_globals;
   clear_values;
   failed:=false;
@@ -1092,7 +1100,7 @@ Begin
     failed:=true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x 
+{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x
   proc_value_bool16bit(value_s64bit < 0);
   if global_u16bit <> RESULT_BOOL16BIT then
     failed:=true;
@@ -1104,7 +1112,7 @@ Begin
   else
     WriteLn('Passed!');
 {$endif}
-     
+
   { arraydef,
     recorddef,
     objectdef,
@@ -1132,26 +1140,26 @@ Begin
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
-    
-    
+
+
   write('Mixed value parameter test (src : LOC_REFERENCE (setdef)))...');
   clear_globals;
   clear_values;
   failed := false;
-  
+
   value_smallset := [A_A,A_D];
   proc_value_smallset_mixed(byte(NOT RESULT_U8BIT), value_smallset, RESULT_U8BIT);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   value_largeset := ['I'];
@@ -1160,14 +1168,14 @@ Begin
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
 
-    
+
 
 
   write('Mixed value parameter test (src : LOC_REFERENCE (stringdef)))...');
@@ -1181,7 +1189,7 @@ Begin
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   value_bigstring := RESULT_BIGSTRING;
@@ -1190,7 +1198,7 @@ Begin
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
@@ -1200,14 +1208,14 @@ Begin
 
   { open array by value with cdecl modifier!!!!!!!!!!!!!!!!!!!!!!!!!!!}
   { DON'T KNOW WHY/HOW TO TEST!!!!!                                   }
-  
-  
+
+
   write('Mixed value parameter test (src : LOC_REFERENCE (arraydef)))...');
-  
+
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   fillchar(value_smallarray,sizeof(value_smallarray),#0);
   value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
   proc_value_smallarray_mixed(byte(NOT RESULT_U8BIT), value_smallarray, RESULT_U8BIT);
@@ -1227,7 +1235,7 @@ Begin
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
 
-{$ifdef fpc}
+{$ifndef tp}
   clear_globals;
   clear_values;
 
@@ -1244,10 +1252,10 @@ Begin
      RESULT_U8BIT);
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-  
+
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if global_char <> RESULT_CHAR then
     failed := true;
   if global_boolean <> RESULT_BOOLEAN then
@@ -1257,7 +1265,7 @@ Begin
   if global_bigstring <> RESULT_SMALLSTRING then
      failed := true;
   if global_ptr <> value_ptr then
-     failed := true; 
+     failed := true;
 {  if value_class <> global_class then
      failed := true;!!!!!!!!!!!!!!!!!!!!}
   if global_s64bit <> RESULT_S64BIT then
@@ -1277,13 +1285,16 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
+
 end.
 
 
 {
   $Log$
-  Revision 1.1  2002-04-13 17:49:45  carl
+  Revision 1.2  2002-05-13 13:45:38  peter
+    * updated to compile tests with kylix
+
+  Revision 1.1  2002/04/13 17:49:45  carl
   + value parameter passing for different calling conventions
 
 }

tests/test/cg/tcalval8.pp

@@ -26,6 +26,9 @@ program tcalval8;
 {$R+}
 {$P-}
 
+{$ifdef VER70}
+  {$define tp}
+{$endif}
 
 
  { REAL should map to single or double }
@@ -36,11 +39,16 @@ program tcalval8;
 
  const
 { should be defined depending on CPU target }
-{$ifdef cpu68k}
-  BIG_INDEX = 8000;
-  SMALL_INDEX  = 13;
-{$endif}
-{$ifdef cpu86}
+{$ifdef fpc}
+  {$ifdef cpu68k}
+    BIG_INDEX = 8000;
+    SMALL_INDEX  = 13;
+  {$endif}
+  {$ifdef cpui386}
+    BIG_INDEX = 33000;
+    SMALL_INDEX = 13;     { value should not be aligned! }
+  {$endif}
+{$else}
   BIG_INDEX = 33000;
   SMALL_INDEX = 13;     { value should not be aligned! }
 {$endif}
@@ -58,40 +66,40 @@ program tcalval8;
   RESULT_SMALLSTRING = 'H';
   RESULT_CHAR = 'I';
   RESULT_BOOLEAN = TRUE;
-  
+
 type
-{$ifdef fpc}
+{$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;
-  
+
   tsmallarray = packed array[1..SMALL_INDEX] of byte;
-  
-  tsmallsetenum = 
+
+  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;
@@ -103,7 +111,7 @@ var
  global_bigstring : shortstring;
  global_boolean : boolean;
  global_char : char;
-{$ifdef fpc}
+{$ifndef tp}
  global_class : tclass1;
  global_s64bit : int64;
  value_s64bit : int64;
@@ -125,14 +133,14 @@ var
  value_smallarray : tsmallarray;
  value_boolean : boolean;
  value_char : char;
- 
+
     procedure fail;
     begin
       WriteLn('Failure.');
       halt(1);
     end;
-    
-    
+
+
     procedure clear_globals;
      begin
       global_u8bit := 0;
@@ -145,13 +153,13 @@ var
       global_bigstring := '';
       global_boolean := false;
       global_char := #0;
-{$ifdef fpc}
+{$ifndef tp}
       global_s64bit := 0;
       global_class := nil;
 {$endif}
      end;
-     
-     
+
+
     procedure clear_values;
      begin
       value_u8bit := 0;
@@ -170,37 +178,37 @@ var
       fillchar(value_smallarray, sizeof(value_smallarray), #0);
       value_boolean := false;
       value_char:=#0;
-{$ifdef fpc}
+{$ifndef tp}
       value_s64bit := 0;
       value_class := nil;
 {$endif}
      end;
 
-   
+
   procedure testprocedure;
    begin
    end;
- 
+
    function getu8bit : byte;
     begin
       getu8bit:=RESULT_U8BIT;
     end;
-    
+
    function getu16bit: word;
      begin
        getu16bit:=RESULT_U16BIT;
      end;
-     
+
    function gets32bit: longint;
     begin
       gets32bit:=RESULT_S32BIT;
     end;
-    
+
    function gets64bit: longint;
     begin
       gets64bit:=RESULT_S32BIT;
     end;
- 
+
 
    function gets32real: single;
     begin
@@ -234,8 +242,8 @@ var
    end;
 
 
-   
-   
+
+
   procedure proc_value_bool8bit(v: boolean);stdcall;
    begin
      { boolean should be 8-bit always! }
@@ -260,13 +268,13 @@ var
    begin
      global_s32real := v;
    end;
-   
+
   procedure proc_value_s64real(v: double);stdcall;
    begin
      global_s64real:= v;
    end;
-   
-   
+
+
   procedure proc_value_pointerdef(p : pchar);stdcall;
    begin
      global_ptr:=p;
@@ -277,23 +285,23 @@ var
    begin
      global_proc:=p;
    end;
-   
-   
 
-   
+
+
+
   procedure proc_value_smallrecord(smallrec : tsmallrecord);stdcall;
    begin
      if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then
        global_u8bit := RESULT_U8BIT;
    end;
-   
+
 
   procedure proc_value_largerecord(largerec : tlargerecord);stdcall;
    begin
      if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then
        global_u8bit := RESULT_U8BIT;
    end;
-   
+
   procedure proc_value_smallset(smallset : tsmallset);stdcall;
    begin
      if A_D in smallset then
@@ -306,13 +314,13 @@ var
      if 'I' in largeset then
        global_u8bit := RESULT_U8BIT;
    end;
-   
+
   procedure proc_value_smallstring(s:tsmallstring);stdcall;
    begin
      if s = RESULT_SMALLSTRING then
        global_u8bit := RESULT_u8BIT;
    end;
-    
+
 
   procedure proc_value_bigstring(s:shortstring);stdcall;
    begin
@@ -326,7 +334,7 @@ var
     if arr[SMALL_INDEX] = RESULT_U8BIT then
       global_u8bit := RESULT_U8BIT;
   end;
-  
+
   procedure proc_value_smallarray_open(arr : array of byte);stdcall;
   begin
     { form 0 to N-1 indexes in open arrays }
@@ -334,7 +342,7 @@ var
       global_u8bit := RESULT_U8BIT;
   end;
 
-{$ifdef fpc}
+{$ifndef tp}
   procedure proc_value_classrefdef(obj : tclass1);stdcall;
    begin
      global_class:=obj;
@@ -347,11 +355,11 @@ var
   begin
     for i:=0 to high(arr) do
      begin
-       case arr[i].vtype of 
+       case arr[i].vtype of
         vtInteger : global_u8bit := arr[i].vinteger and $ff;
         vtBoolean : global_boolean := arr[i].vboolean;
         vtChar : global_char := arr[i].vchar;
-        vtExtended : global_s64real := arr[i].VExtended^; 
+        vtExtended : global_s64real := arr[i].VExtended^;
         vtString :  global_bigstring := arr[i].VString^;
         vtPointer : ;
         vtPChar : global_ptr := arr[i].VPchar;
@@ -364,7 +372,7 @@ var
        end;
      end; {endfor}
   end;
-  
+
 
   procedure proc_value_smallarray_const_2(arr : array of const);stdcall;
   var
@@ -381,7 +389,7 @@ var
 {$endif}
 
  {********************************* MIXED PARAMETERS *************************}
- 
+
   procedure proc_value_u8bit_mixed(b1 : byte; v: byte; b2: byte);stdcall;
    begin
      global_u8bit := v;
@@ -401,10 +409,10 @@ var
      global_s32bit := v;
      value_u8bit := b2;
    end;
-   
 
-   
-   
+
+
+
   procedure proc_value_bool8bit_mixed(b1: byte; v: boolean; b2: byte);stdcall;
    begin
      { boolean should be 8-bit always! }
@@ -433,14 +441,14 @@ var
      global_s32real := v;
      value_u8bit := b2;
    end;
-   
+
   procedure proc_value_s64real_mixed(b1: byte; v: double; b2: byte);stdcall;
    begin
      global_s64real:= v;
      value_u8bit := b2;
    end;
-   
-   
+
+
   procedure proc_value_pointerdef_mixed(b1: byte; p : pchar; b2: byte);stdcall;
    begin
      global_ptr:=p;
@@ -453,8 +461,8 @@ var
      global_proc:=p;
      value_u8bit := b2;
    end;
-   
-   
+
+
 
 
   procedure proc_value_smallrecord_mixed(b1: byte; smallrec : tsmallrecord; b2: byte);stdcall;
@@ -463,7 +471,7 @@ var
        global_u8bit := RESULT_U8BIT;
      value_u8bit := b2;
    end;
-   
+
 
   procedure proc_value_largerecord_mixed(b1: byte; largerec : tlargerecord; b2: byte);stdcall;
    begin
@@ -471,14 +479,14 @@ var
        global_u8bit := RESULT_U8BIT;
      value_u8bit := b2;
    end;
-   
+
   procedure proc_value_smallset_mixed(b1: byte; smallset : tsmallset; b2: byte);stdcall;
    begin
      if A_D in smallset then
        global_u8bit := RESULT_U8BIT;
      value_u8bit := b2;
    end;
-   
+
 
   procedure proc_value_largeset_mixed(b1: byte; largeset : tlargeset; b2: byte);stdcall;
    begin
@@ -486,14 +494,14 @@ var
        global_u8bit := RESULT_U8BIT;
      value_u8bit := b2;
    end;
-   
+
   procedure proc_value_smallstring_mixed(b1: byte; s:tsmallstring; b2: byte);stdcall;
    begin
      if s = RESULT_SMALLSTRING then
        global_u8bit := RESULT_u8BIT;
      value_u8bit := b2;
    end;
-    
+
 
   procedure proc_value_bigstring_mixed(b1: byte; s:shortstring; b2: byte);stdcall;
    begin
@@ -501,7 +509,7 @@ var
        global_u8bit := RESULT_u8BIT;
      value_u8bit := b2;
    end;
-   
+
 
   procedure proc_value_smallarray_mixed(b1: byte; arr : tsmallarray; b2: byte);stdcall;
   begin
@@ -509,7 +517,7 @@ var
       global_u8bit := RESULT_U8BIT;
      value_u8bit := b2;
   end;
-  
+
   procedure proc_value_smallarray_open_mixed(b1: byte; arr : array of byte; b2: byte);stdcall;
   begin
     { form 0 to N-1 indexes in open arrays }
@@ -518,7 +526,7 @@ var
      value_u8bit := b2;
   end;
 
-{$ifdef fpc}
+{$ifndef tp}
   procedure proc_value_classrefdef_mixed(b1: byte; obj : tclass1; b2: byte);stdcall;
    begin
      global_class:=obj;
@@ -532,18 +540,18 @@ var
      value_u8bit := b2;
    end;
 
-  
+
   procedure proc_value_smallarray_const_1_mixed(b1: byte; arr : array of const; b2: byte);stdcall;
   var
    i: integer;
   begin
     for i:=0 to high(arr) do
      begin
-       case arr[i].vtype of 
+       case arr[i].vtype of
         vtInteger : global_u8bit := arr[i].vinteger and $ff;
         vtBoolean : global_boolean := arr[i].vboolean;
         vtChar : global_char := arr[i].vchar;
-        vtExtended : global_s64real := arr[i].VExtended^; 
+        vtExtended : global_s64real := arr[i].VExtended^;
         vtString :  global_bigstring := arr[i].VString^;
         vtPointer : ;
         vtPChar : global_ptr := arr[i].VPchar;
@@ -557,7 +565,7 @@ var
      end; {endfor}
      value_u8bit := b2;
   end;
-  
+
 
   procedure proc_value_smallarray_const_2_mixed(b1: byte; arr : array of const; b2: byte);stdcall;
   var
@@ -569,7 +577,7 @@ var
   end;
 {$endif}
 
- 
+
 
 var
  failed: boolean;
@@ -577,9 +585,9 @@ Begin
   {***************************** NORMAL TESTS *******************************}
   clear_globals;
   clear_values;
-  
+
   failed:=false;
-  
+
   { LOC_REGISTER }
   write('Value parameter test (src : LOC_REGISTER)...');
   proc_value_u8bit(getu8bit);
@@ -591,7 +599,7 @@ Begin
   proc_value_s32bit(gets32bit);
   if global_s32bit <> RESULT_S32BIT then
     failed:=true;
-{$ifdef fpc}
+{$ifndef tp}
   proc_value_s64bit(gets64bit);
   if global_s64bit <> RESULT_S64BIT then
     failed:=true;
@@ -600,9 +608,9 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
-    
-  { LOC_FPUREGISTER }  
+
+
+  { LOC_FPUREGISTER }
   clear_globals;
   clear_values;
   failed:=false;
@@ -617,22 +625,22 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
 
-  { LOC_MEM, LOC_REFERENCE orddef } 
+
+  { LOC_MEM, LOC_REFERENCE orddef }
   clear_globals;
   clear_values;
   value_u8bit := RESULT_U8BIT;
   value_u16bit := RESULT_U16BIT;
   value_s32bit := RESULT_S32BIT;
-{$ifdef fpc}
+{$ifndef tp}
   value_s64bit := RESULT_S64BIT;
 {$endif}
   value_s32real := RESULT_S32REAL;
   value_s64real  := RESULT_S64REAL;
 
   failed:=false;
-  
+
   { LOC_REFERENCE }
   write('Value parameter test (src : LOC_REFERENCE (orddef/enumdef)))...');
   proc_value_u8bit(value_u8bit);
@@ -644,7 +652,7 @@ Begin
   proc_value_s32bit(value_s32bit);
   if global_s32bit <> RESULT_S32BIT then
     failed:=true;
-{$ifdef fpc}
+{$ifndef tp}
   proc_value_s64bit(value_s64bit);
   if global_s64bit <> RESULT_S64BIT then
     failed:=true;
@@ -653,9 +661,9 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
-    
-  { LOC_REFERENCE }  
+
+
+  { LOC_REFERENCE }
   clear_globals;
   failed:=false;
   write('Value parameter test (src : LOC_REFERENCE (floatdef))...');
@@ -669,7 +677,7 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
+
 
 
   write('Value parameter test (src : LOC_REFERENCE (pointer))...');
@@ -682,12 +690,12 @@ Begin
     failed := true;
 
 
-  value_proc := {$ifdef fpc}@{$endif}testprocedure;
+  value_proc := {$ifndef tp}@{$endif}testprocedure;
   proc_value_procvardef(value_proc);
   if {$ifndef fpc}@{$endif}value_proc <> {$ifndef fpc}@{$endif}global_proc then
     failed := true;
 
-{$ifdef fpc}
+{$ifndef tp}
   value_class := tclass1.create;
   proc_value_classrefdef(value_class);
   if value_class <> global_class then
@@ -711,7 +719,7 @@ Begin
   proc_value_bool8bit(value_u8bit = 0);
   if global_u8bit <> RESULT_BOOL8BIT then
     failed:=true;
-{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x 
+{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x
   proc_value_bool16bit(value_s64bit < 0);
   if global_u16bit <> RESULT_BOOL16BIT then
     failed:=true;
@@ -725,7 +733,7 @@ Begin
 
 
 
-{$ifdef fpc}
+{$ifndef tp}
   clear_globals;
   clear_values;
   failed:=false;
@@ -733,7 +741,7 @@ Begin
   proc_value_bool8bit(value_s64bit = 0);
   if global_u8bit <> RESULT_BOOL8BIT then
     failed:=true;
-{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x 
+{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x
   proc_value_bool16bit(value_s64bit < 0);
   if global_u16bit <> RESULT_BOOL16BIT then
     failed:=true;
@@ -769,38 +777,38 @@ Begin
   proc_value_largerecord(value_largerec);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
-    
-    
+
+
   write('Value parameter test (src : LOC_REFERENCE (setdef)))...');
   clear_globals;
   clear_values;
   failed := false;
-  
+
   value_smallset := [A_A,A_D];
   proc_value_smallset(value_smallset);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   value_largeset := ['I'];
   proc_value_largeset(value_largeset);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
 
-    
+
 
 
   write('Value parameter test (src : LOC_REFERENCE (stringdef)))...');
@@ -812,14 +820,14 @@ Begin
   proc_value_smallstring(value_smallstring);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   value_bigstring := RESULT_BIGSTRING;
   proc_value_bigstring(value_bigstring);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
@@ -829,14 +837,14 @@ Begin
 
   { open array by value with cdecl modifier!!!!!!!!!!!!!!!!!!!!!!!!!!!}
   { DON'T KNOW WHY/HOW TO TEST!!!!!                                   }
-  
-  
+
+
   write('Value parameter test (src : LOC_REFERENCE (arraydef)))...');
-  
+
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   fillchar(value_smallarray,sizeof(value_smallarray),#0);
   value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
   proc_value_smallarray(value_smallarray);
@@ -852,7 +860,7 @@ Begin
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
 
-{$ifdef fpc}
+{$ifndef tp}
   clear_globals;
   clear_values;
 
@@ -866,10 +874,10 @@ Begin
   value_s64real:=RESULT_S64REAL;
   proc_value_smallarray_const_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real,
     value_boolean,value_class]);
-  
+
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if global_char <> RESULT_CHAR then
     failed := true;
   if global_boolean <> RESULT_BOOLEAN then
@@ -901,9 +909,9 @@ Begin
   {***************************** MIXED  TESTS *******************************}
   clear_globals;
   clear_values;
-  
+
   failed:=false;
-  
+
   { LOC_REGISTER }
   write('Mixed value parameter test (src : LOC_REGISTER)...');
   proc_value_u8bit_mixed(byte(NOT RESULT_U8BIT),getu8bit,RESULT_U8BIT);
@@ -921,7 +929,7 @@ Begin
     failed:=true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-{$ifdef fpc}
+{$ifndef tp}
   proc_value_s64bit_mixed(byte(NOT RESULT_U8BIT),gets64bit,RESULT_U8BIT);
   if global_s64bit <> RESULT_S64BIT then
     failed:=true;
@@ -933,9 +941,9 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
-    
-  { LOC_FPUREGISTER }  
+
+
+  { LOC_FPUREGISTER }
   clear_globals;
   clear_values;
   failed:=false;
@@ -954,22 +962,22 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
 
-  { LOC_MEM, LOC_REFERENCE orddef } 
+
+  { LOC_MEM, LOC_REFERENCE orddef }
   clear_globals;
   clear_values;
   value_u8bit := RESULT_U8BIT;
   value_u16bit := RESULT_U16BIT;
   value_s32bit := RESULT_S32BIT;
-{$ifdef fpc}
+{$ifndef tp}
   value_s64bit := RESULT_S64BIT;
 {$endif}
   value_s32real := RESULT_S32REAL;
   value_s64real  := RESULT_S64REAL;
 
   failed:=false;
-  
+
   { LOC_REFERENCE }
   write('Mixed value parameter test (src : LOC_REFERENCE (orddef/enumdef)))...');
   proc_value_u8bit_mixed(byte(NOT RESULT_U8BIT),value_u8bit, RESULT_U8BIT);
@@ -987,7 +995,7 @@ Begin
     failed:=true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-{$ifdef fpc}
+{$ifndef tp}
   proc_value_s64bit_mixed(byte(NOT RESULT_U8BIT), value_s64bit, RESULT_U8BIT);
   if global_s64bit <> RESULT_S64BIT then
     failed:=true;
@@ -999,9 +1007,9 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
-    
-  { LOC_REFERENCE }  
+
+
+  { LOC_REFERENCE }
   clear_globals;
   failed:=false;
   write('Mixed value parameter test (src : LOC_REFERENCE (floatdef))...');
@@ -1020,7 +1028,7 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
+
 
 
   write('Mixed value parameter test (src : LOC_REFERENCE (pointer))...');
@@ -1035,12 +1043,12 @@ Begin
     failed := true;
 
 
-  value_proc := {$ifdef fpc}@{$endif}testprocedure;
+  value_proc := {$ifndef tp}@{$endif}testprocedure;
   proc_value_procvardef_mixed(byte(NOT RESULT_U8BIT), value_proc, RESULT_U8BIT);
   if {$ifndef fpc}@{$endif}value_proc <> {$ifndef fpc}@{$endif}global_proc then
     failed := true;
 
-{$ifdef fpc}
+{$ifndef tp}
   value_class := tclass1.create;
   proc_value_classrefdef_mixed(byte(NOT RESULT_U8BIT), value_class, RESULT_U8BIT);
   if value_class <> global_class then
@@ -1068,7 +1076,7 @@ Begin
     failed:=true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x 
+{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x
   proc_value_bool16bit(value_s64bit < 0);
   if global_u16bit <> RESULT_BOOL16BIT then
     failed:=true;
@@ -1081,8 +1089,8 @@ Begin
     WriteLn('Passed!');
 
 
-    
-{$ifdef fpc}
+
+{$ifndef tp}
   clear_globals;
   clear_values;
   failed:=false;
@@ -1092,7 +1100,7 @@ Begin
     failed:=true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x 
+{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x
   proc_value_bool16bit(value_s64bit < 0);
   if global_u16bit <> RESULT_BOOL16BIT then
     failed:=true;
@@ -1104,7 +1112,7 @@ Begin
   else
     WriteLn('Passed!');
 {$endif}
-     
+
   { arraydef,
     recorddef,
     objectdef,
@@ -1132,26 +1140,26 @@ Begin
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
-    
-    
+
+
   write('Mixed value parameter test (src : LOC_REFERENCE (setdef)))...');
   clear_globals;
   clear_values;
   failed := false;
-  
+
   value_smallset := [A_A,A_D];
   proc_value_smallset_mixed(byte(NOT RESULT_U8BIT), value_smallset, RESULT_U8BIT);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   value_largeset := ['I'];
@@ -1160,14 +1168,14 @@ Begin
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
 
-    
+
 
 
   write('Mixed value parameter test (src : LOC_REFERENCE (stringdef)))...');
@@ -1181,7 +1189,7 @@ Begin
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   value_bigstring := RESULT_BIGSTRING;
@@ -1190,7 +1198,7 @@ Begin
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
@@ -1200,14 +1208,14 @@ Begin
 
   { open array by value with cdecl modifier!!!!!!!!!!!!!!!!!!!!!!!!!!!}
   { DON'T KNOW WHY/HOW TO TEST!!!!!                                   }
-  
-  
+
+
   write('Mixed value parameter test (src : LOC_REFERENCE (arraydef)))...');
-  
+
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   fillchar(value_smallarray,sizeof(value_smallarray),#0);
   value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
   proc_value_smallarray_mixed(byte(NOT RESULT_U8BIT), value_smallarray, RESULT_U8BIT);
@@ -1227,7 +1235,7 @@ Begin
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
 
-{$ifdef fpc}
+{$ifndef tp}
   clear_globals;
   clear_values;
 
@@ -1244,10 +1252,10 @@ Begin
      RESULT_U8BIT);
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-  
+
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if global_char <> RESULT_CHAR then
     failed := true;
   if global_boolean <> RESULT_BOOLEAN then
@@ -1257,7 +1265,7 @@ Begin
   if global_bigstring <> RESULT_SMALLSTRING then
      failed := true;
   if global_ptr <> value_ptr then
-     failed := true; 
+     failed := true;
 {  if value_class <> global_class then
      failed := true;!!!!!!!!!!!!!!!!!!!!}
   if global_s64bit <> RESULT_S64BIT then
@@ -1277,13 +1285,16 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
+
 end.
 
 
 {
   $Log$
-  Revision 1.1  2002-04-13 17:49:45  carl
+  Revision 1.2  2002-05-13 13:45:38  peter
+    * updated to compile tests with kylix
+
+  Revision 1.1  2002/04/13 17:49:45  carl
   + value parameter passing for different calling conventions
 
 }

tests/test/cg/tcalval9.pp

@@ -26,6 +26,9 @@ program tcalval9;
 {$R+}
 {$P-}
 
+{$ifdef VER70}
+  {$define tp}
+{$endif}
 
 
  { REAL should map to single or double }
@@ -36,11 +39,16 @@ program tcalval9;
 
  const
 { should be defined depending on CPU target }
-{$ifdef cpu68k}
-  BIG_INDEX = 8000;
-  SMALL_INDEX  = 13;
-{$endif}
-{$ifdef cpu86}
+{$ifdef fpc}
+  {$ifdef cpu68k}
+    BIG_INDEX = 8000;
+    SMALL_INDEX  = 13;
+  {$endif}
+  {$ifdef cpui386}
+    BIG_INDEX = 33000;
+    SMALL_INDEX = 13;     { value should not be aligned! }
+  {$endif}
+{$else}
   BIG_INDEX = 33000;
   SMALL_INDEX = 13;     { value should not be aligned! }
 {$endif}
@@ -58,40 +66,40 @@ program tcalval9;
   RESULT_SMALLSTRING = 'H';
   RESULT_CHAR = 'I';
   RESULT_BOOLEAN = TRUE;
-  
+
 type
-{$ifdef fpc}
+{$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;
-  
+
   tsmallarray = packed array[1..SMALL_INDEX] of byte;
-  
-  tsmallsetenum = 
+
+  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;
@@ -103,7 +111,7 @@ var
  global_bigstring : shortstring;
  global_boolean : boolean;
  global_char : char;
-{$ifdef fpc}
+{$ifndef tp}
  global_class : tclass1;
  global_s64bit : int64;
  value_s64bit : int64;
@@ -125,14 +133,14 @@ var
  value_smallarray : tsmallarray;
  value_boolean : boolean;
  value_char : char;
- 
+
     procedure fail;
     begin
       WriteLn('Failure.');
       halt(1);
     end;
-    
-    
+
+
     procedure clear_globals;
      begin
       global_u8bit := 0;
@@ -145,13 +153,13 @@ var
       global_bigstring := '';
       global_boolean := false;
       global_char := #0;
-{$ifdef fpc}
+{$ifndef tp}
       global_s64bit := 0;
       global_class := nil;
 {$endif}
      end;
-     
-     
+
+
     procedure clear_values;
      begin
       value_u8bit := 0;
@@ -170,37 +178,37 @@ var
       fillchar(value_smallarray, sizeof(value_smallarray), #0);
       value_boolean := false;
       value_char:=#0;
-{$ifdef fpc}
+{$ifndef tp}
       value_s64bit := 0;
       value_class := nil;
 {$endif}
      end;
 
-   
+
   procedure testprocedure;
    begin
    end;
- 
+
    function getu8bit : byte;
     begin
       getu8bit:=RESULT_U8BIT;
     end;
-    
+
    function getu16bit: word;
      begin
        getu16bit:=RESULT_U16BIT;
      end;
-     
+
    function gets32bit: longint;
     begin
       gets32bit:=RESULT_S32BIT;
     end;
-    
+
    function gets64bit: longint;
     begin
       gets64bit:=RESULT_S32BIT;
     end;
- 
+
 
    function gets32real: single;
     begin
@@ -234,8 +242,8 @@ var
    end;
 
 
-   
-   
+
+
   procedure proc_value_bool8bit(v: boolean);saveregisters;
    begin
      { boolean should be 8-bit always! }
@@ -260,13 +268,13 @@ var
    begin
      global_s32real := v;
    end;
-   
+
   procedure proc_value_s64real(v: double);saveregisters;
    begin
      global_s64real:= v;
    end;
-   
-   
+
+
   procedure proc_value_pointerdef(p : pchar);saveregisters;
    begin
      global_ptr:=p;
@@ -277,23 +285,23 @@ var
    begin
      global_proc:=p;
    end;
-   
-   
 
-   
+
+
+
   procedure proc_value_smallrecord(smallrec : tsmallrecord);saveregisters;
    begin
      if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then
        global_u8bit := RESULT_U8BIT;
    end;
-   
+
 
   procedure proc_value_largerecord(largerec : tlargerecord);saveregisters;
    begin
      if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then
        global_u8bit := RESULT_U8BIT;
    end;
-   
+
   procedure proc_value_smallset(smallset : tsmallset);saveregisters;
    begin
      if A_D in smallset then
@@ -306,13 +314,13 @@ var
      if 'I' in largeset then
        global_u8bit := RESULT_U8BIT;
    end;
-   
+
   procedure proc_value_smallstring(s:tsmallstring);saveregisters;
    begin
      if s = RESULT_SMALLSTRING then
        global_u8bit := RESULT_u8BIT;
    end;
-    
+
 
   procedure proc_value_bigstring(s:shortstring);saveregisters;
    begin
@@ -326,7 +334,7 @@ var
     if arr[SMALL_INDEX] = RESULT_U8BIT then
       global_u8bit := RESULT_U8BIT;
   end;
-  
+
   procedure proc_value_smallarray_open(arr : array of byte);saveregisters;
   begin
     { form 0 to N-1 indexes in open arrays }
@@ -334,7 +342,7 @@ var
       global_u8bit := RESULT_U8BIT;
   end;
 
-{$ifdef fpc}
+{$ifndef tp}
   procedure proc_value_classrefdef(obj : tclass1);saveregisters;
    begin
      global_class:=obj;
@@ -347,11 +355,11 @@ var
   begin
     for i:=0 to high(arr) do
      begin
-       case arr[i].vtype of 
+       case arr[i].vtype of
         vtInteger : global_u8bit := arr[i].vinteger and $ff;
         vtBoolean : global_boolean := arr[i].vboolean;
         vtChar : global_char := arr[i].vchar;
-        vtExtended : global_s64real := arr[i].VExtended^; 
+        vtExtended : global_s64real := arr[i].VExtended^;
         vtString :  global_bigstring := arr[i].VString^;
         vtPointer : ;
         vtPChar : global_ptr := arr[i].VPchar;
@@ -364,7 +372,7 @@ var
        end;
      end; {endfor}
   end;
-  
+
 
   procedure proc_value_smallarray_const_2(arr : array of const);saveregisters;
   var
@@ -381,7 +389,7 @@ var
 {$endif}
 
  {********************************* MIXED PARAMETERS *************************}
- 
+
   procedure proc_value_u8bit_mixed(b1 : byte; v: byte; b2: byte);saveregisters;
    begin
      global_u8bit := v;
@@ -401,10 +409,10 @@ var
      global_s32bit := v;
      value_u8bit := b2;
    end;
-   
 
-   
-   
+
+
+
   procedure proc_value_bool8bit_mixed(b1: byte; v: boolean; b2: byte);saveregisters;
    begin
      { boolean should be 8-bit always! }
@@ -433,14 +441,14 @@ var
      global_s32real := v;
      value_u8bit := b2;
    end;
-   
+
   procedure proc_value_s64real_mixed(b1: byte; v: double; b2: byte);saveregisters;
    begin
      global_s64real:= v;
      value_u8bit := b2;
    end;
-   
-   
+
+
   procedure proc_value_pointerdef_mixed(b1: byte; p : pchar; b2: byte);saveregisters;
    begin
      global_ptr:=p;
@@ -453,8 +461,8 @@ var
      global_proc:=p;
      value_u8bit := b2;
    end;
-   
-   
+
+
 
 
   procedure proc_value_smallrecord_mixed(b1: byte; smallrec : tsmallrecord; b2: byte);saveregisters;
@@ -463,7 +471,7 @@ var
        global_u8bit := RESULT_U8BIT;
      value_u8bit := b2;
    end;
-   
+
 
   procedure proc_value_largerecord_mixed(b1: byte; largerec : tlargerecord; b2: byte);saveregisters;
    begin
@@ -471,14 +479,14 @@ var
        global_u8bit := RESULT_U8BIT;
      value_u8bit := b2;
    end;
-   
+
   procedure proc_value_smallset_mixed(b1: byte; smallset : tsmallset; b2: byte);saveregisters;
    begin
      if A_D in smallset then
        global_u8bit := RESULT_U8BIT;
      value_u8bit := b2;
    end;
-   
+
 
   procedure proc_value_largeset_mixed(b1: byte; largeset : tlargeset; b2: byte);saveregisters;
    begin
@@ -486,14 +494,14 @@ var
        global_u8bit := RESULT_U8BIT;
      value_u8bit := b2;
    end;
-   
+
   procedure proc_value_smallstring_mixed(b1: byte; s:tsmallstring; b2: byte);saveregisters;
    begin
      if s = RESULT_SMALLSTRING then
        global_u8bit := RESULT_u8BIT;
      value_u8bit := b2;
    end;
-    
+
 
   procedure proc_value_bigstring_mixed(b1: byte; s:shortstring; b2: byte);saveregisters;
    begin
@@ -501,7 +509,7 @@ var
        global_u8bit := RESULT_u8BIT;
      value_u8bit := b2;
    end;
-   
+
 
   procedure proc_value_smallarray_mixed(b1: byte; arr : tsmallarray; b2: byte);saveregisters;
   begin
@@ -509,7 +517,7 @@ var
       global_u8bit := RESULT_U8BIT;
      value_u8bit := b2;
   end;
-  
+
   procedure proc_value_smallarray_open_mixed(b1: byte; arr : array of byte; b2: byte);saveregisters;
   begin
     { form 0 to N-1 indexes in open arrays }
@@ -518,7 +526,7 @@ var
      value_u8bit := b2;
   end;
 
-{$ifdef fpc}
+{$ifndef tp}
   procedure proc_value_classrefdef_mixed(b1: byte; obj : tclass1; b2: byte);saveregisters;
    begin
      global_class:=obj;
@@ -532,18 +540,18 @@ var
      value_u8bit := b2;
    end;
 
-  
+
   procedure proc_value_smallarray_const_1_mixed(b1: byte; arr : array of const; b2: byte);saveregisters;
   var
    i: integer;
   begin
     for i:=0 to high(arr) do
      begin
-       case arr[i].vtype of 
+       case arr[i].vtype of
         vtInteger : global_u8bit := arr[i].vinteger and $ff;
         vtBoolean : global_boolean := arr[i].vboolean;
         vtChar : global_char := arr[i].vchar;
-        vtExtended : global_s64real := arr[i].VExtended^; 
+        vtExtended : global_s64real := arr[i].VExtended^;
         vtString :  global_bigstring := arr[i].VString^;
         vtPointer : ;
         vtPChar : global_ptr := arr[i].VPchar;
@@ -557,7 +565,7 @@ var
      end; {endfor}
      value_u8bit := b2;
   end;
-  
+
 
   procedure proc_value_smallarray_const_2_mixed(b1: byte; arr : array of const; b2: byte);saveregisters;
   var
@@ -569,7 +577,7 @@ var
   end;
 {$endif}
 
- 
+
 
 var
  failed: boolean;
@@ -577,9 +585,9 @@ Begin
   {***************************** NORMAL TESTS *******************************}
   clear_globals;
   clear_values;
-  
+
   failed:=false;
-  
+
   { LOC_REGISTER }
   write('Value parameter test (src : LOC_REGISTER)...');
   proc_value_u8bit(getu8bit);
@@ -591,7 +599,7 @@ Begin
   proc_value_s32bit(gets32bit);
   if global_s32bit <> RESULT_S32BIT then
     failed:=true;
-{$ifdef fpc}
+{$ifndef tp}
   proc_value_s64bit(gets64bit);
   if global_s64bit <> RESULT_S64BIT then
     failed:=true;
@@ -600,9 +608,9 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
-    
-  { LOC_FPUREGISTER }  
+
+
+  { LOC_FPUREGISTER }
   clear_globals;
   clear_values;
   failed:=false;
@@ -617,22 +625,22 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
 
-  { LOC_MEM, LOC_REFERENCE orddef } 
+
+  { LOC_MEM, LOC_REFERENCE orddef }
   clear_globals;
   clear_values;
   value_u8bit := RESULT_U8BIT;
   value_u16bit := RESULT_U16BIT;
   value_s32bit := RESULT_S32BIT;
-{$ifdef fpc}
+{$ifndef tp}
   value_s64bit := RESULT_S64BIT;
 {$endif}
   value_s32real := RESULT_S32REAL;
   value_s64real  := RESULT_S64REAL;
 
   failed:=false;
-  
+
   { LOC_REFERENCE }
   write('Value parameter test (src : LOC_REFERENCE (orddef/enumdef)))...');
   proc_value_u8bit(value_u8bit);
@@ -644,7 +652,7 @@ Begin
   proc_value_s32bit(value_s32bit);
   if global_s32bit <> RESULT_S32BIT then
     failed:=true;
-{$ifdef fpc}
+{$ifndef tp}
   proc_value_s64bit(value_s64bit);
   if global_s64bit <> RESULT_S64BIT then
     failed:=true;
@@ -653,9 +661,9 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
-    
-  { LOC_REFERENCE }  
+
+
+  { LOC_REFERENCE }
   clear_globals;
   failed:=false;
   write('Value parameter test (src : LOC_REFERENCE (floatdef))...');
@@ -669,7 +677,7 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
+
 
 
   write('Value parameter test (src : LOC_REFERENCE (pointer))...');
@@ -682,12 +690,12 @@ Begin
     failed := true;
 
 
-  value_proc := {$ifdef fpc}@{$endif}testprocedure;
+  value_proc := {$ifndef tp}@{$endif}testprocedure;
   proc_value_procvardef(value_proc);
   if {$ifndef fpc}@{$endif}value_proc <> {$ifndef fpc}@{$endif}global_proc then
     failed := true;
 
-{$ifdef fpc}
+{$ifndef tp}
   value_class := tclass1.create;
   proc_value_classrefdef(value_class);
   if value_class <> global_class then
@@ -711,7 +719,7 @@ Begin
   proc_value_bool8bit(value_u8bit = 0);
   if global_u8bit <> RESULT_BOOL8BIT then
     failed:=true;
-{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x 
+{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x
   proc_value_bool16bit(value_s64bit < 0);
   if global_u16bit <> RESULT_BOOL16BIT then
     failed:=true;
@@ -725,7 +733,7 @@ Begin
 
 
 
-{$ifdef fpc}
+{$ifndef tp}
   clear_globals;
   clear_values;
   failed:=false;
@@ -733,7 +741,7 @@ Begin
   proc_value_bool8bit(value_s64bit = 0);
   if global_u8bit <> RESULT_BOOL8BIT then
     failed:=true;
-{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x 
+{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x
   proc_value_bool16bit(value_s64bit < 0);
   if global_u16bit <> RESULT_BOOL16BIT then
     failed:=true;
@@ -769,38 +777,38 @@ Begin
   proc_value_largerecord(value_largerec);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
-    
-    
+
+
   write('Value parameter test (src : LOC_REFERENCE (setdef)))...');
   clear_globals;
   clear_values;
   failed := false;
-  
+
   value_smallset := [A_A,A_D];
   proc_value_smallset(value_smallset);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   value_largeset := ['I'];
   proc_value_largeset(value_largeset);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
 
-    
+
 
 
   write('Value parameter test (src : LOC_REFERENCE (stringdef)))...');
@@ -812,14 +820,14 @@ Begin
   proc_value_smallstring(value_smallstring);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   value_bigstring := RESULT_BIGSTRING;
   proc_value_bigstring(value_bigstring);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
@@ -829,14 +837,14 @@ Begin
 
   { open array by value with cdecl modifier!!!!!!!!!!!!!!!!!!!!!!!!!!!}
   { DON'T KNOW WHY/HOW TO TEST!!!!!                                   }
-  
-  
+
+
   write('Value parameter test (src : LOC_REFERENCE (arraydef)))...');
-  
+
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   fillchar(value_smallarray,sizeof(value_smallarray),#0);
   value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
   proc_value_smallarray(value_smallarray);
@@ -852,7 +860,7 @@ Begin
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
 
-{$ifdef fpc}
+{$ifndef tp}
   clear_globals;
   clear_values;
 
@@ -866,10 +874,10 @@ Begin
   value_s64real:=RESULT_S64REAL;
   proc_value_smallarray_const_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real,
     value_boolean,value_class]);
-  
+
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if global_char <> RESULT_CHAR then
     failed := true;
   if global_boolean <> RESULT_BOOLEAN then
@@ -901,9 +909,9 @@ Begin
   {***************************** MIXED  TESTS *******************************}
   clear_globals;
   clear_values;
-  
+
   failed:=false;
-  
+
   { LOC_REGISTER }
   write('Mixed value parameter test (src : LOC_REGISTER)...');
   proc_value_u8bit_mixed(byte(NOT RESULT_U8BIT),getu8bit,RESULT_U8BIT);
@@ -921,7 +929,7 @@ Begin
     failed:=true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-{$ifdef fpc}
+{$ifndef tp}
   proc_value_s64bit_mixed(byte(NOT RESULT_U8BIT),gets64bit,RESULT_U8BIT);
   if global_s64bit <> RESULT_S64BIT then
     failed:=true;
@@ -933,9 +941,9 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
-    
-  { LOC_FPUREGISTER }  
+
+
+  { LOC_FPUREGISTER }
   clear_globals;
   clear_values;
   failed:=false;
@@ -954,22 +962,22 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
 
-  { LOC_MEM, LOC_REFERENCE orddef } 
+
+  { LOC_MEM, LOC_REFERENCE orddef }
   clear_globals;
   clear_values;
   value_u8bit := RESULT_U8BIT;
   value_u16bit := RESULT_U16BIT;
   value_s32bit := RESULT_S32BIT;
-{$ifdef fpc}
+{$ifndef tp}
   value_s64bit := RESULT_S64BIT;
 {$endif}
   value_s32real := RESULT_S32REAL;
   value_s64real  := RESULT_S64REAL;
 
   failed:=false;
-  
+
   { LOC_REFERENCE }
   write('Mixed value parameter test (src : LOC_REFERENCE (orddef/enumdef)))...');
   proc_value_u8bit_mixed(byte(NOT RESULT_U8BIT),value_u8bit, RESULT_U8BIT);
@@ -987,7 +995,7 @@ Begin
     failed:=true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-{$ifdef fpc}
+{$ifndef tp}
   proc_value_s64bit_mixed(byte(NOT RESULT_U8BIT), value_s64bit, RESULT_U8BIT);
   if global_s64bit <> RESULT_S64BIT then
     failed:=true;
@@ -999,9 +1007,9 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
-    
-  { LOC_REFERENCE }  
+
+
+  { LOC_REFERENCE }
   clear_globals;
   failed:=false;
   write('Mixed value parameter test (src : LOC_REFERENCE (floatdef))...');
@@ -1020,7 +1028,7 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
+
 
 
   write('Mixed value parameter test (src : LOC_REFERENCE (pointer))...');
@@ -1035,12 +1043,12 @@ Begin
     failed := true;
 
 
-  value_proc := {$ifdef fpc}@{$endif}testprocedure;
+  value_proc := {$ifndef tp}@{$endif}testprocedure;
   proc_value_procvardef_mixed(byte(NOT RESULT_U8BIT), value_proc, RESULT_U8BIT);
   if {$ifndef fpc}@{$endif}value_proc <> {$ifndef fpc}@{$endif}global_proc then
     failed := true;
 
-{$ifdef fpc}
+{$ifndef tp}
   value_class := tclass1.create;
   proc_value_classrefdef_mixed(byte(NOT RESULT_U8BIT), value_class, RESULT_U8BIT);
   if value_class <> global_class then
@@ -1068,7 +1076,7 @@ Begin
     failed:=true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x 
+{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x
   proc_value_bool16bit(value_s64bit < 0);
   if global_u16bit <> RESULT_BOOL16BIT then
     failed:=true;
@@ -1081,8 +1089,8 @@ Begin
     WriteLn('Passed!');
 
 
-    
-{$ifdef fpc}
+
+{$ifndef tp}
   clear_globals;
   clear_values;
   failed:=false;
@@ -1092,7 +1100,7 @@ Begin
     failed:=true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x 
+{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x
   proc_value_bool16bit(value_s64bit < 0);
   if global_u16bit <> RESULT_BOOL16BIT then
     failed:=true;
@@ -1104,7 +1112,7 @@ Begin
   else
     WriteLn('Passed!');
 {$endif}
-     
+
   { arraydef,
     recorddef,
     objectdef,
@@ -1132,26 +1140,26 @@ Begin
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
-    
-    
+
+
   write('Mixed value parameter test (src : LOC_REFERENCE (setdef)))...');
   clear_globals;
   clear_values;
   failed := false;
-  
+
   value_smallset := [A_A,A_D];
   proc_value_smallset_mixed(byte(NOT RESULT_U8BIT), value_smallset, RESULT_U8BIT);
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   value_largeset := ['I'];
@@ -1160,14 +1168,14 @@ Begin
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
 
-    
+
 
 
   write('Mixed value parameter test (src : LOC_REFERENCE (stringdef)))...');
@@ -1181,7 +1189,7 @@ Begin
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   value_bigstring := RESULT_BIGSTRING;
@@ -1190,7 +1198,7 @@ Begin
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
@@ -1200,14 +1208,14 @@ Begin
 
   { open array by value with cdecl modifier!!!!!!!!!!!!!!!!!!!!!!!!!!!}
   { DON'T KNOW WHY/HOW TO TEST!!!!!                                   }
-  
-  
+
+
   write('Mixed value parameter test (src : LOC_REFERENCE (arraydef)))...');
-  
+
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   fillchar(value_smallarray,sizeof(value_smallarray),#0);
   value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
   proc_value_smallarray_mixed(byte(NOT RESULT_U8BIT), value_smallarray, RESULT_U8BIT);
@@ -1227,7 +1235,7 @@ Begin
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
 
-{$ifdef fpc}
+{$ifndef tp}
   clear_globals;
   clear_values;
 
@@ -1244,10 +1252,10 @@ Begin
      RESULT_U8BIT);
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-  
+
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if global_char <> RESULT_CHAR then
     failed := true;
   if global_boolean <> RESULT_BOOLEAN then
@@ -1257,7 +1265,7 @@ Begin
   if global_bigstring <> RESULT_SMALLSTRING then
      failed := true;
   if global_ptr <> value_ptr then
-     failed := true; 
+     failed := true;
 {  if value_class <> global_class then
      failed := true;!!!!!!!!!!!!!!!!!!!!}
   if global_s64bit <> RESULT_S64BIT then
@@ -1277,13 +1285,16 @@ Begin
     fail
   else
     WriteLn('Passed!');
-    
+
 end.
 
 
 {
   $Log$
-  Revision 1.1  2002-04-13 17:49:45  carl
+  Revision 1.2  2002-05-13 13:45:38  peter
+    * updated to compile tests with kylix
+
+  Revision 1.1  2002/04/13 17:49:45  carl
   + value parameter passing for different calling conventions
 
 }

tests/test/cg/tcalvar1.pp

@@ -24,6 +24,9 @@ program tcalvar1;
 {$P-}
 {$V+}
 
+{$ifdef VER70}
+  {$define tp}
+{$endif}
 
 
  { REAL should map to single or double }
@@ -34,11 +37,16 @@ program tcalvar1;
 
  const
 { should be defined depending on CPU target }
-{$ifdef cpu68k}
-  BIG_INDEX = 8000;
-  SMALL_INDEX  = 13;
-{$endif}
-{$ifdef cpui386}
+{$ifdef fpc}
+  {$ifdef cpu68k}
+    BIG_INDEX = 8000;
+    SMALL_INDEX  = 13;
+  {$endif}
+  {$ifdef cpui386}
+    BIG_INDEX = 33000;
+    SMALL_INDEX = 13;     { value should not be aligned! }
+  {$endif}
+{$else}
   BIG_INDEX = 33000;
   SMALL_INDEX = 13;     { value should not be aligned! }
 {$endif}
@@ -56,36 +64,36 @@ program tcalvar1;
   RESULT_SMALLSTRING = 'H';
   RESULT_CHAR = 'I';
   RESULT_BOOLEAN = TRUE;
-  
-type 
+
+type
   tclass1 = class
   end;
-  
+
   tprocedure = procedure;
-  
+
   tsmallrecord = packed record
     b: byte;
     w: word;
   end;
-  
+
   tlargerecord = packed record
     b: array[1..BIG_INDEX] of byte;
   end;
-  
+
   tsmallarray = packed array[1..SMALL_INDEX] of byte;
-  
-  tsmallsetenum = 
+
+  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;
@@ -117,14 +125,14 @@ var
  value_smallarray : tsmallarray;
  value_boolean : boolean;
  value_char : char;
- 
+
     procedure fail;
     begin
       WriteLn('Failure.');
       halt(1);
     end;
-    
-    
+
+
     procedure clear_globals;
      begin
       global_u8bit := 0;
@@ -140,8 +148,8 @@ var
       global_boolean := false;
       global_char := #0;
      end;
-     
-     
+
+
     procedure clear_values;
      begin
       value_u8bit := 0;
@@ -163,8 +171,8 @@ var
       value_boolean := false;
       value_char:=#0;
      end;
-     
-   
+
+
   procedure testprocedure;
    begin
    end;
@@ -173,22 +181,22 @@ var
     begin
       getu8bit:=RESULT_U8BIT;
     end;
-    
+
    function getu16bit: word;
      begin
        getu16bit:=RESULT_U16BIT;
      end;
-     
+
    function gets32bit: longint;
     begin
       gets32bit:=RESULT_S32BIT;
     end;
-    
+
    function gets64bit: longint;
     begin
       gets64bit:=RESULT_S32BIT;
     end;
- 
+
 
    function gets32real: single;
     begin
@@ -207,7 +215,7 @@ var
    begin
      v:=RESULT_S32BIT;
    end;
-   
+
   procedure proc_var_s64bit(var v: int64);
    begin
      v:=RESULT_S64BIT;
@@ -218,7 +226,7 @@ var
    begin
      v:=RESULT_U8BIT;
    end;
-   
+
   procedure proc_var_smallrecord(var smallrec : tsmallrecord);
    begin
      smallrec.b := RESULT_U8BIT;
@@ -237,38 +245,38 @@ var
    begin
      smallset := [A_A,A_D];
    end;
-   
-   
+
+
   procedure proc_var_largeset(var largeset : tlargeset);
    begin
      largeset:= largeset + ['I'];
    end;
-   
+
 
   procedure proc_var_smallstring(var s:tsmallstring);
    begin
      s:=RESULT_SMALLSTRING;
    end;
-    
+
 
   procedure proc_var_bigstring(var s:shortstring);
    begin
      s:=RESULT_BIGSTRING;
    end;
-   
+
 
   procedure proc_var_openstring(var s: OpenString);
    begin
     global_u8bit := high(s);
     s:=RESULT_SMALLSTRING;
    end;
-   
+
   procedure proc_var_smallarray(var arr : tsmallarray);
   begin
     arr[SMALL_INDEX] := RESULT_U8BIT;
     arr[1] := RESULT_U8BIT;
   end;
-  
+
   procedure proc_var_smallarray_open(var arr : array of byte);
   begin
     arr[high(arr)] := RESULT_U8BIT;
@@ -281,7 +289,7 @@ var
   begin
     for i:=0 to high(arr) do
      begin
-       case arr[i].vtype of 
+       case arr[i].vtype of
         vtInteger : arr[i].vinteger := RESULT_U8BIT;
         vtBoolean : arr[i].vboolean := RESULT_BOOLEAN;
         else
@@ -289,7 +297,7 @@ var
        end;
      end; {endfor}
   end;
-  
+
 
   procedure proc_var_smallarray_const_2(var arr : array of const);
   var
@@ -298,7 +306,7 @@ var
      if high(arr)<0 then
        global_u8bit := RESULT_U8BIT;
   end;
-   
+
 
   procedure proc_var_formaldef_array(var buf);
   var
@@ -320,7 +328,7 @@ procedure proc_var_formaldef_string(var buf);
     p[SMALL_INDEX-1] := RESULT_U8BIT;
     p[0] := RESULT_U8BIT;
   end;
-   
+
 
   {************************************************************************}
   {                     MIXED   VAR PARAMETERS                             }
@@ -330,7 +338,7 @@ procedure proc_var_formaldef_string(var buf);
      v:=RESULT_S32BIT;
      value_u8bit := RESULT_U8BIT;
    end;
-   
+
   procedure proc_var_s64bit_mixed(b1 : byte;var v: int64; b2: byte);
    begin
      v:=RESULT_S64BIT;
@@ -343,7 +351,7 @@ procedure proc_var_formaldef_string(var buf);
      v:=RESULT_U8BIT;
      value_u8bit := RESULT_U8BIT;
    end;
-   
+
   procedure proc_var_smallrecord_mixed(b1 : byte; var smallrec : tsmallrecord; b2: byte);
    begin
      smallrec.b := RESULT_U8BIT;
@@ -365,28 +373,28 @@ procedure proc_var_formaldef_string(var buf);
      smallset := [A_A,A_D];
      value_u8bit := RESULT_U8BIT;
    end;
-   
-   
+
+
   procedure proc_var_largeset_mixed(b1 : byte; var largeset : tlargeset; b2: byte);
    begin
      largeset:= largeset + ['I'];
      value_u8bit := RESULT_U8BIT;
    end;
-   
+
 
   procedure proc_var_smallstring_mixed(b1 : byte; var s:tsmallstring; b2: byte);
    begin
      s:=RESULT_SMALLSTRING;
      value_u8bit := RESULT_U8BIT;
    end;
-    
+
 
   procedure proc_var_bigstring_mixed(b1 : byte; var s:shortstring; b2: byte);
    begin
      s:=RESULT_BIGSTRING;
      value_u8bit := RESULT_U8BIT;
    end;
-   
+
 
   procedure proc_var_openstring_mixed(b1 : byte; var s: OpenString; b2: byte);
    begin
@@ -394,14 +402,14 @@ procedure proc_var_formaldef_string(var buf);
     s:=RESULT_SMALLSTRING;
     value_u8bit := RESULT_U8BIT;
    end;
-   
+
   procedure proc_var_smallarray_mixed(b1 : byte; var arr : tsmallarray; b2: byte);
   begin
     arr[SMALL_INDEX] := RESULT_U8BIT;
     arr[1] := RESULT_U8BIT;
     value_u8bit := RESULT_U8BIT;
   end;
-  
+
   procedure proc_var_smallarray_open_mixed(b1 : byte; var arr : array of byte; b2: byte);
   begin
     arr[high(arr)] := RESULT_U8BIT;
@@ -415,7 +423,7 @@ procedure proc_var_formaldef_string(var buf);
   begin
     for i:=0 to high(arr) do
      begin
-       case arr[i].vtype of 
+       case arr[i].vtype of
         vtInteger : arr[i].vinteger := RESULT_U8BIT;
         vtBoolean : arr[i].vboolean := RESULT_BOOLEAN;
         else
@@ -424,7 +432,7 @@ procedure proc_var_formaldef_string(var buf);
      end; {endfor}
      value_u8bit := RESULT_U8BIT;
  end;
-  
+
 
   procedure proc_var_smallarray_const_2_mixed(b1 : byte; var arr : array of const; b2: byte);
   var
@@ -434,7 +442,7 @@ procedure proc_var_formaldef_string(var buf);
        global_u8bit := RESULT_U8BIT;
      value_u8bit := RESULT_U8BIT;
 end;
-   
+
 
   procedure proc_var_formaldef_array_mixed(b1 : byte; var buf; b2: byte);
   var
@@ -467,7 +475,7 @@ begin
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   write('Var parameter test (src : LOC_REFERENCE (orddef)))...');
   proc_var_s32bit(global_s32bit);
   if global_s32bit <> RESULT_S32BIT then
@@ -490,7 +498,7 @@ begin
     fail
   else
     WriteLn('Passed!');
-  
+
   write('Var parameter test (src : LOC_REFERENCE (recorddef)))...');
   clear_globals;
   clear_values;
@@ -499,34 +507,34 @@ begin
   proc_var_smallrecord(value_smallrec);
   if (value_smallrec.b <> RESULT_U8BIT) or (value_smallrec.w <> RESULT_U16BIT) then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   proc_var_largerecord(value_largerec);
   if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[2] <> RESULT_U8BIT) then
     failed := true;
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
-    
+
   write('var parameter test (src : LOC_REFERENCE (setdef)))...');
   clear_globals;
   clear_values;
   failed := false;
-  
+
   proc_var_smallset(value_smallset);
   if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   proc_var_largeset(value_largeset);
   if not ('I' in value_largeset) then
     failed := true;
-    
+
   if failed then
     fail
   else
@@ -553,18 +561,18 @@ begin
   if (value_smallstring <> RESULT_SMALLSTRING) or (global_u8bit <> high(value_smallstring)) then
     failed := true;
 
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
-    
+
   write('Var parameter test (src : LOC_REFERENCE (formaldef)))...');
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   proc_var_formaldef_array(value_smallarray);
   if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
     failed := true;
@@ -576,11 +584,11 @@ begin
     WriteLn('Passed!');
 
   write('Var parameter test (src : LOC_REFERENCE (arraydef)))...');
-  
+
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
   proc_var_smallarray(value_smallarray);
   if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
@@ -594,7 +602,7 @@ begin
   proc_var_smallarray_open(value_smallarray);
   if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
     failed := true;
-    
+
 (*   HOW CAN ARRAY OF CONST VAR PARAMETERS BE TESTED?
   clear_globals;
   clear_values;
@@ -607,10 +615,10 @@ begin
   value_char := RESULT_CHAR;
   value_s64real:=RESULT_S64REAL;
   proc_var_smallarray_var_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real,value_boolean,value_class]);
-  
+
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if global_char <> RESULT_CHAR then
     failed := true;
   if global_boolean <> RESULT_BOOLEAN then
@@ -620,7 +628,7 @@ begin
   if global_bigstring <> RESULT_SMALLSTRING then
      failed := true;
   if global_ptr <> value_ptr then
-     failed := true; 
+     failed := true;
 {  if value_class <> global_class then
      failed := true;!!!!!!!!!!!!!!!!!!!!}
   if global_s64bit <> RESULT_S64BIT then
@@ -638,12 +646,12 @@ begin
     fail
   else
     WriteLn('Passed!');
-    
+
   {***************************** MIXED  TESTS *******************************}
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   write('Var parameter test (src : LOC_REFERENCE (orddef)))...');
   proc_var_s32bit_mixed(RESULT_U8BIT, global_s32bit, RESULT_U8BIT);
   if global_s32bit <> RESULT_S32BIT then
@@ -672,7 +680,7 @@ begin
     fail
   else
     WriteLn('Passed!');
-  
+
   write('Var parameter test (src : LOC_REFERENCE (recorddef)))...');
   clear_globals;
   clear_values;
@@ -683,7 +691,7 @@ begin
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   proc_var_largerecord_mixed(RESULT_U8BIT, value_largerec, RESULT_U8BIT);
@@ -691,24 +699,24 @@ begin
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
-    
+
   write('var parameter test (src : LOC_REFERENCE (setdef)))...');
   clear_globals;
   clear_values;
   failed := false;
-  
+
   proc_var_smallset_mixed(RESULT_U8BIT, value_smallset, RESULT_U8BIT);
   if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   proc_var_largeset_mixed(RESULT_U8BIT, value_largeset, RESULT_U8BIT);
@@ -716,7 +724,7 @@ begin
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
@@ -749,18 +757,18 @@ begin
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
 
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
-    
+
   write('Var parameter test (src : LOC_REFERENCE (formaldef)))...');
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   proc_var_formaldef_array_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT);
   if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
     failed := true;
@@ -774,11 +782,11 @@ begin
     WriteLn('Passed!');
 
   write('Var parameter test (src : LOC_REFERENCE (arraydef)))...');
-  
+
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
   proc_var_smallarray_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT);
   if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
@@ -801,13 +809,16 @@ begin
     fail
   else
     WriteLn('Passed!');
-  
+
 end.
 
 
 {
   $Log$
-  Revision 1.1  2002-04-10 16:33:19  carl
+  Revision 1.2  2002-05-13 13:45:38  peter
+    * updated to compile tests with kylix
+
+  Revision 1.1  2002/04/10 16:33:19  carl
   + first tries at first calln testing
 
 

tests/test/cg/tcalvar2.pp

@@ -24,6 +24,9 @@ program tcalvar2;
 {$V+}
 {$R+}
 
+{$ifdef VER70}
+  {$define tp}
+{$endif}
 
 
  { REAL should map to single or double }
@@ -34,11 +37,16 @@ program tcalvar2;
 
  const
 { should be defined depending on CPU target }
-{$ifdef cpu68k}
-  BIG_INDEX = 8000;
-  SMALL_INDEX  = 13;
-{$endif}
-{$ifdef cpui386}
+{$ifdef fpc}
+  {$ifdef cpu68k}
+    BIG_INDEX = 8000;
+    SMALL_INDEX  = 13;
+  {$endif}
+  {$ifdef cpui386}
+    BIG_INDEX = 33000;
+    SMALL_INDEX = 13;     { value should not be aligned! }
+  {$endif}
+{$else}
   BIG_INDEX = 33000;
   SMALL_INDEX = 13;     { value should not be aligned! }
 {$endif}
@@ -56,36 +64,36 @@ program tcalvar2;
   RESULT_SMALLSTRING = 'H';
   RESULT_CHAR = 'I';
   RESULT_BOOLEAN = TRUE;
-  
-type 
+
+type
   tclass1 = class
   end;
-  
+
   tprocedure = procedure;
-  
+
   tsmallrecord = packed record
     b: byte;
     w: word;
   end;
-  
+
   tlargerecord = packed record
     b: array[1..BIG_INDEX] of byte;
   end;
-  
+
   tsmallarray = packed array[1..SMALL_INDEX] of byte;
-  
-  tsmallsetenum = 
+
+  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;
@@ -117,14 +125,14 @@ var
  value_smallarray : tsmallarray;
  value_boolean : boolean;
  value_char : char;
- 
+
     procedure fail;
     begin
       WriteLn('Failure.');
       halt(1);
     end;
-    
-    
+
+
     procedure clear_globals;
      begin
       global_u8bit := 0;
@@ -140,8 +148,8 @@ var
       global_boolean := false;
       global_char := #0;
      end;
-     
-     
+
+
     procedure clear_values;
      begin
       value_u8bit := 0;
@@ -163,8 +171,8 @@ var
       value_boolean := false;
       value_char:=#0;
      end;
-     
-   
+
+
   procedure testprocedure;
    begin
    end;
@@ -173,22 +181,22 @@ var
     begin
       getu8bit:=RESULT_U8BIT;
     end;
-    
+
    function getu16bit: word;
      begin
        getu16bit:=RESULT_U16BIT;
      end;
-     
+
    function gets32bit: longint;
     begin
       gets32bit:=RESULT_S32BIT;
     end;
-    
+
    function gets64bit: longint;
     begin
       gets64bit:=RESULT_S32BIT;
     end;
- 
+
 
    function gets32real: single;
     begin
@@ -207,7 +215,7 @@ var
    begin
      v:=RESULT_S32BIT;
    end;
-   
+
   procedure proc_var_s64bit_inline(var v: int64);inline;
    begin
      v:=RESULT_S64BIT;
@@ -218,7 +226,7 @@ var
    begin
      v:=RESULT_U8BIT;
    end;
-   
+
   procedure proc_var_smallrecord_inline(var smallrec : tsmallrecord);inline;
    begin
      smallrec.b := RESULT_U8BIT;
@@ -237,52 +245,52 @@ var
    begin
      smallset := [A_A,A_D];
    end;
-   
-   
+
+
   procedure proc_var_largeset_inline(var largeset : tlargeset);inline;
    begin
      largeset:= largeset + ['I'];
    end;
-   
+
 
   procedure proc_var_smallstring_inline(var s:tsmallstring);inline;
    begin
      s:=RESULT_SMALLSTRING;
    end;
-    
+
 
   procedure proc_var_bigstring_inline(var s:shortstring);inline;
    begin
      s:=RESULT_BIGSTRING;
    end;
-   
+
 
   procedure proc_var_openstring_inline(var s: OpenString);inline;
    begin
     global_u8bit := high(s);
     s:=RESULT_SMALLSTRING;
    end;
-   
+
   procedure proc_var_smallarray_inline(var arr : tsmallarray);inline;
   begin
     arr[SMALL_INDEX] := RESULT_U8BIT;
     arr[1] := RESULT_U8BIT;
   end;
-  
+
   procedure proc_var_smallarray_open_inline(var arr : array of byte);inline;
   begin
     arr[high(arr)] := RESULT_U8BIT;
     arr[low(arr)] := RESULT_U8BIT;
   end;
 
-{!!!!!!!!!!!!!!!!!! DON'T KNOW HOWTO TEST}  
+{!!!!!!!!!!!!!!!!!! DON'T KNOW HOWTO TEST}
   procedure proc_var_smallarray_const_1_inline(var arr : array of const);inline;
   var
    i: integer;
   begin
     for i:=0 to high(arr) do
      begin
-       case arr[i].vtype of 
+       case arr[i].vtype of
         vtInteger : arr[i].vinteger := RESULT_U8BIT;
         vtBoolean : arr[i].vboolean := RESULT_BOOLEAN;
         else
@@ -290,7 +298,7 @@ var
        end;
      end; {endfor}
   end;
-  
+
 
   procedure proc_var_smallarray_const_2_inline(var arr : array of const);inline;
   var
@@ -299,7 +307,7 @@ var
      if high(arr)<0 then
        global_u8bit := RESULT_U8BIT;
   end;
-   
+
 
   procedure proc_var_formaldef_array_inline(var buf);inline;
   var
@@ -336,13 +344,13 @@ begin
   proc_var_smallrecord_inline(value_smallrec);
   if (value_smallrec.b <> RESULT_U8BIT) or (value_smallrec.w <> RESULT_U16BIT) then
     failed := true;
- 
+
   clear_globals;
   clear_values;
   proc_var_largerecord_inline(value_largerec);
   if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[2] <> RESULT_U8BIT) then
     failed := true;
-    
+
   if failed then
     fail
   else
@@ -352,17 +360,17 @@ begin
   clear_globals;
   clear_values;
   failed := false;
-  
+
   proc_var_smallset_inline(value_smallset);
   if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   proc_var_largeset_inline(value_largeset);
   if not ('I' in value_largeset) then
     failed := true;
-    
+
   if failed then
     fail
   else
@@ -388,7 +396,7 @@ begin
   if (value_smallstring <> RESULT_SMALLSTRING) or (global_u8bit <> high(value_smallstring)) then
     failed := true;
 
-    
+
   if failed then
     fail
   else
@@ -398,7 +406,7 @@ begin
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   proc_var_formaldef_array_inline(value_smallarray);
   if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
     failed := true;
@@ -410,11 +418,11 @@ begin
     WriteLn('Passed!');
 
   write('(Inline) Var parameter test (src : LOC_REFERENCE (arraydef)))...');
-  
+
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
   proc_var_smallarray_inline(value_smallarray);
   if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
@@ -442,10 +450,10 @@ begin
   value_char := RESULT_CHAR;
   value_s64real:=RESULT_S64REAL;
   proc_var_smallarray_var_1_inline([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real,value_boolean,value_class]);
-  
+
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if global_char <> RESULT_CHAR then
     failed := true;
   if global_boolean <> RESULT_BOOLEAN then
@@ -455,7 +463,7 @@ begin
   if global_bigstring <> RESULT_SMALLSTRING then
      failed := true;
   if global_ptr <> value_ptr then
-     failed := true; 
+     failed := true;
 {  if value_class <> global_class then
      failed := true;!!!!!!!!!!!!!!!!!!!!}
   if global_s64bit <> RESULT_S64BIT then
@@ -477,7 +485,10 @@ end.
 
 {
   $Log$
-  Revision 1.1  2002-04-10 16:33:19  carl
+  Revision 1.2  2002-05-13 13:45:38  peter
+    * updated to compile tests with kylix
+
+  Revision 1.1  2002/04/10 16:33:19  carl
   + first tries at first calln testing
 
 

tests/test/cg/tcalvar3.pp

@@ -24,6 +24,9 @@ program tcalvar3;
 {$P-}
 {$V+}
 
+{$ifdef VER70}
+  {$define tp}
+{$endif}
 
 
  { REAL should map to single or double }
@@ -34,11 +37,16 @@ program tcalvar3;
 
  const
 { should be defined depending on CPU target }
-{$ifdef cpu68k}
-  BIG_INDEX = 8000;
-  SMALL_INDEX  = 13;
-{$endif}
-{$ifdef cpui386}
+{$ifdef fpc}
+  {$ifdef cpu68k}
+    BIG_INDEX = 8000;
+    SMALL_INDEX  = 13;
+  {$endif}
+  {$ifdef cpui386}
+    BIG_INDEX = 33000;
+    SMALL_INDEX = 13;     { value should not be aligned! }
+  {$endif}
+{$else}
   BIG_INDEX = 33000;
   SMALL_INDEX = 13;     { value should not be aligned! }
 {$endif}
@@ -56,36 +64,43 @@ program tcalvar3;
   RESULT_SMALLSTRING = 'H';
   RESULT_CHAR = 'I';
   RESULT_BOOLEAN = TRUE;
-  
-type 
+
+type
+{$ifdef fpc}
+  pbytearr=^byte;
+{$else}
+  pbytearr=^tbytearr;
+  tbytearr=array[0..$fffffff] of byte;
+{$endif}
+
   tclass1 = class
   end;
-  
+
   tprocedure = procedure;
-  
+
   tsmallrecord = packed record
     b: byte;
     w: word;
   end;
-  
+
   tlargerecord = packed record
     b: array[1..BIG_INDEX] of byte;
   end;
-  
+
   tsmallarray = packed array[1..SMALL_INDEX] of byte;
-  
-  tsmallsetenum = 
+
+  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;
@@ -117,14 +132,14 @@ var
  value_smallarray : tsmallarray;
  value_boolean : boolean;
  value_char : char;
- 
+
     procedure fail;
     begin
       WriteLn('Failure.');
       halt(1);
     end;
-    
-    
+
+
     procedure clear_globals;
      begin
       global_u8bit := 0;
@@ -140,8 +155,8 @@ var
       global_boolean := false;
       global_char := #0;
      end;
-     
-     
+
+
     procedure clear_values;
      begin
       value_u8bit := 0;
@@ -163,8 +178,8 @@ var
       value_boolean := false;
       value_char:=#0;
      end;
-     
-   
+
+
   procedure testprocedure;
    begin
    end;
@@ -173,22 +188,22 @@ var
     begin
       getu8bit:=RESULT_U8BIT;
     end;
-    
+
    function getu16bit: word;
      begin
        getu16bit:=RESULT_U16BIT;
      end;
-     
+
    function gets32bit: longint;
     begin
       gets32bit:=RESULT_S32BIT;
     end;
-    
+
    function gets64bit: longint;
     begin
       gets64bit:=RESULT_S32BIT;
     end;
- 
+
 
    function gets32real: single;
     begin
@@ -207,7 +222,7 @@ var
    begin
      v:=RESULT_S32BIT;
    end;
-   
+
   procedure proc_var_s64bit(var v: int64);pascal;
    begin
      v:=RESULT_S64BIT;
@@ -218,7 +233,7 @@ var
    begin
      v:=RESULT_U8BIT;
    end;
-   
+
   procedure proc_var_smallrecord(var smallrec : tsmallrecord);pascal;
    begin
      smallrec.b := RESULT_U8BIT;
@@ -237,38 +252,38 @@ var
    begin
      smallset := [A_A,A_D];
    end;
-   
-   
+
+
   procedure proc_var_largeset(var largeset : tlargeset);pascal;
    begin
      largeset:= largeset + ['I'];
    end;
-   
+
 
   procedure proc_var_smallstring(var s:tsmallstring);pascal;
    begin
      s:=RESULT_SMALLSTRING;
    end;
-    
+
 
   procedure proc_var_bigstring(var s:shortstring);pascal;
    begin
      s:=RESULT_BIGSTRING;
    end;
-   
+
 
   procedure proc_var_openstring(var s: OpenString);pascal;
    begin
     global_u8bit := high(s);
     s:=RESULT_SMALLSTRING;
    end;
-   
+
   procedure proc_var_smallarray(var arr : tsmallarray);pascal;
   begin
     arr[SMALL_INDEX] := RESULT_U8BIT;
     arr[1] := RESULT_U8BIT;
   end;
-  
+
   procedure proc_var_smallarray_open(var arr : array of byte);pascal;
   begin
     arr[high(arr)] := RESULT_U8BIT;
@@ -281,7 +296,7 @@ var
   begin
     for i:=0 to high(arr) do
      begin
-       case arr[i].vtype of 
+       case arr[i].vtype of
         vtInteger : arr[i].vinteger := RESULT_U8BIT;
         vtBoolean : arr[i].vboolean := RESULT_BOOLEAN;
         else
@@ -289,7 +304,7 @@ var
        end;
      end; {endfor}
   end;
-  
+
 
   procedure proc_var_smallarray_const_2(var arr : array of const);pascal;
   var
@@ -298,11 +313,11 @@ var
      if high(arr)<0 then
        global_u8bit := RESULT_U8BIT;
   end;
-   
+
 
   procedure proc_var_formaldef_array(var buf);pascal;
   var
-   p: ^byte;
+   p: pbytearr;
   begin
     { array is indexed from 1 }
     p := @buf;
@@ -313,14 +328,14 @@ var
 
 procedure proc_var_formaldef_string(var buf);pascal;
   var
-   p: ^byte;
+   p: pbytearr;
   begin
     { array is indexed from 1 }
     p := @buf;
     p[SMALL_INDEX-1] := RESULT_U8BIT;
     p[0] := RESULT_U8BIT;
   end;
-   
+
 
   {************************************************************************}
   {                     MIXED   VAR PARAMETERS                             }
@@ -330,7 +345,7 @@ procedure proc_var_formaldef_string(var buf);pascal;
      v:=RESULT_S32BIT;
      value_u8bit := RESULT_U8BIT;
    end;
-   
+
   procedure proc_var_s64bit_mixed(b1 : byte;var v: int64; b2: byte);pascal;
    begin
      v:=RESULT_S64BIT;
@@ -343,7 +358,7 @@ procedure proc_var_formaldef_string(var buf);pascal;
      v:=RESULT_U8BIT;
      value_u8bit := RESULT_U8BIT;
    end;
-   
+
   procedure proc_var_smallrecord_mixed(b1 : byte; var smallrec : tsmallrecord; b2: byte);pascal;
    begin
      smallrec.b := RESULT_U8BIT;
@@ -365,28 +380,28 @@ procedure proc_var_formaldef_string(var buf);pascal;
      smallset := [A_A,A_D];
      value_u8bit := RESULT_U8BIT;
    end;
-   
-   
+
+
   procedure proc_var_largeset_mixed(b1 : byte; var largeset : tlargeset; b2: byte);pascal;
    begin
      largeset:= largeset + ['I'];
      value_u8bit := RESULT_U8BIT;
    end;
-   
+
 
   procedure proc_var_smallstring_mixed(b1 : byte; var s:tsmallstring; b2: byte);pascal;
    begin
      s:=RESULT_SMALLSTRING;
      value_u8bit := RESULT_U8BIT;
    end;
-    
+
 
   procedure proc_var_bigstring_mixed(b1 : byte; var s:shortstring; b2: byte);pascal;
    begin
      s:=RESULT_BIGSTRING;
      value_u8bit := RESULT_U8BIT;
    end;
-   
+
 
   procedure proc_var_openstring_mixed(b1 : byte; var s: OpenString; b2: byte);pascal;
    begin
@@ -394,14 +409,14 @@ procedure proc_var_formaldef_string(var buf);pascal;
     s:=RESULT_SMALLSTRING;
     value_u8bit := RESULT_U8BIT;
    end;
-   
+
   procedure proc_var_smallarray_mixed(b1 : byte; var arr : tsmallarray; b2: byte);pascal;
   begin
     arr[SMALL_INDEX] := RESULT_U8BIT;
     arr[1] := RESULT_U8BIT;
     value_u8bit := RESULT_U8BIT;
   end;
-  
+
   procedure proc_var_smallarray_open_mixed(b1 : byte; var arr : array of byte; b2: byte);pascal;
   begin
     arr[high(arr)] := RESULT_U8BIT;
@@ -415,7 +430,7 @@ procedure proc_var_formaldef_string(var buf);pascal;
   begin
     for i:=0 to high(arr) do
      begin
-       case arr[i].vtype of 
+       case arr[i].vtype of
         vtInteger : arr[i].vinteger := RESULT_U8BIT;
         vtBoolean : arr[i].vboolean := RESULT_BOOLEAN;
         else
@@ -424,7 +439,7 @@ procedure proc_var_formaldef_string(var buf);pascal;
      end; {endfor}
      value_u8bit := RESULT_U8BIT;
  end;
-  
+
 
   procedure proc_var_smallarray_const_2_mixed(b1 : byte; var arr : array of const; b2: byte);pascal;
   var
@@ -434,11 +449,11 @@ procedure proc_var_formaldef_string(var buf);pascal;
        global_u8bit := RESULT_U8BIT;
      value_u8bit := RESULT_U8BIT;
 end;
-   
+
 
   procedure proc_var_formaldef_array_mixed(b1 : byte; var buf; b2: byte);pascal;
   var
-   p: ^byte;
+   p: pbytearr;
   begin
     { array is indexed from 1 }
     p := @buf;
@@ -450,7 +465,7 @@ end;
 
 procedure proc_var_formaldef_string_mixed(b1 : byte; var buf; b2: byte);pascal;
   var
-   p: ^byte;
+   p: pbytearr;
   begin
     { array is indexed from 1 }
     p := @buf;
@@ -467,7 +482,7 @@ begin
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   write('Var parameter test (src : LOC_REFERENCE (orddef)))...');
   proc_var_s32bit(global_s32bit);
   if global_s32bit <> RESULT_S32BIT then
@@ -490,7 +505,7 @@ begin
     fail
   else
     WriteLn('Passed!');
-  
+
   write('Var parameter test (src : LOC_REFERENCE (recorddef)))...');
   clear_globals;
   clear_values;
@@ -499,34 +514,34 @@ begin
   proc_var_smallrecord(value_smallrec);
   if (value_smallrec.b <> RESULT_U8BIT) or (value_smallrec.w <> RESULT_U16BIT) then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   proc_var_largerecord(value_largerec);
   if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[2] <> RESULT_U8BIT) then
     failed := true;
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
-    
+
   write('var parameter test (src : LOC_REFERENCE (setdef)))...');
   clear_globals;
   clear_values;
   failed := false;
-  
+
   proc_var_smallset(value_smallset);
   if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   proc_var_largeset(value_largeset);
   if not ('I' in value_largeset) then
     failed := true;
-    
+
   if failed then
     fail
   else
@@ -553,18 +568,18 @@ begin
   if (value_smallstring <> RESULT_SMALLSTRING) or (global_u8bit <> high(value_smallstring)) then
     failed := true;
 
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
-    
+
   write('Var parameter test (src : LOC_REFERENCE (formaldef)))...');
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   proc_var_formaldef_array(value_smallarray);
   if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
     failed := true;
@@ -576,11 +591,11 @@ begin
     WriteLn('Passed!');
 
   write('Var parameter test (src : LOC_REFERENCE (arraydef)))...');
-  
+
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
   proc_var_smallarray(value_smallarray);
   if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
@@ -594,7 +609,7 @@ begin
   proc_var_smallarray_open(value_smallarray);
   if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
     failed := true;
-    
+
 (*   HOW CAN ARRAY OF CONST VAR PARAMETERS BE TESTED?
   clear_globals;
   clear_values;
@@ -607,10 +622,10 @@ begin
   value_char := RESULT_CHAR;
   value_s64real:=RESULT_S64REAL;
   proc_var_smallarray_var_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real,value_boolean,value_class]);
-  
+
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if global_char <> RESULT_CHAR then
     failed := true;
   if global_boolean <> RESULT_BOOLEAN then
@@ -620,7 +635,7 @@ begin
   if global_bigstring <> RESULT_SMALLSTRING then
      failed := true;
   if global_ptr <> value_ptr then
-     failed := true; 
+     failed := true;
 {  if value_class <> global_class then
      failed := true;!!!!!!!!!!!!!!!!!!!!}
   if global_s64bit <> RESULT_S64BIT then
@@ -638,12 +653,12 @@ begin
     fail
   else
     WriteLn('Passed!');
-    
+
   {***************************** MIXED  TESTS *******************************}
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   write('Var parameter test (src : LOC_REFERENCE (orddef)))...');
   proc_var_s32bit_mixed(RESULT_U8BIT, global_s32bit, RESULT_U8BIT);
   if global_s32bit <> RESULT_S32BIT then
@@ -672,7 +687,7 @@ begin
     fail
   else
     WriteLn('Passed!');
-  
+
   write('Var parameter test (src : LOC_REFERENCE (recorddef)))...');
   clear_globals;
   clear_values;
@@ -683,7 +698,7 @@ begin
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   proc_var_largerecord_mixed(RESULT_U8BIT, value_largerec, RESULT_U8BIT);
@@ -691,24 +706,24 @@ begin
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
-    
+
   write('var parameter test (src : LOC_REFERENCE (setdef)))...');
   clear_globals;
   clear_values;
   failed := false;
-  
+
   proc_var_smallset_mixed(RESULT_U8BIT, value_smallset, RESULT_U8BIT);
   if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   proc_var_largeset_mixed(RESULT_U8BIT, value_largeset, RESULT_U8BIT);
@@ -716,7 +731,7 @@ begin
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
@@ -749,18 +764,18 @@ begin
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
 
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
-    
+
   write('Var parameter test (src : LOC_REFERENCE (formaldef)))...');
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   proc_var_formaldef_array_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT);
   if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
     failed := true;
@@ -774,11 +789,11 @@ begin
     WriteLn('Passed!');
 
   write('Var parameter test (src : LOC_REFERENCE (arraydef)))...');
-  
+
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
   proc_var_smallarray_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT);
   if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
@@ -801,13 +816,16 @@ begin
     fail
   else
     WriteLn('Passed!');
-  
+
 end.
 
 
 {
   $Log$
-  Revision 1.1  2002-04-13 17:51:00  carl
+  Revision 1.2  2002-05-13 13:45:38  peter
+    * updated to compile tests with kylix
+
+  Revision 1.1  2002/04/13 17:51:00  carl
   + var parameter passing for different calling conventions
 
 

tests/test/cg/tcalvar4.pp

@@ -18,12 +18,17 @@
 {          (var   parameters with cdecl    calling convention)   }
 {****************************************************************}
 program tcalvar4;
-{$mode objfpc}
-{$INLINE ON}
+{$ifdef fpc}
+  {$mode objfpc}
+  {$INLINE ON}
+{$endif}
 {$R+}
 {$P-}
 {$V+}
 
+{$ifdef VER70}
+  {$define tp}
+{$endif}
 
 
  { REAL should map to single or double }
@@ -34,11 +39,16 @@ program tcalvar4;
 
  const
 { should be defined depending on CPU target }
-{$ifdef cpu68k}
-  BIG_INDEX = 8000;
-  SMALL_INDEX  = 13;
-{$endif}
-{$ifdef cpui386}
+{$ifdef fpc}
+  {$ifdef cpu68k}
+    BIG_INDEX = 8000;
+    SMALL_INDEX  = 13;
+  {$endif}
+  {$ifdef cpui386}
+    BIG_INDEX = 33000;
+    SMALL_INDEX = 13;     { value should not be aligned! }
+  {$endif}
+{$else}
   BIG_INDEX = 33000;
   SMALL_INDEX = 13;     { value should not be aligned! }
 {$endif}
@@ -56,36 +66,43 @@ program tcalvar4;
   RESULT_SMALLSTRING = 'H';
   RESULT_CHAR = 'I';
   RESULT_BOOLEAN = TRUE;
-  
-type 
+
+type
+{$ifdef fpc}
+  pbytearr=^byte;
+{$else}
+  pbytearr=^tbytearr;
+  tbytearr=array[0..$fffffff] of byte;
+{$endif}
+
   tclass1 = class
   end;
-  
+
   tprocedure = procedure;
-  
+
   tsmallrecord = packed record
     b: byte;
     w: word;
   end;
-  
+
   tlargerecord = packed record
     b: array[1..BIG_INDEX] of byte;
   end;
-  
+
   tsmallarray = packed array[1..SMALL_INDEX] of byte;
-  
-  tsmallsetenum = 
+
+  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;
@@ -117,14 +134,14 @@ var
  value_smallarray : tsmallarray;
  value_boolean : boolean;
  value_char : char;
- 
+
     procedure fail;
     begin
       WriteLn('Failure.');
       halt(1);
     end;
-    
-    
+
+
     procedure clear_globals;
      begin
       global_u8bit := 0;
@@ -140,8 +157,8 @@ var
       global_boolean := false;
       global_char := #0;
      end;
-     
-     
+
+
     procedure clear_values;
      begin
       value_u8bit := 0;
@@ -163,8 +180,8 @@ var
       value_boolean := false;
       value_char:=#0;
      end;
-     
-   
+
+
   procedure testprocedure;
    begin
    end;
@@ -173,22 +190,22 @@ var
     begin
       getu8bit:=RESULT_U8BIT;
     end;
-    
+
    function getu16bit: word;
      begin
        getu16bit:=RESULT_U16BIT;
      end;
-     
+
    function gets32bit: longint;
     begin
       gets32bit:=RESULT_S32BIT;
     end;
-    
+
    function gets64bit: longint;
     begin
       gets64bit:=RESULT_S32BIT;
     end;
- 
+
 
    function gets32real: single;
     begin
@@ -207,7 +224,7 @@ var
    begin
      v:=RESULT_S32BIT;
    end;
-   
+
   procedure proc_var_s64bit(var v: int64);cdecl;
    begin
      v:=RESULT_S64BIT;
@@ -218,7 +235,7 @@ var
    begin
      v:=RESULT_U8BIT;
    end;
-   
+
   procedure proc_var_smallrecord(var smallrec : tsmallrecord);cdecl;
    begin
      smallrec.b := RESULT_U8BIT;
@@ -237,38 +254,38 @@ var
    begin
      smallset := [A_A,A_D];
    end;
-   
-   
+
+
   procedure proc_var_largeset(var largeset : tlargeset);cdecl;
    begin
      largeset:= largeset + ['I'];
    end;
-   
+
 
   procedure proc_var_smallstring(var s:tsmallstring);cdecl;
    begin
      s:=RESULT_SMALLSTRING;
    end;
-    
+
 
   procedure proc_var_bigstring(var s:shortstring);cdecl;
    begin
      s:=RESULT_BIGSTRING;
    end;
-   
+
 
   procedure proc_var_openstring(var s: OpenString);cdecl;
    begin
     global_u8bit := high(s);
     s:=RESULT_SMALLSTRING;
    end;
-   
+
   procedure proc_var_smallarray(var arr : tsmallarray);cdecl;
   begin
     arr[SMALL_INDEX] := RESULT_U8BIT;
     arr[1] := RESULT_U8BIT;
   end;
-  
+
   procedure proc_var_smallarray_open(var arr : array of byte);cdecl;
   begin
     arr[high(arr)] := RESULT_U8BIT;
@@ -281,7 +298,7 @@ var
   begin
     for i:=0 to high(arr) do
      begin
-       case arr[i].vtype of 
+       case arr[i].vtype of
         vtInteger : arr[i].vinteger := RESULT_U8BIT;
         vtBoolean : arr[i].vboolean := RESULT_BOOLEAN;
         else
@@ -289,7 +306,7 @@ var
        end;
      end; {endfor}
   end;
-  
+
 
   procedure proc_var_smallarray_const_2(var arr : array of const);cdecl;
   var
@@ -298,11 +315,11 @@ var
      if high(arr)<0 then
        global_u8bit := RESULT_U8BIT;
   end;
-   
+
 
   procedure proc_var_formaldef_array(var buf);cdecl;
   var
-   p: ^byte;
+   p: pbytearr;
   begin
     { array is indexed from 1 }
     p := @buf;
@@ -313,14 +330,14 @@ var
 
 procedure proc_var_formaldef_string(var buf);cdecl;
   var
-   p: ^byte;
+   p: pbytearr;
   begin
     { array is indexed from 1 }
     p := @buf;
     p[SMALL_INDEX-1] := RESULT_U8BIT;
     p[0] := RESULT_U8BIT;
   end;
-   
+
 
   {************************************************************************}
   {                     MIXED   VAR PARAMETERS                             }
@@ -330,7 +347,7 @@ procedure proc_var_formaldef_string(var buf);cdecl;
      v:=RESULT_S32BIT;
      value_u8bit := RESULT_U8BIT;
    end;
-   
+
   procedure proc_var_s64bit_mixed(b1 : byte;var v: int64; b2: byte);cdecl;
    begin
      v:=RESULT_S64BIT;
@@ -343,7 +360,7 @@ procedure proc_var_formaldef_string(var buf);cdecl;
      v:=RESULT_U8BIT;
      value_u8bit := RESULT_U8BIT;
    end;
-   
+
   procedure proc_var_smallrecord_mixed(b1 : byte; var smallrec : tsmallrecord; b2: byte);cdecl;
    begin
      smallrec.b := RESULT_U8BIT;
@@ -365,28 +382,28 @@ procedure proc_var_formaldef_string(var buf);cdecl;
      smallset := [A_A,A_D];
      value_u8bit := RESULT_U8BIT;
    end;
-   
-   
+
+
   procedure proc_var_largeset_mixed(b1 : byte; var largeset : tlargeset; b2: byte);cdecl;
    begin
      largeset:= largeset + ['I'];
      value_u8bit := RESULT_U8BIT;
    end;
-   
+
 
   procedure proc_var_smallstring_mixed(b1 : byte; var s:tsmallstring; b2: byte);cdecl;
    begin
      s:=RESULT_SMALLSTRING;
      value_u8bit := RESULT_U8BIT;
    end;
-    
+
 
   procedure proc_var_bigstring_mixed(b1 : byte; var s:shortstring; b2: byte);cdecl;
    begin
      s:=RESULT_BIGSTRING;
      value_u8bit := RESULT_U8BIT;
    end;
-   
+
 
   procedure proc_var_openstring_mixed(b1 : byte; var s: OpenString; b2: byte);cdecl;
    begin
@@ -394,14 +411,14 @@ procedure proc_var_formaldef_string(var buf);cdecl;
     s:=RESULT_SMALLSTRING;
     value_u8bit := RESULT_U8BIT;
    end;
-   
+
   procedure proc_var_smallarray_mixed(b1 : byte; var arr : tsmallarray; b2: byte);cdecl;
   begin
     arr[SMALL_INDEX] := RESULT_U8BIT;
     arr[1] := RESULT_U8BIT;
     value_u8bit := RESULT_U8BIT;
   end;
-  
+
   procedure proc_var_smallarray_open_mixed(b1 : byte; var arr : array of byte; b2: byte);cdecl;
   begin
     arr[high(arr)] := RESULT_U8BIT;
@@ -415,7 +432,7 @@ procedure proc_var_formaldef_string(var buf);cdecl;
   begin
     for i:=0 to high(arr) do
      begin
-       case arr[i].vtype of 
+       case arr[i].vtype of
         vtInteger : arr[i].vinteger := RESULT_U8BIT;
         vtBoolean : arr[i].vboolean := RESULT_BOOLEAN;
         else
@@ -424,7 +441,7 @@ procedure proc_var_formaldef_string(var buf);cdecl;
      end; {endfor}
      value_u8bit := RESULT_U8BIT;
  end;
-  
+
 
   procedure proc_var_smallarray_const_2_mixed(b1 : byte; var arr : array of const; b2: byte);cdecl;
   var
@@ -434,11 +451,11 @@ procedure proc_var_formaldef_string(var buf);cdecl;
        global_u8bit := RESULT_U8BIT;
      value_u8bit := RESULT_U8BIT;
 end;
-   
+
 
   procedure proc_var_formaldef_array_mixed(b1 : byte; var buf; b2: byte);cdecl;
   var
-   p: ^byte;
+   p: pbytearr;
   begin
     { array is indexed from 1 }
     p := @buf;
@@ -450,7 +467,7 @@ end;
 
 procedure proc_var_formaldef_string_mixed(b1 : byte; var buf; b2: byte);cdecl;
   var
-   p: ^byte;
+   p: pbytearr;
   begin
     { array is indexed from 1 }
     p := @buf;
@@ -467,7 +484,7 @@ begin
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   write('Var parameter test (src : LOC_REFERENCE (orddef)))...');
   proc_var_s32bit(global_s32bit);
   if global_s32bit <> RESULT_S32BIT then
@@ -490,7 +507,7 @@ begin
     fail
   else
     WriteLn('Passed!');
-  
+
   write('Var parameter test (src : LOC_REFERENCE (recorddef)))...');
   clear_globals;
   clear_values;
@@ -499,34 +516,34 @@ begin
   proc_var_smallrecord(value_smallrec);
   if (value_smallrec.b <> RESULT_U8BIT) or (value_smallrec.w <> RESULT_U16BIT) then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   proc_var_largerecord(value_largerec);
   if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[2] <> RESULT_U8BIT) then
     failed := true;
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
-    
+
   write('var parameter test (src : LOC_REFERENCE (setdef)))...');
   clear_globals;
   clear_values;
   failed := false;
-  
+
   proc_var_smallset(value_smallset);
   if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   proc_var_largeset(value_largeset);
   if not ('I' in value_largeset) then
     failed := true;
-    
+
   if failed then
     fail
   else
@@ -553,18 +570,18 @@ begin
   if (value_smallstring <> RESULT_SMALLSTRING) or (global_u8bit <> high(value_smallstring)) then
     failed := true;
 
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
-    
+
   write('Var parameter test (src : LOC_REFERENCE (formaldef)))...');
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   proc_var_formaldef_array(value_smallarray);
   if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
     failed := true;
@@ -576,11 +593,11 @@ begin
     WriteLn('Passed!');
 
   write('Var parameter test (src : LOC_REFERENCE (arraydef)))...');
-  
+
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
   proc_var_smallarray(value_smallarray);
   if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
@@ -594,7 +611,7 @@ begin
   proc_var_smallarray_open(value_smallarray);
   if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
     failed := true;
-    
+
 (*   HOW CAN ARRAY OF CONST VAR PARAMETERS BE TESTED?
   clear_globals;
   clear_values;
@@ -607,10 +624,10 @@ begin
   value_char := RESULT_CHAR;
   value_s64real:=RESULT_S64REAL;
   proc_var_smallarray_var_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real,value_boolean,value_class]);
-  
+
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if global_char <> RESULT_CHAR then
     failed := true;
   if global_boolean <> RESULT_BOOLEAN then
@@ -620,7 +637,7 @@ begin
   if global_bigstring <> RESULT_SMALLSTRING then
      failed := true;
   if global_ptr <> value_ptr then
-     failed := true; 
+     failed := true;
 {  if value_class <> global_class then
      failed := true;!!!!!!!!!!!!!!!!!!!!}
   if global_s64bit <> RESULT_S64BIT then
@@ -638,12 +655,12 @@ begin
     fail
   else
     WriteLn('Passed!');
-    
+
   {***************************** MIXED  TESTS *******************************}
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   write('Var parameter test (src : LOC_REFERENCE (orddef)))...');
   proc_var_s32bit_mixed(RESULT_U8BIT, global_s32bit, RESULT_U8BIT);
   if global_s32bit <> RESULT_S32BIT then
@@ -672,7 +689,7 @@ begin
     fail
   else
     WriteLn('Passed!');
-  
+
   write('Var parameter test (src : LOC_REFERENCE (recorddef)))...');
   clear_globals;
   clear_values;
@@ -683,7 +700,7 @@ begin
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   proc_var_largerecord_mixed(RESULT_U8BIT, value_largerec, RESULT_U8BIT);
@@ -691,24 +708,24 @@ begin
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
-    
+
   write('var parameter test (src : LOC_REFERENCE (setdef)))...');
   clear_globals;
   clear_values;
   failed := false;
-  
+
   proc_var_smallset_mixed(RESULT_U8BIT, value_smallset, RESULT_U8BIT);
   if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   proc_var_largeset_mixed(RESULT_U8BIT, value_largeset, RESULT_U8BIT);
@@ -716,7 +733,7 @@ begin
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
@@ -749,18 +766,18 @@ begin
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
 
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
-    
+
   write('Var parameter test (src : LOC_REFERENCE (formaldef)))...');
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   proc_var_formaldef_array_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT);
   if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
     failed := true;
@@ -774,11 +791,11 @@ begin
     WriteLn('Passed!');
 
   write('Var parameter test (src : LOC_REFERENCE (arraydef)))...');
-  
+
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
   proc_var_smallarray_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT);
   if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
@@ -801,13 +818,16 @@ begin
     fail
   else
     WriteLn('Passed!');
-  
+
 end.
 
 
 {
   $Log$
-  Revision 1.1  2002-04-13 17:51:00  carl
+  Revision 1.2  2002-05-13 13:45:38  peter
+    * updated to compile tests with kylix
+
+  Revision 1.1  2002/04/13 17:51:00  carl
   + var parameter passing for different calling conventions
 
 

tests/test/cg/tcalvar5.pp

@@ -18,12 +18,17 @@
 {          (var   parameters with popstack calling convention)   }
 {****************************************************************}
 program tcalvar5;
-{$mode objfpc}
-{$INLINE ON}
+{$ifdef fpc}
+  {$mode objfpc}
+  {$INLINE ON}
+{$endif}
 {$R+}
 {$P-}
 {$V+}
 
+{$ifdef VER70}
+  {$define tp}
+{$endif}
 
 
  { REAL should map to single or double }
@@ -34,11 +39,16 @@ program tcalvar5;
 
  const
 { should be defined depending on CPU target }
-{$ifdef cpu68k}
-  BIG_INDEX = 8000;
-  SMALL_INDEX  = 13;
-{$endif}
-{$ifdef cpui386}
+{$ifdef fpc}
+  {$ifdef cpu68k}
+    BIG_INDEX = 8000;
+    SMALL_INDEX  = 13;
+  {$endif}
+  {$ifdef cpui386}
+    BIG_INDEX = 33000;
+    SMALL_INDEX = 13;     { value should not be aligned! }
+  {$endif}
+{$else}
   BIG_INDEX = 33000;
   SMALL_INDEX = 13;     { value should not be aligned! }
 {$endif}
@@ -56,36 +66,43 @@ program tcalvar5;
   RESULT_SMALLSTRING = 'H';
   RESULT_CHAR = 'I';
   RESULT_BOOLEAN = TRUE;
-  
-type 
+
+type
+{$ifdef fpc}
+  pbytearr=^byte;
+{$else}
+  pbytearr=^tbytearr;
+  tbytearr=array[0..$fffffff] of byte;
+{$endif}
+
   tclass1 = class
   end;
-  
+
   tprocedure = procedure;
-  
+
   tsmallrecord = packed record
     b: byte;
     w: word;
   end;
-  
+
   tlargerecord = packed record
     b: array[1..BIG_INDEX] of byte;
   end;
-  
+
   tsmallarray = packed array[1..SMALL_INDEX] of byte;
-  
-  tsmallsetenum = 
+
+  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;
@@ -117,14 +134,14 @@ var
  value_smallarray : tsmallarray;
  value_boolean : boolean;
  value_char : char;
- 
+
     procedure fail;
     begin
       WriteLn('Failure.');
       halt(1);
     end;
-    
-    
+
+
     procedure clear_globals;
      begin
       global_u8bit := 0;
@@ -140,8 +157,8 @@ var
       global_boolean := false;
       global_char := #0;
      end;
-     
-     
+
+
     procedure clear_values;
      begin
       value_u8bit := 0;
@@ -163,8 +180,8 @@ var
       value_boolean := false;
       value_char:=#0;
      end;
-     
-   
+
+
   procedure testprocedure;
    begin
    end;
@@ -173,22 +190,22 @@ var
     begin
       getu8bit:=RESULT_U8BIT;
     end;
-    
+
    function getu16bit: word;
      begin
        getu16bit:=RESULT_U16BIT;
      end;
-     
+
    function gets32bit: longint;
     begin
       gets32bit:=RESULT_S32BIT;
     end;
-    
+
    function gets64bit: longint;
     begin
       gets64bit:=RESULT_S32BIT;
     end;
- 
+
 
    function gets32real: single;
     begin
@@ -207,7 +224,7 @@ var
    begin
      v:=RESULT_S32BIT;
    end;
-   
+
   procedure proc_var_s64bit(var v: int64);popstack;
    begin
      v:=RESULT_S64BIT;
@@ -218,7 +235,7 @@ var
    begin
      v:=RESULT_U8BIT;
    end;
-   
+
   procedure proc_var_smallrecord(var smallrec : tsmallrecord);popstack;
    begin
      smallrec.b := RESULT_U8BIT;
@@ -237,38 +254,38 @@ var
    begin
      smallset := [A_A,A_D];
    end;
-   
-   
+
+
   procedure proc_var_largeset(var largeset : tlargeset);popstack;
    begin
      largeset:= largeset + ['I'];
    end;
-   
+
 
   procedure proc_var_smallstring(var s:tsmallstring);popstack;
    begin
      s:=RESULT_SMALLSTRING;
    end;
-    
+
 
   procedure proc_var_bigstring(var s:shortstring);popstack;
    begin
      s:=RESULT_BIGSTRING;
    end;
-   
+
 
   procedure proc_var_openstring(var s: OpenString);popstack;
    begin
     global_u8bit := high(s);
     s:=RESULT_SMALLSTRING;
    end;
-   
+
   procedure proc_var_smallarray(var arr : tsmallarray);popstack;
   begin
     arr[SMALL_INDEX] := RESULT_U8BIT;
     arr[1] := RESULT_U8BIT;
   end;
-  
+
   procedure proc_var_smallarray_open(var arr : array of byte);popstack;
   begin
     arr[high(arr)] := RESULT_U8BIT;
@@ -281,7 +298,7 @@ var
   begin
     for i:=0 to high(arr) do
      begin
-       case arr[i].vtype of 
+       case arr[i].vtype of
         vtInteger : arr[i].vinteger := RESULT_U8BIT;
         vtBoolean : arr[i].vboolean := RESULT_BOOLEAN;
         else
@@ -289,7 +306,7 @@ var
        end;
      end; {endfor}
   end;
-  
+
 
   procedure proc_var_smallarray_const_2(var arr : array of const);popstack;
   var
@@ -298,11 +315,11 @@ var
      if high(arr)<0 then
        global_u8bit := RESULT_U8BIT;
   end;
-   
+
 
   procedure proc_var_formaldef_array(var buf);popstack;
   var
-   p: ^byte;
+   p: pbytearr;
   begin
     { array is indexed from 1 }
     p := @buf;
@@ -313,14 +330,14 @@ var
 
 procedure proc_var_formaldef_string(var buf);popstack;
   var
-   p: ^byte;
+   p: pbytearr;
   begin
     { array is indexed from 1 }
     p := @buf;
     p[SMALL_INDEX-1] := RESULT_U8BIT;
     p[0] := RESULT_U8BIT;
   end;
-   
+
 
   {************************************************************************}
   {                     MIXED   VAR PARAMETERS                             }
@@ -330,7 +347,7 @@ procedure proc_var_formaldef_string(var buf);popstack;
      v:=RESULT_S32BIT;
      value_u8bit := RESULT_U8BIT;
    end;
-   
+
   procedure proc_var_s64bit_mixed(b1 : byte;var v: int64; b2: byte);popstack;
    begin
      v:=RESULT_S64BIT;
@@ -343,7 +360,7 @@ procedure proc_var_formaldef_string(var buf);popstack;
      v:=RESULT_U8BIT;
      value_u8bit := RESULT_U8BIT;
    end;
-   
+
   procedure proc_var_smallrecord_mixed(b1 : byte; var smallrec : tsmallrecord; b2: byte);popstack;
    begin
      smallrec.b := RESULT_U8BIT;
@@ -365,28 +382,28 @@ procedure proc_var_formaldef_string(var buf);popstack;
      smallset := [A_A,A_D];
      value_u8bit := RESULT_U8BIT;
    end;
-   
-   
+
+
   procedure proc_var_largeset_mixed(b1 : byte; var largeset : tlargeset; b2: byte);popstack;
    begin
      largeset:= largeset + ['I'];
      value_u8bit := RESULT_U8BIT;
    end;
-   
+
 
   procedure proc_var_smallstring_mixed(b1 : byte; var s:tsmallstring; b2: byte);popstack;
    begin
      s:=RESULT_SMALLSTRING;
      value_u8bit := RESULT_U8BIT;
    end;
-    
+
 
   procedure proc_var_bigstring_mixed(b1 : byte; var s:shortstring; b2: byte);popstack;
    begin
      s:=RESULT_BIGSTRING;
      value_u8bit := RESULT_U8BIT;
    end;
-   
+
 
   procedure proc_var_openstring_mixed(b1 : byte; var s: OpenString; b2: byte);popstack;
    begin
@@ -394,14 +411,14 @@ procedure proc_var_formaldef_string(var buf);popstack;
     s:=RESULT_SMALLSTRING;
     value_u8bit := RESULT_U8BIT;
    end;
-   
+
   procedure proc_var_smallarray_mixed(b1 : byte; var arr : tsmallarray; b2: byte);popstack;
   begin
     arr[SMALL_INDEX] := RESULT_U8BIT;
     arr[1] := RESULT_U8BIT;
     value_u8bit := RESULT_U8BIT;
   end;
-  
+
   procedure proc_var_smallarray_open_mixed(b1 : byte; var arr : array of byte; b2: byte);popstack;
   begin
     arr[high(arr)] := RESULT_U8BIT;
@@ -415,7 +432,7 @@ procedure proc_var_formaldef_string(var buf);popstack;
   begin
     for i:=0 to high(arr) do
      begin
-       case arr[i].vtype of 
+       case arr[i].vtype of
         vtInteger : arr[i].vinteger := RESULT_U8BIT;
         vtBoolean : arr[i].vboolean := RESULT_BOOLEAN;
         else
@@ -424,7 +441,7 @@ procedure proc_var_formaldef_string(var buf);popstack;
      end; {endfor}
      value_u8bit := RESULT_U8BIT;
  end;
-  
+
 
   procedure proc_var_smallarray_const_2_mixed(b1 : byte; var arr : array of const; b2: byte);popstack;
   var
@@ -434,11 +451,11 @@ procedure proc_var_formaldef_string(var buf);popstack;
        global_u8bit := RESULT_U8BIT;
      value_u8bit := RESULT_U8BIT;
 end;
-   
+
 
   procedure proc_var_formaldef_array_mixed(b1 : byte; var buf; b2: byte);popstack;
   var
-   p: ^byte;
+   p: pbytearr;
   begin
     { array is indexed from 1 }
     p := @buf;
@@ -450,7 +467,7 @@ end;
 
 procedure proc_var_formaldef_string_mixed(b1 : byte; var buf; b2: byte);popstack;
   var
-   p: ^byte;
+   p: pbytearr;
   begin
     { array is indexed from 1 }
     p := @buf;
@@ -467,7 +484,7 @@ begin
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   write('Var parameter test (src : LOC_REFERENCE (orddef)))...');
   proc_var_s32bit(global_s32bit);
   if global_s32bit <> RESULT_S32BIT then
@@ -490,7 +507,7 @@ begin
     fail
   else
     WriteLn('Passed!');
-  
+
   write('Var parameter test (src : LOC_REFERENCE (recorddef)))...');
   clear_globals;
   clear_values;
@@ -499,34 +516,34 @@ begin
   proc_var_smallrecord(value_smallrec);
   if (value_smallrec.b <> RESULT_U8BIT) or (value_smallrec.w <> RESULT_U16BIT) then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   proc_var_largerecord(value_largerec);
   if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[2] <> RESULT_U8BIT) then
     failed := true;
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
-    
+
   write('var parameter test (src : LOC_REFERENCE (setdef)))...');
   clear_globals;
   clear_values;
   failed := false;
-  
+
   proc_var_smallset(value_smallset);
   if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   proc_var_largeset(value_largeset);
   if not ('I' in value_largeset) then
     failed := true;
-    
+
   if failed then
     fail
   else
@@ -553,18 +570,18 @@ begin
   if (value_smallstring <> RESULT_SMALLSTRING) or (global_u8bit <> high(value_smallstring)) then
     failed := true;
 
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
-    
+
   write('Var parameter test (src : LOC_REFERENCE (formaldef)))...');
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   proc_var_formaldef_array(value_smallarray);
   if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
     failed := true;
@@ -576,11 +593,11 @@ begin
     WriteLn('Passed!');
 
   write('Var parameter test (src : LOC_REFERENCE (arraydef)))...');
-  
+
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
   proc_var_smallarray(value_smallarray);
   if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
@@ -594,7 +611,7 @@ begin
   proc_var_smallarray_open(value_smallarray);
   if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
     failed := true;
-    
+
 (*   HOW CAN ARRAY OF CONST VAR PARAMETERS BE TESTED?
   clear_globals;
   clear_values;
@@ -607,10 +624,10 @@ begin
   value_char := RESULT_CHAR;
   value_s64real:=RESULT_S64REAL;
   proc_var_smallarray_var_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real,value_boolean,value_class]);
-  
+
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if global_char <> RESULT_CHAR then
     failed := true;
   if global_boolean <> RESULT_BOOLEAN then
@@ -620,7 +637,7 @@ begin
   if global_bigstring <> RESULT_SMALLSTRING then
      failed := true;
   if global_ptr <> value_ptr then
-     failed := true; 
+     failed := true;
 {  if value_class <> global_class then
      failed := true;!!!!!!!!!!!!!!!!!!!!}
   if global_s64bit <> RESULT_S64BIT then
@@ -638,12 +655,12 @@ begin
     fail
   else
     WriteLn('Passed!');
-    
+
   {***************************** MIXED  TESTS *******************************}
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   write('Var parameter test (src : LOC_REFERENCE (orddef)))...');
   proc_var_s32bit_mixed(RESULT_U8BIT, global_s32bit, RESULT_U8BIT);
   if global_s32bit <> RESULT_S32BIT then
@@ -672,7 +689,7 @@ begin
     fail
   else
     WriteLn('Passed!');
-  
+
   write('Var parameter test (src : LOC_REFERENCE (recorddef)))...');
   clear_globals;
   clear_values;
@@ -683,7 +700,7 @@ begin
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   proc_var_largerecord_mixed(RESULT_U8BIT, value_largerec, RESULT_U8BIT);
@@ -691,24 +708,24 @@ begin
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
-    
+
   write('var parameter test (src : LOC_REFERENCE (setdef)))...');
   clear_globals;
   clear_values;
   failed := false;
-  
+
   proc_var_smallset_mixed(RESULT_U8BIT, value_smallset, RESULT_U8BIT);
   if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   proc_var_largeset_mixed(RESULT_U8BIT, value_largeset, RESULT_U8BIT);
@@ -716,7 +733,7 @@ begin
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
@@ -749,18 +766,18 @@ begin
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
 
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
-    
+
   write('Var parameter test (src : LOC_REFERENCE (formaldef)))...');
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   proc_var_formaldef_array_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT);
   if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
     failed := true;
@@ -774,11 +791,11 @@ begin
     WriteLn('Passed!');
 
   write('Var parameter test (src : LOC_REFERENCE (arraydef)))...');
-  
+
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
   proc_var_smallarray_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT);
   if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
@@ -801,13 +818,16 @@ begin
     fail
   else
     WriteLn('Passed!');
-  
+
 end.
 
 
 {
   $Log$
-  Revision 1.1  2002-04-13 17:51:00  carl
+  Revision 1.2  2002-05-13 13:45:38  peter
+    * updated to compile tests with kylix
+
+  Revision 1.1  2002/04/13 17:51:00  carl
   + var parameter passing for different calling conventions
 
 

tests/test/cg/tcalvar6.pp

@@ -18,12 +18,17 @@
 {          (var   parameters with safecall calling convention)   }
 {****************************************************************}
 program tcalvar6;
-{$mode objfpc}
-{$INLINE ON}
+{$ifdef fpc}
+  {$mode objfpc}
+  {$INLINE ON}
+{$endif}
 {$R+}
 {$P-}
 {$V+}
 
+{$ifdef VER70}
+  {$define tp}
+{$endif}
 
 
  { REAL should map to single or double }
@@ -34,11 +39,16 @@ program tcalvar6;
 
  const
 { should be defined depending on CPU target }
-{$ifdef cpu68k}
-  BIG_INDEX = 8000;
-  SMALL_INDEX  = 13;
-{$endif}
-{$ifdef cpui386}
+{$ifdef fpc}
+  {$ifdef cpu68k}
+    BIG_INDEX = 8000;
+    SMALL_INDEX  = 13;
+  {$endif}
+  {$ifdef cpui386}
+    BIG_INDEX = 33000;
+    SMALL_INDEX = 13;     { value should not be aligned! }
+  {$endif}
+{$else}
   BIG_INDEX = 33000;
   SMALL_INDEX = 13;     { value should not be aligned! }
 {$endif}
@@ -56,36 +66,43 @@ program tcalvar6;
   RESULT_SMALLSTRING = 'H';
   RESULT_CHAR = 'I';
   RESULT_BOOLEAN = TRUE;
-  
-type 
+
+type
+{$ifdef fpc}
+  pbytearr=^byte;
+{$else}
+  pbytearr=^tbytearr;
+  tbytearr=array[0..$fffffff] of byte;
+{$endif}
+
   tclass1 = class
   end;
-  
+
   tprocedure = procedure;
-  
+
   tsmallrecord = packed record
     b: byte;
     w: word;
   end;
-  
+
   tlargerecord = packed record
     b: array[1..BIG_INDEX] of byte;
   end;
-  
+
   tsmallarray = packed array[1..SMALL_INDEX] of byte;
-  
-  tsmallsetenum = 
+
+  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;
@@ -117,14 +134,14 @@ var
  value_smallarray : tsmallarray;
  value_boolean : boolean;
  value_char : char;
- 
+
     procedure fail;
     begin
       WriteLn('Failure.');
       halt(1);
     end;
-    
-    
+
+
     procedure clear_globals;
      begin
       global_u8bit := 0;
@@ -140,8 +157,8 @@ var
       global_boolean := false;
       global_char := #0;
      end;
-     
-     
+
+
     procedure clear_values;
      begin
       value_u8bit := 0;
@@ -163,8 +180,8 @@ var
       value_boolean := false;
       value_char:=#0;
      end;
-     
-   
+
+
   procedure testprocedure;
    begin
    end;
@@ -173,22 +190,22 @@ var
     begin
       getu8bit:=RESULT_U8BIT;
     end;
-    
+
    function getu16bit: word;
      begin
        getu16bit:=RESULT_U16BIT;
      end;
-     
+
    function gets32bit: longint;
     begin
       gets32bit:=RESULT_S32BIT;
     end;
-    
+
    function gets64bit: longint;
     begin
       gets64bit:=RESULT_S32BIT;
     end;
- 
+
 
    function gets32real: single;
     begin
@@ -207,7 +224,7 @@ var
    begin
      v:=RESULT_S32BIT;
    end;
-   
+
   procedure proc_var_s64bit(var v: int64);safecall;
    begin
      v:=RESULT_S64BIT;
@@ -218,7 +235,7 @@ var
    begin
      v:=RESULT_U8BIT;
    end;
-   
+
   procedure proc_var_smallrecord(var smallrec : tsmallrecord);safecall;
    begin
      smallrec.b := RESULT_U8BIT;
@@ -237,38 +254,38 @@ var
    begin
      smallset := [A_A,A_D];
    end;
-   
-   
+
+
   procedure proc_var_largeset(var largeset : tlargeset);safecall;
    begin
      largeset:= largeset + ['I'];
    end;
-   
+
 
   procedure proc_var_smallstring(var s:tsmallstring);safecall;
    begin
      s:=RESULT_SMALLSTRING;
    end;
-    
+
 
   procedure proc_var_bigstring(var s:shortstring);safecall;
    begin
      s:=RESULT_BIGSTRING;
    end;
-   
+
 
   procedure proc_var_openstring(var s: OpenString);safecall;
    begin
     global_u8bit := high(s);
     s:=RESULT_SMALLSTRING;
    end;
-   
+
   procedure proc_var_smallarray(var arr : tsmallarray);safecall;
   begin
     arr[SMALL_INDEX] := RESULT_U8BIT;
     arr[1] := RESULT_U8BIT;
   end;
-  
+
   procedure proc_var_smallarray_open(var arr : array of byte);safecall;
   begin
     arr[high(arr)] := RESULT_U8BIT;
@@ -281,7 +298,7 @@ var
   begin
     for i:=0 to high(arr) do
      begin
-       case arr[i].vtype of 
+       case arr[i].vtype of
         vtInteger : arr[i].vinteger := RESULT_U8BIT;
         vtBoolean : arr[i].vboolean := RESULT_BOOLEAN;
         else
@@ -289,7 +306,7 @@ var
        end;
      end; {endfor}
   end;
-  
+
 
   procedure proc_var_smallarray_const_2(var arr : array of const);safecall;
   var
@@ -298,11 +315,11 @@ var
      if high(arr)<0 then
        global_u8bit := RESULT_U8BIT;
   end;
-   
+
 
   procedure proc_var_formaldef_array(var buf);safecall;
   var
-   p: ^byte;
+   p: pbytearr;
   begin
     { array is indexed from 1 }
     p := @buf;
@@ -313,14 +330,14 @@ var
 
 procedure proc_var_formaldef_string(var buf);safecall;
   var
-   p: ^byte;
+   p: pbytearr;
   begin
     { array is indexed from 1 }
     p := @buf;
     p[SMALL_INDEX-1] := RESULT_U8BIT;
     p[0] := RESULT_U8BIT;
   end;
-   
+
 
   {************************************************************************}
   {                     MIXED   VAR PARAMETERS                             }
@@ -330,7 +347,7 @@ procedure proc_var_formaldef_string(var buf);safecall;
      v:=RESULT_S32BIT;
      value_u8bit := RESULT_U8BIT;
    end;
-   
+
   procedure proc_var_s64bit_mixed(b1 : byte;var v: int64; b2: byte);safecall;
    begin
      v:=RESULT_S64BIT;
@@ -343,7 +360,7 @@ procedure proc_var_formaldef_string(var buf);safecall;
      v:=RESULT_U8BIT;
      value_u8bit := RESULT_U8BIT;
    end;
-   
+
   procedure proc_var_smallrecord_mixed(b1 : byte; var smallrec : tsmallrecord; b2: byte);safecall;
    begin
      smallrec.b := RESULT_U8BIT;
@@ -365,28 +382,28 @@ procedure proc_var_formaldef_string(var buf);safecall;
      smallset := [A_A,A_D];
      value_u8bit := RESULT_U8BIT;
    end;
-   
-   
+
+
   procedure proc_var_largeset_mixed(b1 : byte; var largeset : tlargeset; b2: byte);safecall;
    begin
      largeset:= largeset + ['I'];
      value_u8bit := RESULT_U8BIT;
    end;
-   
+
 
   procedure proc_var_smallstring_mixed(b1 : byte; var s:tsmallstring; b2: byte);safecall;
    begin
      s:=RESULT_SMALLSTRING;
      value_u8bit := RESULT_U8BIT;
    end;
-    
+
 
   procedure proc_var_bigstring_mixed(b1 : byte; var s:shortstring; b2: byte);safecall;
    begin
      s:=RESULT_BIGSTRING;
      value_u8bit := RESULT_U8BIT;
    end;
-   
+
 
   procedure proc_var_openstring_mixed(b1 : byte; var s: OpenString; b2: byte);safecall;
    begin
@@ -394,14 +411,14 @@ procedure proc_var_formaldef_string(var buf);safecall;
     s:=RESULT_SMALLSTRING;
     value_u8bit := RESULT_U8BIT;
    end;
-   
+
   procedure proc_var_smallarray_mixed(b1 : byte; var arr : tsmallarray; b2: byte);safecall;
   begin
     arr[SMALL_INDEX] := RESULT_U8BIT;
     arr[1] := RESULT_U8BIT;
     value_u8bit := RESULT_U8BIT;
   end;
-  
+
   procedure proc_var_smallarray_open_mixed(b1 : byte; var arr : array of byte; b2: byte);safecall;
   begin
     arr[high(arr)] := RESULT_U8BIT;
@@ -415,7 +432,7 @@ procedure proc_var_formaldef_string(var buf);safecall;
   begin
     for i:=0 to high(arr) do
      begin
-       case arr[i].vtype of 
+       case arr[i].vtype of
         vtInteger : arr[i].vinteger := RESULT_U8BIT;
         vtBoolean : arr[i].vboolean := RESULT_BOOLEAN;
         else
@@ -424,7 +441,7 @@ procedure proc_var_formaldef_string(var buf);safecall;
      end; {endfor}
      value_u8bit := RESULT_U8BIT;
  end;
-  
+
 
   procedure proc_var_smallarray_const_2_mixed(b1 : byte; var arr : array of const; b2: byte);safecall;
   var
@@ -434,11 +451,11 @@ procedure proc_var_formaldef_string(var buf);safecall;
        global_u8bit := RESULT_U8BIT;
      value_u8bit := RESULT_U8BIT;
 end;
-   
+
 
   procedure proc_var_formaldef_array_mixed(b1 : byte; var buf; b2: byte);safecall;
   var
-   p: ^byte;
+   p: pbytearr;
   begin
     { array is indexed from 1 }
     p := @buf;
@@ -450,7 +467,7 @@ end;
 
 procedure proc_var_formaldef_string_mixed(b1 : byte; var buf; b2: byte);safecall;
   var
-   p: ^byte;
+   p: pbytearr;
   begin
     { array is indexed from 1 }
     p := @buf;
@@ -467,7 +484,7 @@ begin
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   write('Var parameter test (src : LOC_REFERENCE (orddef)))...');
   proc_var_s32bit(global_s32bit);
   if global_s32bit <> RESULT_S32BIT then
@@ -490,7 +507,7 @@ begin
     fail
   else
     WriteLn('Passed!');
-  
+
   write('Var parameter test (src : LOC_REFERENCE (recorddef)))...');
   clear_globals;
   clear_values;
@@ -499,34 +516,34 @@ begin
   proc_var_smallrecord(value_smallrec);
   if (value_smallrec.b <> RESULT_U8BIT) or (value_smallrec.w <> RESULT_U16BIT) then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   proc_var_largerecord(value_largerec);
   if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[2] <> RESULT_U8BIT) then
     failed := true;
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
-    
+
   write('var parameter test (src : LOC_REFERENCE (setdef)))...');
   clear_globals;
   clear_values;
   failed := false;
-  
+
   proc_var_smallset(value_smallset);
   if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   proc_var_largeset(value_largeset);
   if not ('I' in value_largeset) then
     failed := true;
-    
+
   if failed then
     fail
   else
@@ -553,18 +570,18 @@ begin
   if (value_smallstring <> RESULT_SMALLSTRING) or (global_u8bit <> high(value_smallstring)) then
     failed := true;
 
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
-    
+
   write('Var parameter test (src : LOC_REFERENCE (formaldef)))...');
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   proc_var_formaldef_array(value_smallarray);
   if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
     failed := true;
@@ -576,11 +593,11 @@ begin
     WriteLn('Passed!');
 
   write('Var parameter test (src : LOC_REFERENCE (arraydef)))...');
-  
+
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
   proc_var_smallarray(value_smallarray);
   if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
@@ -594,7 +611,7 @@ begin
   proc_var_smallarray_open(value_smallarray);
   if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
     failed := true;
-    
+
 (*   HOW CAN ARRAY OF CONST VAR PARAMETERS BE TESTED?
   clear_globals;
   clear_values;
@@ -607,10 +624,10 @@ begin
   value_char := RESULT_CHAR;
   value_s64real:=RESULT_S64REAL;
   proc_var_smallarray_var_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real,value_boolean,value_class]);
-  
+
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if global_char <> RESULT_CHAR then
     failed := true;
   if global_boolean <> RESULT_BOOLEAN then
@@ -620,7 +637,7 @@ begin
   if global_bigstring <> RESULT_SMALLSTRING then
      failed := true;
   if global_ptr <> value_ptr then
-     failed := true; 
+     failed := true;
 {  if value_class <> global_class then
      failed := true;!!!!!!!!!!!!!!!!!!!!}
   if global_s64bit <> RESULT_S64BIT then
@@ -638,12 +655,12 @@ begin
     fail
   else
     WriteLn('Passed!');
-    
+
   {***************************** MIXED  TESTS *******************************}
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   write('Var parameter test (src : LOC_REFERENCE (orddef)))...');
   proc_var_s32bit_mixed(RESULT_U8BIT, global_s32bit, RESULT_U8BIT);
   if global_s32bit <> RESULT_S32BIT then
@@ -672,7 +689,7 @@ begin
     fail
   else
     WriteLn('Passed!');
-  
+
   write('Var parameter test (src : LOC_REFERENCE (recorddef)))...');
   clear_globals;
   clear_values;
@@ -683,7 +700,7 @@ begin
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   proc_var_largerecord_mixed(RESULT_U8BIT, value_largerec, RESULT_U8BIT);
@@ -691,24 +708,24 @@ begin
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
-    
+
   write('var parameter test (src : LOC_REFERENCE (setdef)))...');
   clear_globals;
   clear_values;
   failed := false;
-  
+
   proc_var_smallset_mixed(RESULT_U8BIT, value_smallset, RESULT_U8BIT);
   if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   proc_var_largeset_mixed(RESULT_U8BIT, value_largeset, RESULT_U8BIT);
@@ -716,7 +733,7 @@ begin
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
@@ -749,18 +766,18 @@ begin
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
 
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
-    
+
   write('Var parameter test (src : LOC_REFERENCE (formaldef)))...');
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   proc_var_formaldef_array_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT);
   if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
     failed := true;
@@ -774,11 +791,11 @@ begin
     WriteLn('Passed!');
 
   write('Var parameter test (src : LOC_REFERENCE (arraydef)))...');
-  
+
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
   proc_var_smallarray_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT);
   if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
@@ -801,13 +818,16 @@ begin
     fail
   else
     WriteLn('Passed!');
-  
+
 end.
 
 
 {
   $Log$
-  Revision 1.1  2002-04-13 17:51:00  carl
+  Revision 1.2  2002-05-13 13:45:38  peter
+    * updated to compile tests with kylix
+
+  Revision 1.1  2002/04/13 17:51:00  carl
   + var parameter passing for different calling conventions
 
 

tests/test/cg/tcalvar7.pp

@@ -18,12 +18,17 @@
 {          (var   parameters with register calling convention)   }
 {****************************************************************}
 program tcalvar7;
-{$mode objfpc}
-{$INLINE ON}
+{$ifdef fpc}
+  {$mode objfpc}
+  {$INLINE ON}
+{$endif}
 {$R+}
 {$P-}
 {$V+}
 
+{$ifdef VER70}
+  {$define tp}
+{$endif}
 
 
  { REAL should map to single or double }
@@ -34,11 +39,16 @@ program tcalvar7;
 
  const
 { should be defined depending on CPU target }
-{$ifdef cpu68k}
-  BIG_INDEX = 8000;
-  SMALL_INDEX  = 13;
-{$endif}
-{$ifdef cpui386}
+{$ifdef fpc}
+  {$ifdef cpu68k}
+    BIG_INDEX = 8000;
+    SMALL_INDEX  = 13;
+  {$endif}
+  {$ifdef cpui386}
+    BIG_INDEX = 33000;
+    SMALL_INDEX = 13;     { value should not be aligned! }
+  {$endif}
+{$else}
   BIG_INDEX = 33000;
   SMALL_INDEX = 13;     { value should not be aligned! }
 {$endif}
@@ -56,36 +66,43 @@ program tcalvar7;
   RESULT_SMALLSTRING = 'H';
   RESULT_CHAR = 'I';
   RESULT_BOOLEAN = TRUE;
-  
-type 
+
+type
+{$ifdef fpc}
+  pbytearr=^byte;
+{$else}
+  pbytearr=^tbytearr;
+  tbytearr=array[0..$fffffff] of byte;
+{$endif}
+
   tclass1 = class
   end;
-  
+
   tprocedure = procedure;
-  
+
   tsmallrecord = packed record
     b: byte;
     w: word;
   end;
-  
+
   tlargerecord = packed record
     b: array[1..BIG_INDEX] of byte;
   end;
-  
+
   tsmallarray = packed array[1..SMALL_INDEX] of byte;
-  
-  tsmallsetenum = 
+
+  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;
@@ -117,14 +134,14 @@ var
  value_smallarray : tsmallarray;
  value_boolean : boolean;
  value_char : char;
- 
+
     procedure fail;
     begin
       WriteLn('Failure.');
       halt(1);
     end;
-    
-    
+
+
     procedure clear_globals;
      begin
       global_u8bit := 0;
@@ -140,8 +157,8 @@ var
       global_boolean := false;
       global_char := #0;
      end;
-     
-     
+
+
     procedure clear_values;
      begin
       value_u8bit := 0;
@@ -163,8 +180,8 @@ var
       value_boolean := false;
       value_char:=#0;
      end;
-     
-   
+
+
   procedure testprocedure;
    begin
    end;
@@ -173,22 +190,22 @@ var
     begin
       getu8bit:=RESULT_U8BIT;
     end;
-    
+
    function getu16bit: word;
      begin
        getu16bit:=RESULT_U16BIT;
      end;
-     
+
    function gets32bit: longint;
     begin
       gets32bit:=RESULT_S32BIT;
     end;
-    
+
    function gets64bit: longint;
     begin
       gets64bit:=RESULT_S32BIT;
     end;
- 
+
 
    function gets32real: single;
     begin
@@ -207,7 +224,7 @@ var
    begin
      v:=RESULT_S32BIT;
    end;
-   
+
   procedure proc_var_s64bit(var v: int64);register;
    begin
      v:=RESULT_S64BIT;
@@ -218,7 +235,7 @@ var
    begin
      v:=RESULT_U8BIT;
    end;
-   
+
   procedure proc_var_smallrecord(var smallrec : tsmallrecord);register;
    begin
      smallrec.b := RESULT_U8BIT;
@@ -237,38 +254,38 @@ var
    begin
      smallset := [A_A,A_D];
    end;
-   
-   
+
+
   procedure proc_var_largeset(var largeset : tlargeset);register;
    begin
      largeset:= largeset + ['I'];
    end;
-   
+
 
   procedure proc_var_smallstring(var s:tsmallstring);register;
    begin
      s:=RESULT_SMALLSTRING;
    end;
-    
+
 
   procedure proc_var_bigstring(var s:shortstring);register;
    begin
      s:=RESULT_BIGSTRING;
    end;
-   
+
 
   procedure proc_var_openstring(var s: OpenString);register;
    begin
     global_u8bit := high(s);
     s:=RESULT_SMALLSTRING;
    end;
-   
+
   procedure proc_var_smallarray(var arr : tsmallarray);register;
   begin
     arr[SMALL_INDEX] := RESULT_U8BIT;
     arr[1] := RESULT_U8BIT;
   end;
-  
+
   procedure proc_var_smallarray_open(var arr : array of byte);register;
   begin
     arr[high(arr)] := RESULT_U8BIT;
@@ -281,7 +298,7 @@ var
   begin
     for i:=0 to high(arr) do
      begin
-       case arr[i].vtype of 
+       case arr[i].vtype of
         vtInteger : arr[i].vinteger := RESULT_U8BIT;
         vtBoolean : arr[i].vboolean := RESULT_BOOLEAN;
         else
@@ -289,7 +306,7 @@ var
        end;
      end; {endfor}
   end;
-  
+
 
   procedure proc_var_smallarray_const_2(var arr : array of const);register;
   var
@@ -298,11 +315,11 @@ var
      if high(arr)<0 then
        global_u8bit := RESULT_U8BIT;
   end;
-   
+
 
   procedure proc_var_formaldef_array(var buf);register;
   var
-   p: ^byte;
+   p: pbytearr;
   begin
     { array is indexed from 1 }
     p := @buf;
@@ -313,14 +330,14 @@ var
 
 procedure proc_var_formaldef_string(var buf);register;
   var
-   p: ^byte;
+   p: pbytearr;
   begin
     { array is indexed from 1 }
     p := @buf;
     p[SMALL_INDEX-1] := RESULT_U8BIT;
     p[0] := RESULT_U8BIT;
   end;
-   
+
 
   {************************************************************************}
   {                     MIXED   VAR PARAMETERS                             }
@@ -330,7 +347,7 @@ procedure proc_var_formaldef_string(var buf);register;
      v:=RESULT_S32BIT;
      value_u8bit := RESULT_U8BIT;
    end;
-   
+
   procedure proc_var_s64bit_mixed(b1 : byte;var v: int64; b2: byte);register;
    begin
      v:=RESULT_S64BIT;
@@ -343,7 +360,7 @@ procedure proc_var_formaldef_string(var buf);register;
      v:=RESULT_U8BIT;
      value_u8bit := RESULT_U8BIT;
    end;
-   
+
   procedure proc_var_smallrecord_mixed(b1 : byte; var smallrec : tsmallrecord; b2: byte);register;
    begin
      smallrec.b := RESULT_U8BIT;
@@ -365,28 +382,28 @@ procedure proc_var_formaldef_string(var buf);register;
      smallset := [A_A,A_D];
      value_u8bit := RESULT_U8BIT;
    end;
-   
-   
+
+
   procedure proc_var_largeset_mixed(b1 : byte; var largeset : tlargeset; b2: byte);register;
    begin
      largeset:= largeset + ['I'];
      value_u8bit := RESULT_U8BIT;
    end;
-   
+
 
   procedure proc_var_smallstring_mixed(b1 : byte; var s:tsmallstring; b2: byte);register;
    begin
      s:=RESULT_SMALLSTRING;
      value_u8bit := RESULT_U8BIT;
    end;
-    
+
 
   procedure proc_var_bigstring_mixed(b1 : byte; var s:shortstring; b2: byte);register;
    begin
      s:=RESULT_BIGSTRING;
      value_u8bit := RESULT_U8BIT;
    end;
-   
+
 
   procedure proc_var_openstring_mixed(b1 : byte; var s: OpenString; b2: byte);register;
    begin
@@ -394,14 +411,14 @@ procedure proc_var_formaldef_string(var buf);register;
     s:=RESULT_SMALLSTRING;
     value_u8bit := RESULT_U8BIT;
    end;
-   
+
   procedure proc_var_smallarray_mixed(b1 : byte; var arr : tsmallarray; b2: byte);register;
   begin
     arr[SMALL_INDEX] := RESULT_U8BIT;
     arr[1] := RESULT_U8BIT;
     value_u8bit := RESULT_U8BIT;
   end;
-  
+
   procedure proc_var_smallarray_open_mixed(b1 : byte; var arr : array of byte; b2: byte);register;
   begin
     arr[high(arr)] := RESULT_U8BIT;
@@ -415,7 +432,7 @@ procedure proc_var_formaldef_string(var buf);register;
   begin
     for i:=0 to high(arr) do
      begin
-       case arr[i].vtype of 
+       case arr[i].vtype of
         vtInteger : arr[i].vinteger := RESULT_U8BIT;
         vtBoolean : arr[i].vboolean := RESULT_BOOLEAN;
         else
@@ -424,7 +441,7 @@ procedure proc_var_formaldef_string(var buf);register;
      end; {endfor}
      value_u8bit := RESULT_U8BIT;
  end;
-  
+
 
   procedure proc_var_smallarray_const_2_mixed(b1 : byte; var arr : array of const; b2: byte);register;
   var
@@ -434,11 +451,11 @@ procedure proc_var_formaldef_string(var buf);register;
        global_u8bit := RESULT_U8BIT;
      value_u8bit := RESULT_U8BIT;
 end;
-   
+
 
   procedure proc_var_formaldef_array_mixed(b1 : byte; var buf; b2: byte);register;
   var
-   p: ^byte;
+   p: pbytearr;
   begin
     { array is indexed from 1 }
     p := @buf;
@@ -450,7 +467,7 @@ end;
 
 procedure proc_var_formaldef_string_mixed(b1 : byte; var buf; b2: byte);register;
   var
-   p: ^byte;
+   p: pbytearr;
   begin
     { array is indexed from 1 }
     p := @buf;
@@ -467,7 +484,7 @@ begin
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   write('Var parameter test (src : LOC_REFERENCE (orddef)))...');
   proc_var_s32bit(global_s32bit);
   if global_s32bit <> RESULT_S32BIT then
@@ -490,7 +507,7 @@ begin
     fail
   else
     WriteLn('Passed!');
-  
+
   write('Var parameter test (src : LOC_REFERENCE (recorddef)))...');
   clear_globals;
   clear_values;
@@ -499,34 +516,34 @@ begin
   proc_var_smallrecord(value_smallrec);
   if (value_smallrec.b <> RESULT_U8BIT) or (value_smallrec.w <> RESULT_U16BIT) then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   proc_var_largerecord(value_largerec);
   if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[2] <> RESULT_U8BIT) then
     failed := true;
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
-    
+
   write('var parameter test (src : LOC_REFERENCE (setdef)))...');
   clear_globals;
   clear_values;
   failed := false;
-  
+
   proc_var_smallset(value_smallset);
   if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   proc_var_largeset(value_largeset);
   if not ('I' in value_largeset) then
     failed := true;
-    
+
   if failed then
     fail
   else
@@ -553,18 +570,18 @@ begin
   if (value_smallstring <> RESULT_SMALLSTRING) or (global_u8bit <> high(value_smallstring)) then
     failed := true;
 
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
-    
+
   write('Var parameter test (src : LOC_REFERENCE (formaldef)))...');
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   proc_var_formaldef_array(value_smallarray);
   if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
     failed := true;
@@ -576,11 +593,11 @@ begin
     WriteLn('Passed!');
 
   write('Var parameter test (src : LOC_REFERENCE (arraydef)))...');
-  
+
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
   proc_var_smallarray(value_smallarray);
   if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
@@ -594,7 +611,7 @@ begin
   proc_var_smallarray_open(value_smallarray);
   if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
     failed := true;
-    
+
 (*   HOW CAN ARRAY OF CONST VAR PARAMETERS BE TESTED?
   clear_globals;
   clear_values;
@@ -607,10 +624,10 @@ begin
   value_char := RESULT_CHAR;
   value_s64real:=RESULT_S64REAL;
   proc_var_smallarray_var_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real,value_boolean,value_class]);
-  
+
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if global_char <> RESULT_CHAR then
     failed := true;
   if global_boolean <> RESULT_BOOLEAN then
@@ -620,7 +637,7 @@ begin
   if global_bigstring <> RESULT_SMALLSTRING then
      failed := true;
   if global_ptr <> value_ptr then
-     failed := true; 
+     failed := true;
 {  if value_class <> global_class then
      failed := true;!!!!!!!!!!!!!!!!!!!!}
   if global_s64bit <> RESULT_S64BIT then
@@ -638,12 +655,12 @@ begin
     fail
   else
     WriteLn('Passed!');
-    
+
   {***************************** MIXED  TESTS *******************************}
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   write('Var parameter test (src : LOC_REFERENCE (orddef)))...');
   proc_var_s32bit_mixed(RESULT_U8BIT, global_s32bit, RESULT_U8BIT);
   if global_s32bit <> RESULT_S32BIT then
@@ -672,7 +689,7 @@ begin
     fail
   else
     WriteLn('Passed!');
-  
+
   write('Var parameter test (src : LOC_REFERENCE (recorddef)))...');
   clear_globals;
   clear_values;
@@ -683,7 +700,7 @@ begin
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   proc_var_largerecord_mixed(RESULT_U8BIT, value_largerec, RESULT_U8BIT);
@@ -691,24 +708,24 @@ begin
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
-    
+
   write('var parameter test (src : LOC_REFERENCE (setdef)))...');
   clear_globals;
   clear_values;
   failed := false;
-  
+
   proc_var_smallset_mixed(RESULT_U8BIT, value_smallset, RESULT_U8BIT);
   if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   proc_var_largeset_mixed(RESULT_U8BIT, value_largeset, RESULT_U8BIT);
@@ -716,7 +733,7 @@ begin
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
@@ -749,18 +766,18 @@ begin
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
 
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
-    
+
   write('Var parameter test (src : LOC_REFERENCE (formaldef)))...');
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   proc_var_formaldef_array_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT);
   if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
     failed := true;
@@ -774,11 +791,11 @@ begin
     WriteLn('Passed!');
 
   write('Var parameter test (src : LOC_REFERENCE (arraydef)))...');
-  
+
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
   proc_var_smallarray_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT);
   if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
@@ -801,13 +818,16 @@ begin
     fail
   else
     WriteLn('Passed!');
-  
+
 end.
 
 
 {
   $Log$
-  Revision 1.1  2002-04-13 17:51:00  carl
+  Revision 1.2  2002-05-13 13:45:38  peter
+    * updated to compile tests with kylix
+
+  Revision 1.1  2002/04/13 17:51:00  carl
   + var parameter passing for different calling conventions
 
 

tests/test/cg/tcalvar8.pp

@@ -18,12 +18,17 @@
 {          (var   parameters with stdcall  calling convention)   }
 {****************************************************************}
 program tcalvar8;
-{$mode objfpc}
-{$INLINE ON}
+{$ifdef fpc}
+  {$mode objfpc}
+  {$INLINE ON}
+{$endif}
 {$R+}
 {$P-}
 {$V+}
 
+{$ifdef VER70}
+  {$define tp}
+{$endif}
 
 
  { REAL should map to single or double }
@@ -34,11 +39,16 @@ program tcalvar8;
 
  const
 { should be defined depending on CPU target }
-{$ifdef cpu68k}
-  BIG_INDEX = 8000;
-  SMALL_INDEX  = 13;
-{$endif}
-{$ifdef cpui386}
+{$ifdef fpc}
+  {$ifdef cpu68k}
+    BIG_INDEX = 8000;
+    SMALL_INDEX  = 13;
+  {$endif}
+  {$ifdef cpui386}
+    BIG_INDEX = 33000;
+    SMALL_INDEX = 13;     { value should not be aligned! }
+  {$endif}
+{$else}
   BIG_INDEX = 33000;
   SMALL_INDEX = 13;     { value should not be aligned! }
 {$endif}
@@ -56,36 +66,43 @@ program tcalvar8;
   RESULT_SMALLSTRING = 'H';
   RESULT_CHAR = 'I';
   RESULT_BOOLEAN = TRUE;
-  
-type 
+
+type
+{$ifdef fpc}
+  pbytearr=^byte;
+{$else}
+  pbytearr=^tbytearr;
+  tbytearr=array[0..$fffffff] of byte;
+{$endif}
+
   tclass1 = class
   end;
-  
+
   tprocedure = procedure;
-  
+
   tsmallrecord = packed record
     b: byte;
     w: word;
   end;
-  
+
   tlargerecord = packed record
     b: array[1..BIG_INDEX] of byte;
   end;
-  
+
   tsmallarray = packed array[1..SMALL_INDEX] of byte;
-  
-  tsmallsetenum = 
+
+  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;
@@ -117,14 +134,14 @@ var
  value_smallarray : tsmallarray;
  value_boolean : boolean;
  value_char : char;
- 
+
     procedure fail;
     begin
       WriteLn('Failure.');
       halt(1);
     end;
-    
-    
+
+
     procedure clear_globals;
      begin
       global_u8bit := 0;
@@ -140,8 +157,8 @@ var
       global_boolean := false;
       global_char := #0;
      end;
-     
-     
+
+
     procedure clear_values;
      begin
       value_u8bit := 0;
@@ -163,8 +180,8 @@ var
       value_boolean := false;
       value_char:=#0;
      end;
-     
-   
+
+
   procedure testprocedure;
    begin
    end;
@@ -173,22 +190,22 @@ var
     begin
       getu8bit:=RESULT_U8BIT;
     end;
-    
+
    function getu16bit: word;
      begin
        getu16bit:=RESULT_U16BIT;
      end;
-     
+
    function gets32bit: longint;
     begin
       gets32bit:=RESULT_S32BIT;
     end;
-    
+
    function gets64bit: longint;
     begin
       gets64bit:=RESULT_S32BIT;
     end;
- 
+
 
    function gets32real: single;
     begin
@@ -207,7 +224,7 @@ var
    begin
      v:=RESULT_S32BIT;
    end;
-   
+
   procedure proc_var_s64bit(var v: int64);stdcall;
    begin
      v:=RESULT_S64BIT;
@@ -218,7 +235,7 @@ var
    begin
      v:=RESULT_U8BIT;
    end;
-   
+
   procedure proc_var_smallrecord(var smallrec : tsmallrecord);stdcall;
    begin
      smallrec.b := RESULT_U8BIT;
@@ -237,38 +254,38 @@ var
    begin
      smallset := [A_A,A_D];
    end;
-   
-   
+
+
   procedure proc_var_largeset(var largeset : tlargeset);stdcall;
    begin
      largeset:= largeset + ['I'];
    end;
-   
+
 
   procedure proc_var_smallstring(var s:tsmallstring);stdcall;
    begin
      s:=RESULT_SMALLSTRING;
    end;
-    
+
 
   procedure proc_var_bigstring(var s:shortstring);stdcall;
    begin
      s:=RESULT_BIGSTRING;
    end;
-   
+
 
   procedure proc_var_openstring(var s: OpenString);stdcall;
    begin
     global_u8bit := high(s);
     s:=RESULT_SMALLSTRING;
    end;
-   
+
   procedure proc_var_smallarray(var arr : tsmallarray);stdcall;
   begin
     arr[SMALL_INDEX] := RESULT_U8BIT;
     arr[1] := RESULT_U8BIT;
   end;
-  
+
   procedure proc_var_smallarray_open(var arr : array of byte);stdcall;
   begin
     arr[high(arr)] := RESULT_U8BIT;
@@ -281,7 +298,7 @@ var
   begin
     for i:=0 to high(arr) do
      begin
-       case arr[i].vtype of 
+       case arr[i].vtype of
         vtInteger : arr[i].vinteger := RESULT_U8BIT;
         vtBoolean : arr[i].vboolean := RESULT_BOOLEAN;
         else
@@ -289,7 +306,7 @@ var
        end;
      end; {endfor}
   end;
-  
+
 
   procedure proc_var_smallarray_const_2(var arr : array of const);stdcall;
   var
@@ -298,11 +315,11 @@ var
      if high(arr)<0 then
        global_u8bit := RESULT_U8BIT;
   end;
-   
+
 
   procedure proc_var_formaldef_array(var buf);stdcall;
   var
-   p: ^byte;
+   p: pbytearr;
   begin
     { array is indexed from 1 }
     p := @buf;
@@ -313,14 +330,14 @@ var
 
 procedure proc_var_formaldef_string(var buf);stdcall;
   var
-   p: ^byte;
+   p: pbytearr;
   begin
     { array is indexed from 1 }
     p := @buf;
     p[SMALL_INDEX-1] := RESULT_U8BIT;
     p[0] := RESULT_U8BIT;
   end;
-   
+
 
   {************************************************************************}
   {                     MIXED   VAR PARAMETERS                             }
@@ -330,7 +347,7 @@ procedure proc_var_formaldef_string(var buf);stdcall;
      v:=RESULT_S32BIT;
      value_u8bit := RESULT_U8BIT;
    end;
-   
+
   procedure proc_var_s64bit_mixed(b1 : byte;var v: int64; b2: byte);stdcall;
    begin
      v:=RESULT_S64BIT;
@@ -343,7 +360,7 @@ procedure proc_var_formaldef_string(var buf);stdcall;
      v:=RESULT_U8BIT;
      value_u8bit := RESULT_U8BIT;
    end;
-   
+
   procedure proc_var_smallrecord_mixed(b1 : byte; var smallrec : tsmallrecord; b2: byte);stdcall;
    begin
      smallrec.b := RESULT_U8BIT;
@@ -365,28 +382,28 @@ procedure proc_var_formaldef_string(var buf);stdcall;
      smallset := [A_A,A_D];
      value_u8bit := RESULT_U8BIT;
    end;
-   
-   
+
+
   procedure proc_var_largeset_mixed(b1 : byte; var largeset : tlargeset; b2: byte);stdcall;
    begin
      largeset:= largeset + ['I'];
      value_u8bit := RESULT_U8BIT;
    end;
-   
+
 
   procedure proc_var_smallstring_mixed(b1 : byte; var s:tsmallstring; b2: byte);stdcall;
    begin
      s:=RESULT_SMALLSTRING;
      value_u8bit := RESULT_U8BIT;
    end;
-    
+
 
   procedure proc_var_bigstring_mixed(b1 : byte; var s:shortstring; b2: byte);stdcall;
    begin
      s:=RESULT_BIGSTRING;
      value_u8bit := RESULT_U8BIT;
    end;
-   
+
 
   procedure proc_var_openstring_mixed(b1 : byte; var s: OpenString; b2: byte);stdcall;
    begin
@@ -394,14 +411,14 @@ procedure proc_var_formaldef_string(var buf);stdcall;
     s:=RESULT_SMALLSTRING;
     value_u8bit := RESULT_U8BIT;
    end;
-   
+
   procedure proc_var_smallarray_mixed(b1 : byte; var arr : tsmallarray; b2: byte);stdcall;
   begin
     arr[SMALL_INDEX] := RESULT_U8BIT;
     arr[1] := RESULT_U8BIT;
     value_u8bit := RESULT_U8BIT;
   end;
-  
+
   procedure proc_var_smallarray_open_mixed(b1 : byte; var arr : array of byte; b2: byte);stdcall;
   begin
     arr[high(arr)] := RESULT_U8BIT;
@@ -415,7 +432,7 @@ procedure proc_var_formaldef_string(var buf);stdcall;
   begin
     for i:=0 to high(arr) do
      begin
-       case arr[i].vtype of 
+       case arr[i].vtype of
         vtInteger : arr[i].vinteger := RESULT_U8BIT;
         vtBoolean : arr[i].vboolean := RESULT_BOOLEAN;
         else
@@ -424,7 +441,7 @@ procedure proc_var_formaldef_string(var buf);stdcall;
      end; {endfor}
      value_u8bit := RESULT_U8BIT;
  end;
-  
+
 
   procedure proc_var_smallarray_const_2_mixed(b1 : byte; var arr : array of const; b2: byte);stdcall;
   var
@@ -434,11 +451,11 @@ procedure proc_var_formaldef_string(var buf);stdcall;
        global_u8bit := RESULT_U8BIT;
      value_u8bit := RESULT_U8BIT;
 end;
-   
+
 
   procedure proc_var_formaldef_array_mixed(b1 : byte; var buf; b2: byte);stdcall;
   var
-   p: ^byte;
+   p: pbytearr;
   begin
     { array is indexed from 1 }
     p := @buf;
@@ -450,7 +467,7 @@ end;
 
 procedure proc_var_formaldef_string_mixed(b1 : byte; var buf; b2: byte);stdcall;
   var
-   p: ^byte;
+   p: pbytearr;
   begin
     { array is indexed from 1 }
     p := @buf;
@@ -467,7 +484,7 @@ begin
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   write('Var parameter test (src : LOC_REFERENCE (orddef)))...');
   proc_var_s32bit(global_s32bit);
   if global_s32bit <> RESULT_S32BIT then
@@ -490,7 +507,7 @@ begin
     fail
   else
     WriteLn('Passed!');
-  
+
   write('Var parameter test (src : LOC_REFERENCE (recorddef)))...');
   clear_globals;
   clear_values;
@@ -499,34 +516,34 @@ begin
   proc_var_smallrecord(value_smallrec);
   if (value_smallrec.b <> RESULT_U8BIT) or (value_smallrec.w <> RESULT_U16BIT) then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   proc_var_largerecord(value_largerec);
   if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[2] <> RESULT_U8BIT) then
     failed := true;
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
-    
+
   write('var parameter test (src : LOC_REFERENCE (setdef)))...');
   clear_globals;
   clear_values;
   failed := false;
-  
+
   proc_var_smallset(value_smallset);
   if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   proc_var_largeset(value_largeset);
   if not ('I' in value_largeset) then
     failed := true;
-    
+
   if failed then
     fail
   else
@@ -553,18 +570,18 @@ begin
   if (value_smallstring <> RESULT_SMALLSTRING) or (global_u8bit <> high(value_smallstring)) then
     failed := true;
 
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
-    
+
   write('Var parameter test (src : LOC_REFERENCE (formaldef)))...');
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   proc_var_formaldef_array(value_smallarray);
   if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
     failed := true;
@@ -576,11 +593,11 @@ begin
     WriteLn('Passed!');
 
   write('Var parameter test (src : LOC_REFERENCE (arraydef)))...');
-  
+
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
   proc_var_smallarray(value_smallarray);
   if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
@@ -594,7 +611,7 @@ begin
   proc_var_smallarray_open(value_smallarray);
   if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
     failed := true;
-    
+
 (*   HOW CAN ARRAY OF CONST VAR PARAMETERS BE TESTED?
   clear_globals;
   clear_values;
@@ -607,10 +624,10 @@ begin
   value_char := RESULT_CHAR;
   value_s64real:=RESULT_S64REAL;
   proc_var_smallarray_var_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real,value_boolean,value_class]);
-  
+
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if global_char <> RESULT_CHAR then
     failed := true;
   if global_boolean <> RESULT_BOOLEAN then
@@ -620,7 +637,7 @@ begin
   if global_bigstring <> RESULT_SMALLSTRING then
      failed := true;
   if global_ptr <> value_ptr then
-     failed := true; 
+     failed := true;
 {  if value_class <> global_class then
      failed := true;!!!!!!!!!!!!!!!!!!!!}
   if global_s64bit <> RESULT_S64BIT then
@@ -638,12 +655,12 @@ begin
     fail
   else
     WriteLn('Passed!');
-    
+
   {***************************** MIXED  TESTS *******************************}
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   write('Var parameter test (src : LOC_REFERENCE (orddef)))...');
   proc_var_s32bit_mixed(RESULT_U8BIT, global_s32bit, RESULT_U8BIT);
   if global_s32bit <> RESULT_S32BIT then
@@ -672,7 +689,7 @@ begin
     fail
   else
     WriteLn('Passed!');
-  
+
   write('Var parameter test (src : LOC_REFERENCE (recorddef)))...');
   clear_globals;
   clear_values;
@@ -683,7 +700,7 @@ begin
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   proc_var_largerecord_mixed(RESULT_U8BIT, value_largerec, RESULT_U8BIT);
@@ -691,24 +708,24 @@ begin
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
-    
+
   write('var parameter test (src : LOC_REFERENCE (setdef)))...');
   clear_globals;
   clear_values;
   failed := false;
-  
+
   proc_var_smallset_mixed(RESULT_U8BIT, value_smallset, RESULT_U8BIT);
   if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   proc_var_largeset_mixed(RESULT_U8BIT, value_largeset, RESULT_U8BIT);
@@ -716,7 +733,7 @@ begin
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
@@ -749,18 +766,18 @@ begin
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
 
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
-    
+
   write('Var parameter test (src : LOC_REFERENCE (formaldef)))...');
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   proc_var_formaldef_array_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT);
   if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
     failed := true;
@@ -774,11 +791,11 @@ begin
     WriteLn('Passed!');
 
   write('Var parameter test (src : LOC_REFERENCE (arraydef)))...');
-  
+
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
   proc_var_smallarray_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT);
   if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
@@ -801,13 +818,16 @@ begin
     fail
   else
     WriteLn('Passed!');
-  
+
 end.
 
 
 {
   $Log$
-  Revision 1.1  2002-04-13 17:51:00  carl
+  Revision 1.2  2002-05-13 13:45:38  peter
+    * updated to compile tests with kylix
+
+  Revision 1.1  2002/04/13 17:51:00  carl
   + var parameter passing for different calling conventions
 
 

tests/test/cg/tcalvar9.pp

@@ -18,12 +18,17 @@
 {          (var   parameters with saveregs  calling convention)  }
 {****************************************************************}
 program tcalvar9;
-{$mode objfpc}
-{$INLINE ON}
+{$ifdef fpc}
+  {$mode objfpc}
+  {$INLINE ON}
+{$endif}
 {$R+}
 {$P-}
 {$V+}
 
+{$ifdef VER70}
+  {$define tp}
+{$endif}
 
 
  { REAL should map to single or double }
@@ -34,11 +39,16 @@ program tcalvar9;
 
  const
 { should be defined depending on CPU target }
-{$ifdef cpu68k}
-  BIG_INDEX = 8000;
-  SMALL_INDEX  = 13;
-{$endif}
-{$ifdef cpui386}
+{$ifdef fpc}
+  {$ifdef cpu68k}
+    BIG_INDEX = 8000;
+    SMALL_INDEX  = 13;
+  {$endif}
+  {$ifdef cpui386}
+    BIG_INDEX = 33000;
+    SMALL_INDEX = 13;     { value should not be aligned! }
+  {$endif}
+{$else}
   BIG_INDEX = 33000;
   SMALL_INDEX = 13;     { value should not be aligned! }
 {$endif}
@@ -56,36 +66,43 @@ program tcalvar9;
   RESULT_SMALLSTRING = 'H';
   RESULT_CHAR = 'I';
   RESULT_BOOLEAN = TRUE;
-  
-type 
+
+type
+{$ifdef fpc}
+  pbytearr=^byte;
+{$else}
+  pbytearr=^tbytearr;
+  tbytearr=array[0..$fffffff] of byte;
+{$endif}
+
   tclass1 = class
   end;
-  
+
   tprocedure = procedure;
-  
+
   tsmallrecord = packed record
     b: byte;
     w: word;
   end;
-  
+
   tlargerecord = packed record
     b: array[1..BIG_INDEX] of byte;
   end;
-  
+
   tsmallarray = packed array[1..SMALL_INDEX] of byte;
-  
-  tsmallsetenum = 
+
+  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;
@@ -117,14 +134,14 @@ var
  value_smallarray : tsmallarray;
  value_boolean : boolean;
  value_char : char;
- 
+
     procedure fail;
     begin
       WriteLn('Failure.');
       halt(1);
     end;
-    
-    
+
+
     procedure clear_globals;
      begin
       global_u8bit := 0;
@@ -140,8 +157,8 @@ var
       global_boolean := false;
       global_char := #0;
      end;
-     
-     
+
+
     procedure clear_values;
      begin
       value_u8bit := 0;
@@ -163,8 +180,8 @@ var
       value_boolean := false;
       value_char:=#0;
      end;
-     
-   
+
+
   procedure testprocedure;
    begin
    end;
@@ -173,22 +190,22 @@ var
     begin
       getu8bit:=RESULT_U8BIT;
     end;
-    
+
    function getu16bit: word;
      begin
        getu16bit:=RESULT_U16BIT;
      end;
-     
+
    function gets32bit: longint;
     begin
       gets32bit:=RESULT_S32BIT;
     end;
-    
+
    function gets64bit: longint;
     begin
       gets64bit:=RESULT_S32BIT;
     end;
- 
+
 
    function gets32real: single;
     begin
@@ -207,7 +224,7 @@ var
    begin
      v:=RESULT_S32BIT;
    end;
-   
+
   procedure proc_var_s64bit(var v: int64);saveregisters;
    begin
      v:=RESULT_S64BIT;
@@ -218,7 +235,7 @@ var
    begin
      v:=RESULT_U8BIT;
    end;
-   
+
   procedure proc_var_smallrecord(var smallrec : tsmallrecord);saveregisters;
    begin
      smallrec.b := RESULT_U8BIT;
@@ -237,38 +254,38 @@ var
    begin
      smallset := [A_A,A_D];
    end;
-   
-   
+
+
   procedure proc_var_largeset(var largeset : tlargeset);saveregisters;
    begin
      largeset:= largeset + ['I'];
    end;
-   
+
 
   procedure proc_var_smallstring(var s:tsmallstring);saveregisters;
    begin
      s:=RESULT_SMALLSTRING;
    end;
-    
+
 
   procedure proc_var_bigstring(var s:shortstring);saveregisters;
    begin
      s:=RESULT_BIGSTRING;
    end;
-   
+
 
   procedure proc_var_openstring(var s: OpenString);saveregisters;
    begin
     global_u8bit := high(s);
     s:=RESULT_SMALLSTRING;
    end;
-   
+
   procedure proc_var_smallarray(var arr : tsmallarray);saveregisters;
   begin
     arr[SMALL_INDEX] := RESULT_U8BIT;
     arr[1] := RESULT_U8BIT;
   end;
-  
+
   procedure proc_var_smallarray_open(var arr : array of byte);saveregisters;
   begin
     arr[high(arr)] := RESULT_U8BIT;
@@ -281,7 +298,7 @@ var
   begin
     for i:=0 to high(arr) do
      begin
-       case arr[i].vtype of 
+       case arr[i].vtype of
         vtInteger : arr[i].vinteger := RESULT_U8BIT;
         vtBoolean : arr[i].vboolean := RESULT_BOOLEAN;
         else
@@ -289,7 +306,7 @@ var
        end;
      end; {endfor}
   end;
-  
+
 
   procedure proc_var_smallarray_const_2(var arr : array of const);saveregisters;
   var
@@ -298,11 +315,11 @@ var
      if high(arr)<0 then
        global_u8bit := RESULT_U8BIT;
   end;
-   
+
 
   procedure proc_var_formaldef_array(var buf);saveregisters;
   var
-   p: ^byte;
+   p: pbytearr;
   begin
     { array is indexed from 1 }
     p := @buf;
@@ -313,14 +330,14 @@ var
 
 procedure proc_var_formaldef_string(var buf);saveregisters;
   var
-   p: ^byte;
+   p: pbytearr;
   begin
     { array is indexed from 1 }
     p := @buf;
     p[SMALL_INDEX-1] := RESULT_U8BIT;
     p[0] := RESULT_U8BIT;
   end;
-   
+
 
   {************************************************************************}
   {                     MIXED   VAR PARAMETERS                             }
@@ -330,7 +347,7 @@ procedure proc_var_formaldef_string(var buf);saveregisters;
      v:=RESULT_S32BIT;
      value_u8bit := RESULT_U8BIT;
    end;
-   
+
   procedure proc_var_s64bit_mixed(b1 : byte;var v: int64; b2: byte);saveregisters;
    begin
      v:=RESULT_S64BIT;
@@ -343,7 +360,7 @@ procedure proc_var_formaldef_string(var buf);saveregisters;
      v:=RESULT_U8BIT;
      value_u8bit := RESULT_U8BIT;
    end;
-   
+
   procedure proc_var_smallrecord_mixed(b1 : byte; var smallrec : tsmallrecord; b2: byte);saveregisters;
    begin
      smallrec.b := RESULT_U8BIT;
@@ -365,28 +382,28 @@ procedure proc_var_formaldef_string(var buf);saveregisters;
      smallset := [A_A,A_D];
      value_u8bit := RESULT_U8BIT;
    end;
-   
-   
+
+
   procedure proc_var_largeset_mixed(b1 : byte; var largeset : tlargeset; b2: byte);saveregisters;
    begin
      largeset:= largeset + ['I'];
      value_u8bit := RESULT_U8BIT;
    end;
-   
+
 
   procedure proc_var_smallstring_mixed(b1 : byte; var s:tsmallstring; b2: byte);saveregisters;
    begin
      s:=RESULT_SMALLSTRING;
      value_u8bit := RESULT_U8BIT;
    end;
-    
+
 
   procedure proc_var_bigstring_mixed(b1 : byte; var s:shortstring; b2: byte);saveregisters;
    begin
      s:=RESULT_BIGSTRING;
      value_u8bit := RESULT_U8BIT;
    end;
-   
+
 
   procedure proc_var_openstring_mixed(b1 : byte; var s: OpenString; b2: byte);saveregisters;
    begin
@@ -394,14 +411,14 @@ procedure proc_var_formaldef_string(var buf);saveregisters;
     s:=RESULT_SMALLSTRING;
     value_u8bit := RESULT_U8BIT;
    end;
-   
+
   procedure proc_var_smallarray_mixed(b1 : byte; var arr : tsmallarray; b2: byte);saveregisters;
   begin
     arr[SMALL_INDEX] := RESULT_U8BIT;
     arr[1] := RESULT_U8BIT;
     value_u8bit := RESULT_U8BIT;
   end;
-  
+
   procedure proc_var_smallarray_open_mixed(b1 : byte; var arr : array of byte; b2: byte);saveregisters;
   begin
     arr[high(arr)] := RESULT_U8BIT;
@@ -415,7 +432,7 @@ procedure proc_var_formaldef_string(var buf);saveregisters;
   begin
     for i:=0 to high(arr) do
      begin
-       case arr[i].vtype of 
+       case arr[i].vtype of
         vtInteger : arr[i].vinteger := RESULT_U8BIT;
         vtBoolean : arr[i].vboolean := RESULT_BOOLEAN;
         else
@@ -424,7 +441,7 @@ procedure proc_var_formaldef_string(var buf);saveregisters;
      end; {endfor}
      value_u8bit := RESULT_U8BIT;
  end;
-  
+
 
   procedure proc_var_smallarray_const_2_mixed(b1 : byte; var arr : array of const; b2: byte);saveregisters;
   var
@@ -434,11 +451,11 @@ procedure proc_var_formaldef_string(var buf);saveregisters;
        global_u8bit := RESULT_U8BIT;
      value_u8bit := RESULT_U8BIT;
 end;
-   
+
 
   procedure proc_var_formaldef_array_mixed(b1 : byte; var buf; b2: byte);saveregisters;
   var
-   p: ^byte;
+   p: pbytearr;
   begin
     { array is indexed from 1 }
     p := @buf;
@@ -450,7 +467,7 @@ end;
 
 procedure proc_var_formaldef_string_mixed(b1 : byte; var buf; b2: byte);saveregisters;
   var
-   p: ^byte;
+   p: pbytearr;
   begin
     { array is indexed from 1 }
     p := @buf;
@@ -467,7 +484,7 @@ begin
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   write('Var parameter test (src : LOC_REFERENCE (orddef)))...');
   proc_var_s32bit(global_s32bit);
   if global_s32bit <> RESULT_S32BIT then
@@ -490,7 +507,7 @@ begin
     fail
   else
     WriteLn('Passed!');
-  
+
   write('Var parameter test (src : LOC_REFERENCE (recorddef)))...');
   clear_globals;
   clear_values;
@@ -499,34 +516,34 @@ begin
   proc_var_smallrecord(value_smallrec);
   if (value_smallrec.b <> RESULT_U8BIT) or (value_smallrec.w <> RESULT_U16BIT) then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   proc_var_largerecord(value_largerec);
   if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[2] <> RESULT_U8BIT) then
     failed := true;
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
-    
+
   write('var parameter test (src : LOC_REFERENCE (setdef)))...');
   clear_globals;
   clear_values;
   failed := false;
-  
+
   proc_var_smallset(value_smallset);
   if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   proc_var_largeset(value_largeset);
   if not ('I' in value_largeset) then
     failed := true;
-    
+
   if failed then
     fail
   else
@@ -553,18 +570,18 @@ begin
   if (value_smallstring <> RESULT_SMALLSTRING) or (global_u8bit <> high(value_smallstring)) then
     failed := true;
 
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
-    
+
   write('Var parameter test (src : LOC_REFERENCE (formaldef)))...');
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   proc_var_formaldef_array(value_smallarray);
   if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
     failed := true;
@@ -576,11 +593,11 @@ begin
     WriteLn('Passed!');
 
   write('Var parameter test (src : LOC_REFERENCE (arraydef)))...');
-  
+
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
   proc_var_smallarray(value_smallarray);
   if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
@@ -594,7 +611,7 @@ begin
   proc_var_smallarray_open(value_smallarray);
   if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
     failed := true;
-    
+
 (*   HOW CAN ARRAY OF CONST VAR PARAMETERS BE TESTED?
   clear_globals;
   clear_values;
@@ -607,10 +624,10 @@ begin
   value_char := RESULT_CHAR;
   value_s64real:=RESULT_S64REAL;
   proc_var_smallarray_var_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real,value_boolean,value_class]);
-  
+
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if global_char <> RESULT_CHAR then
     failed := true;
   if global_boolean <> RESULT_BOOLEAN then
@@ -620,7 +637,7 @@ begin
   if global_bigstring <> RESULT_SMALLSTRING then
      failed := true;
   if global_ptr <> value_ptr then
-     failed := true; 
+     failed := true;
 {  if value_class <> global_class then
      failed := true;!!!!!!!!!!!!!!!!!!!!}
   if global_s64bit <> RESULT_S64BIT then
@@ -638,12 +655,12 @@ begin
     fail
   else
     WriteLn('Passed!');
-    
+
   {***************************** MIXED  TESTS *******************************}
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   write('Var parameter test (src : LOC_REFERENCE (orddef)))...');
   proc_var_s32bit_mixed(RESULT_U8BIT, global_s32bit, RESULT_U8BIT);
   if global_s32bit <> RESULT_S32BIT then
@@ -672,7 +689,7 @@ begin
     fail
   else
     WriteLn('Passed!');
-  
+
   write('Var parameter test (src : LOC_REFERENCE (recorddef)))...');
   clear_globals;
   clear_values;
@@ -683,7 +700,7 @@ begin
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   proc_var_largerecord_mixed(RESULT_U8BIT, value_largerec, RESULT_U8BIT);
@@ -691,24 +708,24 @@ begin
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
-    
+
   write('var parameter test (src : LOC_REFERENCE (setdef)))...');
   clear_globals;
   clear_values;
   failed := false;
-  
+
   proc_var_smallset_mixed(RESULT_U8BIT, value_smallset, RESULT_U8BIT);
   if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   clear_globals;
   clear_values;
   proc_var_largeset_mixed(RESULT_U8BIT, value_largeset, RESULT_U8BIT);
@@ -716,7 +733,7 @@ begin
     failed := true;
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
-    
+
   if failed then
     fail
   else
@@ -749,18 +766,18 @@ begin
   if value_u8bit <> RESULT_U8BIT then
     failed := true;
 
-    
+
   if failed then
     fail
   else
     WriteLn('Passed!');
 
-    
+
   write('Var parameter test (src : LOC_REFERENCE (formaldef)))...');
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   proc_var_formaldef_array_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT);
   if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
     failed := true;
@@ -774,11 +791,11 @@ begin
     WriteLn('Passed!');
 
   write('Var parameter test (src : LOC_REFERENCE (arraydef)))...');
-  
+
   clear_globals;
   clear_values;
   failed:=false;
-  
+
   value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
   proc_var_smallarray_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT);
   if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then
@@ -801,13 +818,16 @@ begin
     fail
   else
     WriteLn('Passed!');
-  
+
 end.
 
 
 {
   $Log$
-  Revision 1.1  2002-04-13 17:51:00  carl
+  Revision 1.2  2002-05-13 13:45:38  peter
+    * updated to compile tests with kylix
+
+  Revision 1.1  2002/04/13 17:51:00  carl
   + var parameter passing for different calling conventions
 
 

tests/test/cg/tcnvint1.pp

@@ -14,12 +14,15 @@
 {****************************************************************}
 program tcnvint1;
 
+{$ifdef VER70}
+  {$define tp}
+{$endif}
 
 var
  tobyte : byte;
  toword : word;
  tolong : longint;
-{$ifdef fpc}
+{$ifndef tp}
  toint64 : int64;
 {$endif}
  bb1 : bytebool;
@@ -68,7 +71,7 @@ begin
  wb1 := FALSE;
  tolong := longint(wb1);
  WriteLn('wordbool->longint : value should be 0...',tolong);
-{$ifdef fpc}
+{$ifndef tp}
  bb1 := TRUE;
  toint64 :=int64(bb1);
  WriteLn('boolean->int64 : value should be 1...',toint64);
@@ -147,7 +150,7 @@ begin
  tobyte := 1;
  tolong:=longint(toword > tobyte);
  WriteLn('value should be 1...',tolong);
-{$ifdef fpc}
+{$ifndef tp}
  toword := 0;
  tobyte := 1;
  toint64:=int64(toword > tobyte);
@@ -204,7 +207,10 @@ end.
 
 {
    $Log$
-   Revision 1.2  2001-07-31 01:55:47  carl
+   Revision 1.3  2002-05-13 13:45:38  peter
+     * updated to compile tests with kylix
+
+   Revision 1.2  2001/07/31 01:55:47  carl
    * corrected small spelling mistake
 
    Revision 1.1  2001/07/27 02:56:10  carl

tests/test/cg/tcnvint2.pp

@@ -15,6 +15,10 @@
 {****************************************************************}
 program tcnvint2;
 
+{$ifdef VER70}
+  {$define tp}
+{$endif}
+
 var
   failed   : boolean;
 
@@ -33,7 +37,7 @@ var
        getlongint := $10000000;
      end;
 
-{$ifdef fpc}
+{$ifndef tp}
    function getint64: int64;
      begin
        getint64 := $10000000;
@@ -51,7 +55,7 @@ var
  frombyte : byte;
  fromword : word;
  fromlong : longint;
-{$ifdef fpc}
+{$ifndef tp}
  fromint64 : int64;
 {$endif}
  b   : boolean;
@@ -99,7 +103,7 @@ begin
  fromlong := $00000100;
  lb1 := longbool(fromlong);
  Test('longint -> longbool : Value should be TRUE...',lb1);
-{$ifdef fpc}
+{$ifndef tp}
  fromint64 := $10000000;
  lb1 := longbool(fromint64);
  Test('int64 -> longbool : Value should be TRUE...',lb1);
@@ -136,7 +140,7 @@ begin
  fromlong := $00000100;
  lb1 := longbool(getlongint);
  Test('longint -> longbool : Value should be TRUE...',lb1);
-{$ifdef fpc}
+{$ifndef tp}
  fromint64 := $10000000;
  lb1 := longbool(getint64);
  Test('int64 -> longbool : Value should be TRUE...',lb1);
@@ -164,7 +168,7 @@ begin
  fromlong := $0100;
  lb1 := longbool(fromlong > fromword);
  Test('Value should be FALSE...',lb1);
-{$ifdef fpc}
+{$ifndef tp}
  fromint64 := $10000000;
  fromlong := $02;
  lb1 := longbool(fromint64 > fromlong);
@@ -180,7 +184,10 @@ end.
 
 {
    $Log$
-   Revision 1.2  2002-03-29 12:36:03  peter
+   Revision 1.3  2002-05-13 13:45:38  peter
+     * updated to compile tests with kylix
+
+   Revision 1.2  2002/03/29 12:36:03  peter
      * add check if tests are successfull or not
 
    Revision 1.1  2001/08/31 23:56:45  carl

tests/test/cg/tcnvint3.pp

@@ -15,9 +15,13 @@
 {****************************************************************}
 program tcnvint3;
 
+{$ifdef VER70}
+  {$define tp}
+{$endif}
+
 {$R-}
 
-{$ifndef fpc}
+{$ifdef tp}
 type
   smallint = integer;
 {$endif}
@@ -32,7 +36,7 @@ end;
 const
  ABSOLUTE_GETS8BIT_RESULT    = 63;
  GETS8BIT_RESULT             = -63;
- GETU8BIT_RESULT             = $55; 
+ GETU8BIT_RESULT             = $55;
  ABSOLUTE_GETS16BIT_RESULT   = 16384;
  GETS16BIT_RESULT            = -16384;
  GETU16BIT_RESULT            = 32767;
@@ -40,7 +44,7 @@ const
  GETU32BIT_RESULT            =  2000000;
 
 
-{$ifdef fpc}
+{$ifndef tp}
    function gets64bit : int64;
     begin
       gets64bit := 12;
@@ -49,33 +53,33 @@ const
 
    function gets32bit : longint;
     begin
-      gets32bit := GETS32BIT_RESULT;    
+      gets32bit := GETS32BIT_RESULT;
     end;
-    
-  
+
+
   { return an 8-bit signed value }
   function gets8bit : shortint;
     begin
       gets8bit := GETS8BIT_RESULT;
     end;
-   
+
   { return an 8-bit unsigned value }
   function getu8bit : byte;
    begin
      getu8bit := GETU8BIT_RESULT;
    end;
-   
-   
+
+
   function gets16bit : smallint;
     begin
       gets16bit := GETS16BIT_RESULT;
     end;
-    
+
   function getu16bit : word;
     begin
       getu16bit := GETU16BIT_RESULT;
     end;
-  
+
 
    function getu32bit : longint;
     begin
@@ -89,7 +93,7 @@ var
  u16bit : word;
  u8bit : byte;
  failed : boolean;
-{$ifdef fpc}
+{$ifndef tp}
  s64bit : int64;
  u32bit : cardinal;
 {$endif}
@@ -102,7 +106,7 @@ begin
   { dst : LOC_REGISTER }
   writeln('type conversion src_size > dst_size');
   writeln('dst : LOC_REGISTER src : LOC_REGISTER ');
-{$ifdef fpc}
+{$ifndef tp}
   write('Testing dst : s32bit src : s64bit...');
   { s64bit -> s32bit  }
   s32bit:=gets64bit;
@@ -130,7 +134,7 @@ begin
   { of different memory sizes cases.                                    }
   { src : LOC_REFERENCE }
   { dst : LOC_REGISTER  }
-{$ifdef fpc}
+{$ifndef tp}
   writeln('dst : LOC_REGISTER src : LOC_REFERENCE ');
   write('Testing dst : s32bit src : s64bit...');
   s64bit:=$FF0000;
@@ -162,7 +166,7 @@ begin
     Fail
   else
     WriteLn('Passed.');
-{$ifdef fpc}
+{$ifndef tp}
   write('Testing dst : u16bit src : u32bit...');
   u32bit:=$F001;
   u16bit := u32bit;
@@ -178,10 +182,10 @@ begin
     Fail
   else
     WriteLn('Passed.');
-    
+
   { That was the easy part... now : dst_size > src_size    }
   { here we must take care of sign extension               }
-  
+
   { src : LOC_REGISTER }
   { dst : LOC_REGISTER }
   writeln('type conversion dst_size > src_size');
@@ -200,7 +204,7 @@ begin
   else
     WriteLn('Passed.');
 
-{$ifdef fpc}
+{$ifndef tp}
   failed := false;
   write('Testing dst : u32bit  src : s8bit, u8bit, s16bit, u16bit... ');
   u32bit:=gets8bit;
@@ -235,7 +239,7 @@ begin
     Fail
   else
     WriteLn('Passed.');
-  
+
 
   failed := false;
   write('Testing dst : s32bit  src : s8bit, u8bit. s16bit, u16bit...');
@@ -256,8 +260,8 @@ begin
     Fail
   else
     WriteLn('Passed.');
-  
-{$ifdef fpc}
+
+{$ifndef tp}
   failed := false;
   write('Testing dst : s64bit  src : s8bit, u8bit. s16bit, u16bit, s32bit, u32bit...');
 
@@ -304,7 +308,7 @@ begin
   else
     WriteLn('Passed.');
 
-{$ifdef fpc}
+{$ifndef tp}
   failed := false;
   write('Testing dst : u32bit  src : s8bit, u8bit, s16bit, u16bit... ');
   s8bit := GETS8BIT_RESULT;
@@ -348,7 +352,7 @@ begin
 
   failed := false;
   write('Testing dst : s32bit  src : s8bit, u8bit. s16bit, u16bit...');
-  
+
   s8bit := GETS8BIT_RESULT;
   s32bit := s8bit;
   if s32bit <> GETS8BIT_RESULT then
@@ -371,10 +375,10 @@ begin
     WriteLn('Passed.');
 
 
-{$ifdef fpc}
+{$ifndef tp}
   failed := false;
   write('Testing dst : s64bit  src : s8bit, u8bit. s16bit, u16bit, s32bit, u32bit...');
-  
+
   s8bit := GETS8BIT_RESULT;
   s64bit := s8bit;
   if s64bit <> GETS8BIT_RESULT then
@@ -409,7 +413,10 @@ end.
 {
 
  $Log$
- Revision 1.1  2002-03-18 20:20:13  carl
+ Revision 1.2  2002-05-13 13:45:38  peter
+   * updated to compile tests with kylix
+
+ Revision 1.1  2002/03/18 20:20:13  carl
  + int_int type conversion tests
 
 }