* compatibility with C checks improved

tests/test/cg/obj/ctest.c

@@ -12,7 +12,10 @@
 unsigned char global_u8bit;
 unsigned short global_u16bit;
 unsigned long global_u32bit;
-unsigned long long global_s64bit;
+short global_s16bit;
+long global_s32bit;
+long long global_s64bit;
+unsigned long long global_u64bit;
 float global_float;
 double global_double;
 long double global_long_double;
@@ -20,19 +23,33 @@ long double global_long_double;
 #define   RESULT_U8BIT    0x55
 #define   RESULT_U16BIT   0x500F
 #define   RESULT_U32BIT   0x500F0000
-#define   RESULT_S64BIT  -12000
-#define   RESULT_FLOAT   14.54
-#define   RESULT_PCHAR   "Hello world"
-#define	  RESULT_LONGDOUBLE  RESULT_FLOAT
-#define   RESULT_DOUBLE      RESULT_FLOAT
+#define   RESULT_S16BIT   -12
+#define   RESULT_S32BIT   -120
+#define   RESULT_S64BIT   -12000
+#define   RESULT_U64BIT   0x1BCDABCD
+#define   RESULT_PCHAR    "Hello world"
+#define   RESULT_FLOAT       14.54
+#define   RESULT_DOUBLE      15.54
+#define	  RESULT_LONGDOUBLE  16.54
 
 
+struct _1BYTE_
+{
+	unsigned char  u8;
+};
+
 struct _3BYTE_
 {
 	unsigned char  u8;
 	unsigned short u16;
 };
 
+struct _5BYTE_
+{
+	unsigned char  u8;
+	unsigned long u32;
+};
+
 struct _7BYTE_
 {
 	unsigned char u8;
@@ -62,11 +79,27 @@ void test_param_u32(unsigned long v)
 }
 
 
+void test_param_s16(short v)
+{
+  global_s16bit = v;
+}
+
+void test_param_s32(long v)
+{
+  global_s32bit = v;
+}
+
+
 void test_param_s64(long long v)
 {
   global_s64bit = v;
 }
 
+void test_param_u64(unsigned long long v)
+{
+  global_u64bit = v;
+}
+
 void test_param_float(float v)
 {
   global_float = v;
@@ -83,13 +116,67 @@ void test_param_longdouble(long double v)
   global_long_double = v;
 }
 
+/* simple array parameter testing */
+void test_array_param_u8(unsigned char v[2])
+{
+  global_u8bit = v[1];
+}
+
+
+void test_array_param_u16(unsigned short v[2])
+{
+  global_u16bit = v[1];
+}
+
+void test_array_param_u32(unsigned long v[2])
+{
+  global_u32bit = v[1];
+}
+
+
+void test_array_param_s16(short v[2])
+{
+  global_s16bit = v[1];
+}
+
+void test_array_param_s32(long v[2])
+{
+  global_s32bit = v[1];
+}
+
+
+void test_array_param_s64(long long v[2])
+{
+  global_s64bit = v[1];
+}
+
+void test_array_param_u64(unsigned long long v[2])
+{
+  global_u64bit = v[1];
+}
+
+void test_array_param_float(float v[2])
+{
+  global_float = v[1];
+}
+
+void test_array_param_double(double v[2])
+{
+  global_double = v[1];
+}
+
+
+void test_array_param_longdouble(long double v[2])
+{
+  global_long_double = v[1];
+}
+
 /* if this one works, others should also automatically */
 void test_param_var_u8(unsigned char *x)
 {
 	*x = RESULT_U8BIT;
 }
 
-
 /* mixed parameter testing */
 void test_param_mixed_u16(unsigned char z, unsigned short x, unsigned char y)
 {
@@ -109,13 +196,49 @@ void test_param_mixed_s64(unsigned char z, long long x, unsigned char y)
 	global_u8bit = y;
 }
 
+void test_param_mixed_var_u8(unsigned char *x, unsigned char y)
+{
+	global_u8bit = y;
+	*x = RESULT_U8BIT;
+}
+
+/* mixed parameter testing with floating point args */
+void test_param_mixed_float(float x, unsigned char y)
+{
+	global_float = x;
+	global_u8bit = y;
+}
+
+void test_param_mixed_double(double x, unsigned char y)
+{
+	global_double = x;
+	global_u8bit = y;
+}
+
+void test_param_mixed_long_double(long double x, unsigned char y)
+{
+	global_long_double = x;
+	global_u8bit = y;
+}
+
 /* simple record testing */
+void test_param_struct_tiny(struct _1BYTE_ buffer)
+{
+	global_u8bit = buffer.u8;
+}
+
 void test_param_struct_small(struct _3BYTE_ buffer)
 {
 	global_u8bit = buffer.u8;
 	global_u16bit = buffer.u16;
 }
 
+void test_param_struct_medium(struct _5BYTE_ buffer)
+{
+	global_u8bit = buffer.u8;
+	global_u32bit = buffer.u32;
+}
+
 void test_param_struct_large(struct _7BYTE_ buffer)
 {
 	global_u8bit = buffer.u8;
@@ -124,6 +247,32 @@ void test_param_struct_large(struct _7BYTE_ buffer)
 }
 
 
