+ var parameter testing

+ function result testing
+ floating point testing

tests/test/cg/obj/ctest.c

@@ -3,10 +3,29 @@
   Copyright (c) 2002, Carl Eric Codere
 */
 
+/*
+   Note : Arrays seem to always be passed by reference
+   in the C language. Therefore, no testing is required
+   to use them.
+*/
+
 unsigned char global_u8bit;
 unsigned short global_u16bit;
 unsigned long global_u32bit;
 unsigned long long global_s64bit;
+float global_float;
+double global_double;
+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
+
 
 struct _3BYTE_
 {
@@ -22,6 +41,9 @@ struct _7BYTE_
 };
 
 
+struct _7BYTE_ test_struct;
+
+
 /* simple parameter testing */
 void test_param_u8(unsigned char v)
 {
@@ -45,6 +67,29 @@ void test_param_s64(long long v)
   global_s64bit = v;
 }
 
+void test_param_float(float v)
+{
+  global_float = v;
+}
+
+void test_param_double(double v)
+{
+  global_double = v;
+}
+
+
+void test_param_longdouble(long double v)
+{
+  global_long_double = v;
+}
+
+/* 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)
 {
@@ -78,9 +123,64 @@ void test_param_struct_large(struct _7BYTE_ buffer)
 	global_s64bit = buffer.s64;
 }
 
+
+/* function result testing */
+unsigned char test_function_u8()
+{
+	return RESULT_U8BIT;
+}
+
+unsigned short test_function_u16()
+{
+	return RESULT_U16BIT;
+}
+
+unsigned long test_function_u32()
+{
+	return RESULT_U32BIT;
+}
+
+unsigned long long test_function_s64()
+{
+	return RESULT_S64BIT;
+}
+
+char* test_function_pchar()
+{
+	return RESULT_PCHAR;
+}
+
+float test_function_float()
+{
+	return RESULT_FLOAT;
+}
+
+double test_function_double()
+{
+	return RESULT_DOUBLE;
+}
+
+long double test_function_longdouble()
+{
+	return RESULT_LONGDOUBLE;
+}
+
+struct _7BYTE_ test_function_struct()
+{
+	test_struct.u8 = RESULT_U8BIT;
+	test_struct.s64 = RESULT_S64BIT;
+	test_struct.u16 = RESULT_U16BIT;
+	return test_struct;
+}
+
 /*
   $Log$
-  Revision 1.2  2002-04-22 19:09:12  carl
+  Revision 1.3  2002-05-04 16:57:23  carl
+  + var parameter testing
+  + function result testing
+  + floating point testing
+
+  Revision 1.2  2002/04/22 19:09:12  carl
   + added structure testing
 
   Revision 1.1  2002/04/13 21:06:39  carl

tests/test/cg/tcalext.pp

@@ -19,6 +19,7 @@ program tcalext;
 {$MODE OBJFPC}
 {$STATIC ON}
 {$R+}
+uses strings;
 
 {$L ctest.o}
 { Use C alignment of records }
@@ -28,6 +29,10 @@ const
    RESULT_U16BIT = $500F;
    RESULT_U32BIT = $500F0000;
    RESULT_S64BIT = -12000;
+   RESULT_FLOAT  = 14.54;
+   RESULT_DOUBLE = RESULT_FLOAT;
+   RESULT_LONGDOUBLE = RESULT_FLOAT;
+   RESULT_PCHAR  = 'Hello world';
 
 type
  _3byte_ = record
@@ -47,6 +52,11 @@ 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_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: double); cdecl; external;
+procedure test_param_var_u8(var x: byte); 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;
@@ -54,6 +64,16 @@ procedure test_param_mixed_s64(z: byte; x: int64; y: byte); cdecl; external;
 { structure parameter testing }
 procedure test_param_struct_small(buffer :  _3BYTE_); cdecl; external;
 procedure test_param_struct_large(buffer :  _7BYTE_); 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_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_struct : _7byte_; cdecl; external;
 
 
 
@@ -65,10 +85,16 @@ var
  global_u16bit : word; cvar; external;
  global_u32bit : 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_u16bit : word;
  value_u32bit : cardinal;
  value_s64bit : int64;
+ value_float : single;
+ value_double : double;
+ value_longdouble : extended;
 
  procedure clear_globals;
   begin
@@ -76,7 +102,10 @@ var
     global_u16bit := 0;
     global_u32bit := 0;
     global_s64bit := 0;
-  end;
+    global_float := 0.0;
+    global_double := 0.0;
+    global_long_double := 0.0;
+   end;
 
  procedure clear_values;
   begin
@@ -84,6 +113,9 @@ var
     value_u16bit := 0;
     value_u32bit := 0;
     value_s64bit := 0;
+    value_float := 0.0;
+    value_double := 0.0;
+    value_longdouble := 0.0;
   end;
 
   procedure fail;
@@ -96,6 +128,7 @@ var
 var failed : boolean;
     smallstruct : _3BYTE_;
     bigstruct : _7BYTE_;
+    pc: pchar;
 begin
   Write('External simple parameter testing...');
   failed := false;
@@ -131,7 +164,39 @@ begin
   test_param_s64(value_s64bit);
   if global_s64bit <> RESULT_S64BIT then
     failed := true;
+
+  clear_values;
+  clear_globals;
+
+  value_float := RESULT_FLOAT;    
+  test_param_float(value_float);
+  if trunc(global_float) <> trunc(RESULT_FLOAT) then
+    failed := true;
+    
+  clear_values;
+  clear_globals;
   
+  value_double := RESULT_DOUBLE;    
+  test_param_double(value_double);
+  if trunc(global_double) <> trunc(RESULT_DOUBLE) then
+    failed := true;
+
+  clear_values;
+  clear_globals;
+
+  value_longdouble := RESULT_LONGDOUBLE;    
+  test_param_longdouble(value_longdouble);
+  if trunc(global_long_double) <> trunc(RESULT_LONGDOUBLE) then
+    failed := true;
+    
+  { var parameter testing }    
+  clear_values;
+  clear_globals;
+  test_param_var_u8(value_u8bit);
+  if value_u8bit <> RESULT_U8BIT then
+     failed := true;
+    
+    
   If failed then 
    fail
   else
@@ -212,12 +277,94 @@ begin
    fail
   else
     WriteLn('Passed!');
+
+
+  Write('Function result testing...');
+  failed := false;
+  
+  clear_values;
+  clear_globals;
+  
+  value_u8bit := test_function_u8;
+  if value_u8bit <> RESULT_U8BIT then
+    failed := true;
+
+  clear_values;
+  clear_globals;
+  
+  value_u16bit := test_function_u16;
+  if value_u16bit <> RESULT_U16BIT then
+    failed := true;
+
+  clear_values;
+  clear_globals;
+  
+  value_u32bit := test_function_u32;
+  if value_u32bit <> RESULT_U32BIT then
+    failed := true;
+
+  clear_values;
+  clear_globals;
+
+  value_s64bit := test_function_s64;
+  if value_s64bit <> RESULT_S64BIT then
+    failed := true;
+
+  clear_values;
+  clear_globals;
+  
+  { verify if the contents both strings are equal }
+  pc := test_function_pchar;
+  if strcomp(pc, RESULT_PCHAR) <> 0 then
+    failed := true;
+
+  clear_values;
+  clear_globals;
+
+  value_float := test_function_float;
+  if trunc(value_float) <> trunc(RESULT_FLOAT) then
+    failed := true;
+
+  clear_values;
+  clear_globals;
+
+  value_double := test_function_double;
+  if trunc(value_double) <> trunc(RESULT_DOUBLE) then
+    failed := true;
+
+  clear_values;
+  clear_globals;
+
+  value_longdouble := test_function_longdouble;
+  if trunc(value_longdouble) <> trunc(RESULT_LONGDOUBLE) then
+    failed := true;
+ 
+  clear_values;
+  clear_globals;
+
+  bigstruct := test_function_struct;
+  if bigstruct.u8 <> RESULT_U8BIT then
+    failed := true;
+  if bigstruct.s64 <> RESULT_S64BIT then
+    failed := true;
+  if bigstruct.u16 <> RESULT_U16BIT then
+    failed := true;
+
+  If failed then 
+   fail
+  else
+    WriteLn('Passed!');
   
 end.
 
 {
   $Log$
-  Revision 1.2  2002-04-22 19:09:28  carl
+  Revision 1.3  2002-05-04 16:56:54  carl
+  + var parameter testing
+  + function result testing
+  + floating point testing
+
+  Revision 1.2  2002/04/22 19:09:28  carl
   + added structure testing
 
   Revision 1.1  2002/04/13 21:03:43  carl