+/* record+char testing */
+void test_param_mixed_struct_tiny(struct _1BYTE_ buffer, unsigned char y)
+{
+	global_u8bit = y;
+}
+
+void test_param_mixed_struct_small(struct _3BYTE_ buffer, unsigned char y)
+{
+	global_u8bit = y;
+	global_u16bit = buffer.u16;
+}
+
+void test_param_mixed_struct_medium(struct _5BYTE_ buffer, unsigned char y)
+{
+        global_u8bit = y;
+	global_u32bit = buffer.u32;
+}
+
+void test_param_mixed_struct_large(struct _7BYTE_ buffer, unsigned char y)
+{
+        global_u8bit = y;
+	global_u16bit = buffer.u16;
+	global_s64bit = buffer.s64;
+}
+
+
 /* function result testing */
 unsigned char test_function_u8()
 {
@@ -140,6 +289,21 @@ unsigned long test_function_u32()
 	return RESULT_U32BIT;
 }
 
+unsigned long long test_function_u64()
+{
+	return RESULT_U64BIT;
+}
+
+unsigned short test_function_s16()
+{
+	return RESULT_S16BIT;
+}
+
+unsigned long test_function_s32()
+{
+	return RESULT_S32BIT;
+}
+
 unsigned long long test_function_s64()
 {
 	return RESULT_S64BIT;
@@ -165,6 +329,29 @@ long double test_function_longdouble()
 	return RESULT_LONGDOUBLE;
 }
 
+struct _1BYTE_ test_function_tiny_struct()
+{
+        struct _1BYTE_ test_struct;
+	test_struct.u8 = RESULT_U8BIT;
+	return test_struct;
+}
+
+struct _3BYTE_ test_function_small_struct()
+{
+        struct _3BYTE_ test_struct;
+	test_struct.u8 = RESULT_U8BIT;
+	test_struct.u16 = RESULT_U16BIT;
+	return test_struct;
+}
+
+struct _5BYTE_ test_function_medium_struct()
+{
+        struct _5BYTE_ test_struct;
+	test_struct.u8 = RESULT_U8BIT;
+	test_struct.u32 = RESULT_U32BIT;
+	return test_struct;
+}
+
 struct _7BYTE_ test_function_struct()
 {
 	test_struct.u8 = RESULT_U8BIT;
@@ -175,7 +362,10 @@ struct _7BYTE_ test_function_struct()
 
 /*
   $Log$
-  Revision 1.4  2002-09-07 15:40:56  peter
+  Revision 1.5  2002-11-04 15:17:45  pierre
+   * compatibility with C checks improved
+
+  Revision 1.4  2002/09/07 15:40:56  peter
     * old logs removed and tabs fixed
 
   Revision 1.3  2002/05/04 16:57:23  carl

tests/test/cg/ptest.pp

@@ -0,0 +1,425 @@
+{
+  Program to test linking between C and pascal units.
+
+  Pascal counter part
+}
+
+unit ptest;
+
+interface
+
+{ Use C alignment of records }
+{$PACKRECORDS C}
+const
+   RESULT_U8BIT = $55;
+   RESULT_U16BIT = $500F;
+   RESULT_U32BIT = $500F0000;
+   RESULT_U64BIT = $1BCDABCD;
+   RESULT_S16BIT = -12;
+   RESULT_S32BIT = -120;
+   RESULT_S64BIT = -12000;
+   RESULT_FLOAT  = 14.54;
+   RESULT_DOUBLE = 15.54;
+   RESULT_LONGDOUBLE = 16.54;
+   RESULT_PCHAR  = 'Hello world';
+
+type
+ _1byte_ = record
+  u8 : byte;
+ end;
+
+ _3byte_ = record
+  u8 : byte;
+  u16 : word;
+ end;
+
+ _5byte_ = record
+  u8 : byte;
+  u32 : cardinal;
+ end;
+
+_7byte_ = record
+  u8: byte;
+  s64: int64;
+  u16: word;
+end;
+  byte_array = array [0..1] of byte;
+  word_array = array [0..1] of word;
+  cardinal_array = array [0..1] of cardinal;
+  qword_array = array [0..1] of qword;
+  smallint_array = array [0..1] of smallint;
+  longint_array = array [0..1] of longint;
+  int64_array = array [0..1] of int64;
+  single_array = array [0..1] of single;
+  double_array = array [0..1] of double;
+  extended_array = array [0..1] of extended;
+
+var
+  global_u8bit : byte; cvar;
+  global_u16bit : word; cvar;
+  global_u32bit : cardinal; cvar;
+  global_u64bit : qword; cvar;
+  global_s16bit : smallint; cvar;
+  global_s32bit : longint; cvar;
+  global_s64bit : int64; cvar;
+  global_float : single; cvar;
+  global_double : double; cvar;
+  global_long_double : extended; cvar;
+
+{ simple parameter passing }
+procedure test_param_u8(x: byte); cdecl;
+procedure test_param_u16(x : word); cdecl;
+procedure test_param_u32(x: cardinal); cdecl;
+procedure test_param_u64(x: qword); cdecl;
+procedure test_param_s16(x : smallint); cdecl;
+procedure test_param_s32(x: longint); cdecl;
+procedure test_param_s64(x: int64); cdecl;
+procedure test_param_float(x : single); cdecl;
+procedure test_param_double(x: double); cdecl;
+procedure test_param_longdouble(x: extended); cdecl;
+procedure test_param_var_u8(var x: byte); cdecl;
+
+{ array parameter passing }
+procedure test_array_param_u8(x: byte_array); cdecl;
+procedure test_array_param_u16(x : word_array); cdecl;
+procedure test_array_param_u32(x: cardinal_array); cdecl;
+procedure test_array_param_u64(x: qword_array); cdecl;
+procedure test_array_param_s16(x :smallint_array); cdecl;
+procedure test_array_param_s32(x: longint_array); cdecl;
+procedure test_array_param_s64(x: int64_array); cdecl;
+procedure test_array_param_float(x : single_array); cdecl;
+procedure test_array_param_double(x: double_array); cdecl;
+procedure test_array_param_longdouble(x: extended_array); cdecl;
+
+{ mixed parameter passing }
+procedure test_param_mixed_u16(z: byte; x : word; y :byte); cdecl;
+procedure test_param_mixed_u32(z: byte; x: cardinal; y: byte); cdecl;
+procedure test_param_mixed_s64(z: byte; x: int64; y: byte); cdecl;
+procedure test_param_mixed_float(x: single; y: byte); cdecl;
+procedure test_param_mixed_double(x: double; y: byte); cdecl;
+procedure test_param_mixed_long_double(x: extended; y: byte); cdecl;
+procedure test_param_mixed_var_u8(var x: byte;y:byte); cdecl;
+{ structure parameter testing }
+procedure test_param_struct_tiny(buffer :   _1BYTE_); cdecl;
+procedure test_param_struct_small(buffer :  _3BYTE_); cdecl;
+procedure test_param_struct_medium(buffer : _5BYTE_); cdecl;
+procedure test_param_struct_large(buffer :  _7BYTE_); cdecl;
+{ mixed with structure parameter testing }
+procedure test_param_mixed_struct_tiny(buffer :   _1BYTE_; y :byte); cdecl;
+procedure test_param_mixed_struct_small(buffer :  _3BYTE_; y :byte); cdecl;
+procedure test_param_mixed_struct_medium(buffer : _5BYTE_; y :byte); cdecl;
+procedure test_param_mixed_struct_large(buffer :  _7BYTE_; y :byte); cdecl;
+{ function result value testing }
+function test_function_u8: byte; cdecl;
+function test_function_u16: word; cdecl;
+function test_function_u32: cardinal; cdecl;
+function test_function_u64: qword; cdecl;
+function test_function_s16: smallint; cdecl;
+function test_function_s32: longint; cdecl;
+function test_function_s64: int64; cdecl;
+function test_function_pchar: pchar; cdecl;
+function test_function_float : single; cdecl;
+function test_function_double : double; cdecl;
+function test_function_longdouble: extended; cdecl;
+function test_function_tiny_struct : _1byte_; cdecl;
+function test_function_small_struct : _3byte_; cdecl;
+function test_function_medium_struct : _5byte_; cdecl;
+function test_function_struct : _7byte_; cdecl;
+
+
+implementation
+
+{ simple parameter passing }
+procedure test_param_u8(x: byte); cdecl;
+  begin
+    global_u8bit:=x;
+  end;
+
+procedure test_param_u16(x : word); cdecl;
+  begin
+    global_u16bit:=x;
+  end;
+
+procedure test_param_u32(x: cardinal); cdecl;
+  begin
+    global_u32bit:=x;
+  end;
+
+procedure test_param_u64(x: qword); cdecl;
+  begin
+    global_u64bit:=x;
+  end;
+
+procedure test_param_s16(x : smallint); cdecl;
+  begin
+    global_s16bit:=x;
+  end;
+
+procedure test_param_s32(x: longint); cdecl;
+  begin
+    global_s32bit:=x;
+  end;
+
+procedure test_param_s64(x: int64); cdecl;
+  begin
+    global_s64bit:=x;
+  end;
+
+procedure test_param_float(x : single); cdecl;
+  begin
+    global_float:=x;
+  end;
+
+procedure test_param_double(x: double); cdecl;
+  begin
+    global_double:=x;
+  end;
+
+procedure test_param_longdouble(x: extended); cdecl;
+  begin
+    global_long_double:=x;
+  end;
+
+procedure test_param_var_u8(var x: byte); cdecl;
+  begin
+    x:=RESULT_U8BIT;
+  end;
+
+
+{ array parameter passing }
+procedure test_array_param_u8(x: byte_array); cdecl;
+  begin
+   global_u8bit:=x[1];
+  end;
+
+procedure test_array_param_u16(x : word_array); cdecl;
+  begin
+   global_u16bit:=x[1];
+  end;
+
+procedure test_array_param_u32(x: cardinal_array); cdecl;
+  begin
+   global_u32bit:=x[1];
+  end;
+
+procedure test_array_param_u64(x: qword_array); cdecl;
+  begin
+   global_u64bit:=x[1];
+  end;
+
+procedure test_array_param_s16(x :smallint_array); cdecl;
+  begin
+   global_s16bit:=x[1];
+  end;
+
+procedure test_array_param_s32(x: longint_array); cdecl;
+  begin
+   global_s32bit:=x[1];
+  end;
+
+procedure test_array_param_s64(x: int64_array); cdecl;
+  begin
+   global_s64bit:=x[1];
+  end;
+
+procedure test_array_param_float(x : single_array); cdecl;
+  begin
+   global_float:=x[1];
+  end;
+
+procedure test_array_param_double(x: double_array); cdecl;
+  begin
+   global_double:=x[1];
+  end;
+
+procedure test_array_param_longdouble(x: extended_array); cdecl;
+  begin
+   global_long_double:=x[1];
+  end;
+
+
+{ mixed parameter passing }
+procedure test_param_mixed_u16(z: byte; x : word; y :byte); cdecl;
+  begin
+    global_u16bit:=x;
+    global_u8bit:=y;
+  end;
+
+procedure test_param_mixed_u32(z: byte; x: cardinal; y: byte); cdecl;
+  begin
+    global_u32bit:=x;
+    global_u8bit:=y;
+  end;
+
+procedure test_param_mixed_s64(z: byte; x: int64; y: byte); cdecl;
+  begin
+    global_s64bit:=x;
+    global_u8bit:=y;
+  end;
+
+procedure test_param_mixed_float(x: single; y: byte); cdecl;
+  begin
+    global_float:=x;
+    global_u8bit:=y;
+  end;
+
+procedure test_param_mixed_double(x: double; y: byte); cdecl;
+  begin
+    global_double:=x;
+    global_u8bit:=y;
+  end;
+
+procedure test_param_mixed_long_double(x: extended; y: byte); cdecl;
+  begin
+    global_long_double:=x;
+    global_u8bit:=y;
+  end;
+
+procedure test_param_mixed_var_u8(var x: byte;y:byte); cdecl;
+  begin
+    x:=RESULT_U8BIT;
+    global_u8bit:=y;
+  end;
+
+{ structure parameter testing }
+procedure test_param_struct_tiny(buffer :   _1BYTE_); cdecl;
+  begin
+    global_u8bit:=buffer.u8;
+  end;
+
+procedure test_param_struct_small(buffer :  _3BYTE_); cdecl;
+  begin
+    global_u8bit:=buffer.u8;
+    global_u16bit:=buffer.u16;
+  end;
+
+procedure test_param_struct_medium(buffer : _5BYTE_); cdecl;
+  begin
+    global_u8bit:=buffer.u8;
+    global_u32bit:=buffer.u32;
+  end;
+
+procedure test_param_struct_large(buffer :  _7BYTE_); cdecl;
+  begin
+    global_u8bit:=buffer.u8;
+    global_u16bit:=buffer.u16;
+    global_s64bit:=buffer.s64;
+  end;
+
+{ mixed with structure parameter testing }
+procedure test_param_mixed_struct_tiny(buffer :   _1BYTE_; y :byte); cdecl;
+  begin
+    global_u8bit := y;
+  end;
+
+procedure test_param_mixed_struct_small(buffer :  _3BYTE_; y :byte); cdecl;
+  begin
+    global_u8bit := y;
+    global_u16bit := buffer.u16;
+  end;
+
+procedure test_param_mixed_struct_medium(buffer : _5BYTE_; y :byte); cdecl;
+  begin
+    global_u8bit := y;
+    global_u32bit := buffer.u32;
+  end;
+
+procedure test_param_mixed_struct_large(buffer :  _7BYTE_; y :byte); cdecl;
+  begin
+    global_u8bit:=y;
+    global_u16bit:=buffer.u16;
+    global_s64bit:=buffer.s64;
+  end;
+
+{ function result value testing }
+function test_function_u8: byte; cdecl;
+  begin
+    test_function_u8:=RESULT_U8BIT;
+  end;
+
+function test_function_u16: word; cdecl;
+  begin
+    test_function_u16:=RESULT_U16BIT;
+  end;
+
+function test_function_u32: cardinal; cdecl;
+  begin
+    test_function_u32:=RESULT_U32BIT;
+  end;
+
+function test_function_u64: qword; cdecl;
+  begin
+    test_function_u64:=RESULT_U64BIT;
+  end;
+
+function test_function_s16: smallint; cdecl;
+  begin
+    test_function_s16:=RESULT_S16BIT;
+  end;
+
+function test_function_s32: longint; cdecl;
+  begin
+    test_function_s32:=RESULT_S32BIT;
+  end;
+
+function test_function_s64: int64; cdecl;
+  begin
+    test_function_s64:=RESULT_S64BIT;
+  end;
+
+function test_function_pchar: pchar; cdecl;
+  begin
+    test_function_pchar:=RESULT_PCHAR;
+  end;
+
+function test_function_float : single; cdecl;
+  begin
+    test_function_float:=RESULT_FLOAT;
+  end;
+
+function test_function_double : double; cdecl;
+  begin
+    test_function_double:=RESULT_DOUBLE;
+  end;
+
+function test_function_longdouble: extended; cdecl;
+  begin
+    test_function_longdouble:=RESULT_LONGDOUBLE;
+  end;
+
+function test_function_tiny_struct : _1byte_; cdecl;
+  begin
+    test_function_tiny_struct.u8:=RESULT_U8BIT;
+  end;
+
+function test_function_small_struct : _3byte_; cdecl;
+  begin
+    test_function_small_struct.u8:=RESULT_U8BIT;
+    test_function_small_struct.u16:=RESULT_U16BIT;
+  end;
+
+function test_function_medium_struct : _5byte_; cdecl;
+  begin
+    test_function_medium_struct.u8:=RESULT_U8BIT;
+    test_function_medium_struct.u32:=RESULT_U32BIT;
+  end;
+
+function test_function_struct : _7byte_; cdecl;
+  begin
+    test_function_struct.u8:=RESULT_U8BIT;
+    test_function_struct.u16:=RESULT_U16BIT;
+    test_function_struct.s64:=RESULT_S64BIT;
+  end;
+
+
+
+
+end.
+
+{
+  $Log$
+  Revision 1.1  2002-11-04 15:17:45  pierre
+   * compatibility with C checks improved
+
+
+}

tests/test/cg/tcalext.pp

@@ -21,58 +21,115 @@ program tcalext;
 {$R+}
 uses strings;
 
+
+{$ifndef USE_PASCAL_OBJECT}
 {$L ctest.o}
+{$endif USE_PASCAL_OBJECT}
 { Use C alignment of records }
 {$PACKRECORDS C}
 const
    RESULT_U8BIT = $55;
    RESULT_U16BIT = $500F;
    RESULT_U32BIT = $500F0000;
+   RESULT_U64BIT = $1BCDABCD;
+   RESULT_S16BIT = -12;
+   RESULT_S32BIT = -120;
    RESULT_S64BIT = -12000;
    RESULT_FLOAT  = 14.54;
-   RESULT_DOUBLE = RESULT_FLOAT;
-   RESULT_LONGDOUBLE = RESULT_FLOAT;
+   RESULT_DOUBLE = 15.54;
+   RESULT_LONGDOUBLE = 16.54;
    RESULT_PCHAR  = 'Hello world';
 
 type
+ _1byte_ = record
+  u8 : byte;
+ end;
+
  _3byte_ = record
   u8 : byte;
   u16 : word;
  end;
 
+ _5byte_ = record
+  u8 : byte;
+  u32 : cardinal;
+ end;
+
 _7byte_ = record
   u8: byte;
   s64: int64;
   u16: word;
 end;
+  byte_array = array [0..1] of byte;
+  word_array = array [0..1] of word;
+  cardinal_array = array [0..1] of cardinal;
+  qword_array = array [0..1] of qword;
+  smallint_array = array [0..1] of smallint;
+  longint_array = array [0..1] of longint;
+  int64_array = array [0..1] of int64;
+  single_array = array [0..1] of single;
+  double_array = array [0..1] of double;
+  extended_array = array [0..1] of extended;
 
 
 { simple parameter passing }
 procedure test_param_u8(x: byte); cdecl; external;
 procedure test_param_u16(x : word); cdecl; external;
 procedure test_param_u32(x: cardinal); cdecl; external;
+procedure test_param_u64(x: qword); cdecl; external;
+procedure test_param_s16(x : smallint); cdecl; external;
+procedure test_param_s32(x: longint); cdecl; external;
 procedure test_param_s64(x: int64); cdecl; external;
 procedure test_param_float(x : single); cdecl; external;
 procedure test_param_double(x: double); cdecl; external;
 procedure test_param_longdouble(x: extended); cdecl; external;
 procedure test_param_var_u8(var x: byte); cdecl; external;
 
+{ array parameter passing }
+procedure test_array_param_u8(x: byte_array); cdecl; external;
+procedure test_array_param_u16(x : word_array); cdecl; external;
+procedure test_array_param_u32(x: cardinal_array); cdecl; external;
+procedure test_array_param_u64(x: qword_array); cdecl; external;
+procedure test_array_param_s16(x :smallint_array); cdecl; external;
+procedure test_array_param_s32(x: longint_array); cdecl; external;
+procedure test_array_param_s64(x: int64_array); cdecl; external;
+procedure test_array_param_float(x : single_array); cdecl; external;
+procedure test_array_param_double(x: double_array); cdecl; external;
+procedure test_array_param_longdouble(x: extended_array); cdecl; external;
+
 { mixed parameter passing }
 procedure test_param_mixed_u16(z: byte; x : word; y :byte); cdecl; external;
 procedure test_param_mixed_u32(z: byte; x: cardinal; y: byte); cdecl; external;
 procedure test_param_mixed_s64(z: byte; x: int64; y: byte); cdecl; external;
+procedure test_param_mixed_float(x: single; y: byte); cdecl; external;
+procedure test_param_mixed_double(x: double; y: byte); cdecl; external;
+procedure test_param_mixed_long_double(x: extended; y: byte); cdecl; external;
+procedure test_param_mixed_var_u8(var x: byte;y:byte); cdecl; external;
 { structure parameter testing }
+procedure test_param_struct_tiny(buffer :   _1BYTE_); cdecl; external;
 procedure test_param_struct_small(buffer :  _3BYTE_); cdecl; external;
+procedure test_param_struct_medium(buffer : _5BYTE_); cdecl; external;
 procedure test_param_struct_large(buffer :  _7BYTE_); cdecl; external;
+{ mixed with structure parameter testing }
+procedure test_param_mixed_struct_tiny(buffer :   _1BYTE_; y :byte); cdecl; external;
+procedure test_param_mixed_struct_small(buffer :  _3BYTE_; y :byte); cdecl; external;
+procedure test_param_mixed_struct_medium(buffer : _5BYTE_; y :byte); cdecl; external;
+procedure test_param_mixed_struct_large(buffer :  _7BYTE_; y :byte); cdecl; external;
 { function result value testing }
 function test_function_u8: byte; cdecl; external;
 function test_function_u16: word; cdecl; external;
 function test_function_u32: cardinal; cdecl; external;
+function test_function_u64: qword; cdecl; external;
+function test_function_s16: smallint; cdecl; external;
+function test_function_s32: longint; cdecl; external;
 function test_function_s64: int64; cdecl; external;
 function test_function_pchar: pchar; cdecl; external;
 function test_function_float : single; cdecl; external;
 function test_function_double : double; cdecl; external;
 function test_function_longdouble: extended; cdecl; external;
+function test_function_tiny_struct : _1byte_; cdecl; external;
+function test_function_small_struct : _3byte_; cdecl; external;
+function test_function_medium_struct : _5byte_; cdecl; external;
 function test_function_struct : _7byte_; cdecl; external;
 
 
@@ -83,24 +140,43 @@ function test_function_struct : _7byte_; cdecl; external;
 var
  global_u8bit : byte; cvar; external;
  global_u16bit : word; cvar; external;
- global_u32bit : longint; cvar;external;
+ global_u32bit : cardinal; cvar;external;
+ global_u64bit : qword; cvar; external;
+ global_s16bit : smallint; cvar; external;
+ global_s32bit : longint; cvar;external;
  global_s64bit : int64; cvar; external;
  global_float : single; cvar;external;
  global_double : double; cvar;external;
  global_long_double : extended; cvar; external;
  value_u8bit : byte;
+ value_s16bit : smallint;
+ value_s32bit : longint;
+ value_s64bit : int64;
  value_u16bit : word;
  value_u32bit : cardinal;
- value_s64bit : int64;
+ value_u64bit : qword;
  value_float : single;
  value_double : double;
- value_longdouble : extended;
+ value_long_double : extended;
+ array_u8bit : array [0..1] of byte;
+ array_s16bit : array [0..1] of smallint;
+ array_s32bit : array [0..1] of longint;
+ array_s64bit : array [0..1] of int64;
+ array_u16bit : array [0..1] of word;
+ array_u32bit : array [0..1] of cardinal;
+ array_u64bit : array [0..1] of qword;
+ array_float : array [0..1] of single;
+ array_double : array [0..1] of double;
+ array_long_double : array [0..1] of extended;
 
  procedure clear_globals;
   begin
     global_u8bit := 0;
     global_u16bit := 0;
     global_u32bit := 0;
+    global_u64bit := 0;
+    global_s16bit := 0;
+    global_s32bit := 0;
     global_s64bit := 0;
     global_float := 0.0;
     global_double := 0.0;
@@ -112,21 +188,29 @@ var
     value_u8bit := 0;
     value_u16bit := 0;
     value_u32bit := 0;
+    value_u64bit := 0;
+    value_s16bit := 0;
+    value_s32bit := 0;
     value_s64bit := 0;
     value_float := 0.0;
     value_double := 0.0;
-    value_longdouble := 0.0;
+    value_long_double := 0.0;
   end;
 
+const
+  has_errors : boolean = false;
+  known_bug_about_extended_array_present : boolean = false;
   procedure fail;
    begin
      WriteLn('Failed!');
-     halt(1);
+     has_errors:=true;
    end;
 
 
 var failed : boolean;
+    tinystruct : _1BYTE_;
     smallstruct : _3BYTE_;
+    mediumstruct : _5BYTE_;
     bigstruct : _7BYTE_;
     pc: pchar;
 begin
@@ -160,6 +244,30 @@ begin
   clear_values;
   clear_globals;
 
+  value_u64bit := RESULT_U64BIT;
+  test_param_u64(value_u64bit);
+  if global_u64bit <> RESULT_U64BIT then
+    failed := true;
+
+  clear_values;
+  clear_globals;
+
+  value_s16bit := RESULT_S16BIT;
+  test_param_s16(value_s16bit);
+  if global_s16bit <> RESULT_S16BIT then
+    failed := true;
+
+  clear_values;
+  clear_globals;
+
+  value_s32bit := RESULT_S32BIT;
+  test_param_s32(value_s32bit);
+  if global_s32bit <> RESULT_S32BIT then
+    failed := true;
+
+  clear_values;
+  clear_globals;
+
   value_s64bit := RESULT_S64BIT;
   test_param_s64(value_s64bit);
   if global_s64bit <> RESULT_S64BIT then
@@ -184,8 +292,8 @@ begin
   clear_values;
   clear_globals;
 
-  value_longdouble := RESULT_LONGDOUBLE;
-  test_param_longdouble(value_longdouble);
+  value_long_double := RESULT_LONGDOUBLE;
+  test_param_longdouble(value_long_double);
   if trunc(global_long_double) <> trunc(RESULT_LONGDOUBLE) then
     failed := true;
 
@@ -196,6 +304,100 @@ begin
   if value_u8bit <> RESULT_U8BIT then
      failed := true;
 
+  If failed then
+   fail
+  else
+    WriteLn('Passed!');
+
+  Write('External array parameter testing...');
+  failed := false;
+
+  clear_values;
+  clear_globals;
+
+  array_u8bit[1] := RESULT_U8BIT;
+  test_array_param_u8(array_u8bit);
+  if global_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+  clear_values;
+  clear_globals;
+
+  array_u16bit[1] := RESULT_U16BIT;
+  test_array_param_u16(array_u16bit);
+  if global_u16bit <> RESULT_U16BIT then
+    failed := true;
+
+  clear_values;
+  clear_globals;
+
+  array_u32bit[1] := RESULT_U32BIT;
+  test_array_param_u32(array_u32bit);
+  if global_u32bit <> RESULT_U32BIT then
+    failed := true;
+
+  clear_values;
+  clear_globals;
+
+  array_u64bit[1] := RESULT_U64BIT;
+  test_array_param_u64(array_u64bit);
+  if global_u64bit <> RESULT_U64BIT then
+    failed := true;
+
+  clear_values;
+  clear_globals;
+
+  array_s16bit[1] := RESULT_S16BIT;
+  test_array_param_s16(array_s16bit);
+  if global_s16bit <> RESULT_S16BIT then
+    failed := true;
+
+  clear_values;
+  clear_globals;
+
+  array_s32bit[1] := RESULT_S32BIT;
+  test_array_param_s32(array_s32bit);
+  if global_s32bit <> RESULT_S32BIT then
+    failed := true;
+
+  clear_values;
+  clear_globals;
+
+  array_s64bit[1] := RESULT_S64BIT;
+  test_array_param_s64(array_s64bit);
+  if global_s64bit <> RESULT_S64BIT then
+    failed := true;
+
+  clear_values;
+  clear_globals;
+
+  array_float[1] := RESULT_FLOAT;
+  test_array_param_float(array_float);
+  if trunc(global_float) <> trunc(RESULT_FLOAT) then
+    failed := true;
+
+  clear_values;
+  clear_globals;
+
+  array_double[1] := RESULT_DOUBLE;
+  test_array_param_double(array_double);
+  if trunc(global_double) <> trunc(RESULT_DOUBLE) then
+    failed := true;
+
+  clear_values;
+  clear_globals;
+
+  array_long_double[1] := RESULT_LONGDOUBLE;
+  test_array_param_longdouble(array_long_double);
+  if trunc(global_long_double) <> trunc(RESULT_LONGDOUBLE) then
+    begin
+      if sizeof(global_long_double)=10 then
+        begin
+          known_bug_about_extended_array_present:=true;
+        end
+      else
+        failed := true;
+    end;
 
   If failed then
    fail
@@ -205,6 +407,14 @@ begin
   Write('External mixed parameter testing...');
   failed := false;
 
+  clear_values;
+  clear_globals;
+  test_param_mixed_var_u8(value_u8bit,RESULT_U8BIT);
+  if value_u8bit <> RESULT_U8BIT then
+     failed := true;
+  if global_u8bit <> RESULT_U8BIT then
+    failed := true;
+
   clear_values;
   clear_globals;
 
@@ -238,6 +448,46 @@ begin
   if global_u8bit <> RESULT_U8BIT then
     failed := true;
 
+  clear_values;
+  clear_globals;
+
+  value_u8bit := RESULT_U8BIT;
+  value_float := RESULT_FLOAT;
+  test_param_mixed_float(value_float, value_u8bit);
+  if global_float <> value_float then
+    failed := true;
+  if global_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+  If failed then
+   fail
+  else
+    WriteLn('Passed!');
+
+  Write('External mixed parameter testing with floating values...');
+
+  clear_values;
+  clear_globals;
+
+  value_u8bit := RESULT_U8BIT;
+  value_double := RESULT_DOUBLE;
+  test_param_mixed_double(value_double, value_u8bit);
+  if global_double <> value_double then
+    failed := true;
+  if global_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+  clear_values;
+  clear_globals;
+
+  value_u8bit := RESULT_U8BIT;
+  value_long_double := RESULT_LONGDOUBLE;
+  test_param_mixed_long_double(value_long_double, value_u8bit);
+  if global_long_double <> value_long_double then
+    failed := true;
+  if global_u8bit <> RESULT_U8BIT then
+    failed := true;
+
   If failed then
    fail
   else
@@ -250,6 +500,14 @@ begin
   clear_values;
   clear_globals;
 
+  tinystruct.u8 := RESULT_U8BIT;
+  test_param_struct_tiny(tinystruct);
+  if global_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+  clear_values;
+  clear_globals;
+
   smallstruct.u8 := RESULT_U8BIT;
   smallstruct.u16 := RESULT_u16BIT;
   test_param_struct_small(smallstruct);
@@ -261,6 +519,17 @@ begin
   clear_values;
   clear_globals;
 
+  mediumstruct.u8 := RESULT_U8BIT;
+  mediumstruct.u32 := RESULT_U32BIT;
+  test_param_struct_medium(mediumstruct);
+  if global_u32bit <> RESULT_U32BIT then
+    failed := true;
+  if global_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+  clear_values;
+  clear_globals;
+
 
   bigstruct.u8 := RESULT_U8BIT;
   bigstruct.u16 := RESULT_U16BIT;
@@ -279,7 +548,58 @@ begin
     WriteLn('Passed!');
 
 
-  Write('Function result testing...');
+  Write('External mixed struct/byte parameter testing...');
+
+  failed := false;
+
+  clear_values;
+  clear_globals;
+
+  test_param_mixed_struct_tiny(tinystruct,RESULT_U8BIT);
+  if global_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+  clear_values;
+  clear_globals;
+
+  smallstruct.u16 := RESULT_u16BIT;
+  test_param_mixed_struct_small(smallstruct,RESULT_U8BIT);
+  if global_u16bit <> RESULT_U16BIT then
+    failed := true;
+  if global_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+  clear_values;
+  clear_globals;
+
+  mediumstruct.u32 := RESULT_U32BIT;
+  test_param_mixed_struct_medium(mediumstruct,RESULT_U8BIT);
+  if global_u32bit <> RESULT_U32BIT then
+    failed := true;
+  if global_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+  clear_values;
+  clear_globals;
+
+
+  bigstruct.u16 := RESULT_U16BIT;
+  bigstruct.s64 := RESULT_S64BIT;
+  test_param_mixed_struct_large(bigstruct,RESULT_U8BIT);
+  if global_s64bit <> RESULT_S64BIT then
+    failed := true;
+  if global_u16bit <> RESULT_U16BIT then
+    failed := true;
+  if global_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+  If failed then
+   fail
+  else
+    WriteLn('Passed!');
+
+
+  Write('Integer function result testing...');
   failed := false;
 
   clear_values;
@@ -306,6 +626,27 @@ begin
   clear_values;
   clear_globals;
 
+  value_u64bit := test_function_u64;
+  if value_u64bit <> RESULT_U64BIT then
+    failed := true;
+
+  clear_values;
+  clear_globals;
+
+  value_s16bit := test_function_s16;
+  if value_s16bit <> RESULT_S16BIT then
+    failed := true;
+
+  clear_values;
+  clear_globals;
+
+  value_s32bit := test_function_s32;
+  if value_s32bit <> RESULT_S32BIT then
+    failed := true;
+
+  clear_values;
+  clear_globals;
+
   value_s64bit := test_function_s64;
   if value_s64bit <> RESULT_S64BIT then
     failed := true;
@@ -313,6 +654,13 @@ begin
   clear_values;
   clear_globals;
 
+  If failed then
+   fail
+  else
+    WriteLn('Passed!');
+
+  Write('pchar function result testing...');
+  failed := false;
   { verify if the contents both strings are equal }
   pc := test_function_pchar;
   if strcomp(pc, RESULT_PCHAR) <> 0 then
@@ -321,6 +669,13 @@ begin
   clear_values;
   clear_globals;
 
+  If failed then
+   fail
+  else
+    WriteLn('Passed!');
+
+  Write('Real function result testing...');
+  failed := false;
   value_float := test_function_float;
   if trunc(value_float) <> trunc(RESULT_FLOAT) then
     failed := true;
@@ -335,13 +690,36 @@ begin
   clear_values;
   clear_globals;
 
-  value_longdouble := test_function_longdouble;
-  if trunc(value_longdouble) <> trunc(RESULT_LONGDOUBLE) then
+  value_long_double := test_function_longdouble;
+  if trunc(value_long_double) <> trunc(RESULT_LONGDOUBLE) then
     failed := true;
 
   clear_values;
   clear_globals;
 
+  If failed then
+   fail
+  else
+    WriteLn('Passed!');
+
+  Write('Function result testing for struct...');
+
+  tinystruct := test_function_tiny_struct;
+  if tinystruct.u8 <> RESULT_U8BIT then
+    failed := true;
+
+  smallstruct := test_function_small_struct;
+  if smallstruct.u8 <> RESULT_U8BIT then
+    failed := true;
+  if smallstruct.u16 <> RESULT_U16BIT then
+    failed := true;
+
+  mediumstruct := test_function_medium_struct;
+  if mediumstruct.u8 <> RESULT_U8BIT then
+    failed := true;
+  if mediumstruct.u32 <> RESULT_U32BIT then
+    failed := true;
+
   bigstruct := test_function_struct;
   if bigstruct.u8 <> RESULT_U8BIT then
     failed := true;
@@ -355,11 +733,23 @@ begin
   else
     WriteLn('Passed!');
 
+  if known_bug_about_extended_array_present then
+    begin
+      writeln('extended size is incompatible with C');
+      writeln('this will lead to failures if long doubles');
+      writeln('are used as arrays of members of packed structures');
+      has_errors:=true;
+    end;
+  if has_errors then
+    Halt(1);
 end.
 
 {
   $Log$
-  Revision 1.5  2002-09-07 15:40:51  peter
+  Revision 1.6  2002-11-04 15:17:45  pierre
+   * compatibility with C checks improved
+
+  Revision 1.5  2002/09/07 15:40:51  peter
     * old logs removed and tabs fixed
 
   Revision 1.4  2002/08/25 19:28:07  peter

tests/test/cg/tcalpext.pp

@@ -0,0 +1,32 @@
+
+{****************************************************************}
+{  CODE GENERATOR TEST PROGRAM                                   }
+{****************************************************************}
+{ NODE TESTED : secondcalln()                                    }
+{****************************************************************}
+{ PRE-REQUISITES: secondload()                                   }
+{                 secondassign()                                 }
+{                 secondcalln()                                  }
+{                 secondadd()                                    }
+{                 secondtypeconv()                               }
+{****************************************************************}
+{ DEFINES:                                                       }
+{****************************************************************}
+{ This test check that the code created by Free Pascal for       }
+{ functions declared with cdecl modifier are correct             }
+{****************************************************************}
+
+
+{$define USE_PASCAL_OBJECT}
+
+
+{$ifdef USE_PASCAL_OBJECT}
+  {$ifdef win32}
+  {$L ptest.ow}
+  {$else}
+  {$L ptest.o}
+  {$endif not win32}
+{$endif USE_PASCAL_OBJECT}
+
+{$i tcalext.pp }
+