Преглед изворни кода

- removed, because C "long double" compatibility has been fixed (via
the "cextended" type) and testing this functionality has been
enabled in tcalext a while back already

git-svn-id: trunk@15359 -

Jonas Maebe пре 15 година
родитељ
комит
2a752f2c49
2 измењених фајлова са 0 додато и 266 уклоњено
  1. 0 1
      .gitattributes
  2. 0 265
      tests/test/cg/tcalext2.pp

+ 0 - 1
.gitattributes

@@ -8601,7 +8601,6 @@ tests/test/cg/tcalcst7.pp svneol=native#text/plain
 tests/test/cg/tcalcst8.pp svneol=native#text/plain
 tests/test/cg/tcalcst9.pp svneol=native#text/plain
 tests/test/cg/tcalext.pp svneol=native#text/plain
-tests/test/cg/tcalext2.pp svneol=native#text/plain
 tests/test/cg/tcalext3.pp svneol=native#text/plain
 tests/test/cg/tcalext4.pp svneol=native#text/plain
 tests/test/cg/tcalext5.pp svneol=native#text/plain

+ 0 - 265
tests/test/cg/tcalext2.pp

@@ -1,265 +0,0 @@
-{ %cpu=i386 }
-{ %KNOWNRUNERROR=2,i386 long double array problem }
-{****************************************************************}
-{  CODE GENERATOR TEST PROGRAM                                   }
-{****************************************************************}
-{ NODE TESTED : secondcalln()                                    }
-{****************************************************************}
-{ PRE-REQUISITES: secondload()                                   }
-{                 secondassign()                                 }
-{                 secondcalln()                                  }
-{                 secondadd()                                    }
-{                 secondtypeconv()                               }
-{****************************************************************}
-{ DEFINES:                                                       }
-{****************************************************************}
-{ REMARKS: This tests a subset of the secondcalln() , it         }
-{          verifies the usage of external cdecl                  }
-{          modules compiled with C compilers.                    }
-{****************************************************************}
-
-
-{$ifndef USE_PASCAL_OBJECT}
-{$MODE OBJFPC}
-{$R+}
-uses strings;
-{$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 = 15.54;
-   RESULT_LONGDOUBLE = 16.54;
-   RESULT_PCHAR  = 'Hello world';
-
-type
- _1byte_ = record
-  u8 : byte;
- end;
-
- _3byte_ = record
-  u8 : byte;
-  u16 : word;
- end;
-
- _3byte_s = record
-  u16 : word;
-  w8 : byte;
- 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;
-{$ifdef FPC_HAS_TYPE_EXTENDED}
-procedure test_param_longdouble(x: extended); cdecl; external;
-{$endif FPC_HAS_TYPE_EXTENDED}
-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;
-{$ifdef FPC_HAS_TYPE_EXTENDED}
-procedure test_array_param_longdouble(x: extended_array); cdecl; external;
-{$endif FPC_HAS_TYPE_EXTENDED}
-
-{ 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_small_s(buffer :  _3BYTE_S); 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_small_s(buffer :  _3BYTE_S; 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;
-{$ifdef FPC_HAS_TYPE_EXTENDED}
-function test_function_longdouble: extended; cdecl; external;
-{$endif FPC_HAS_TYPE_EXTENDED}
-function test_function_tiny_struct : _1byte_; cdecl; external;
-function test_function_small_struct : _3byte_; cdecl; external;
-function test_function_small_struct_s : _3byte_s; cdecl; external;
-function test_function_medium_struct : _5byte_; cdecl; external;
-function test_function_struct : _7byte_; cdecl; external;
-
-
-
-
-
-var
- global_u8bit : byte; cvar; external;
- global_u16bit : word; 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_u64bit : qword;
- value_float : single;
- value_double : double;
- 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;
-    global_long_double := 0.0;
-   end;
-
- procedure clear_values;
-  begin
-    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_long_double := 0.0;
-  end;
-
-const
-  has_errors : boolean = false;
-  known_bug_about_extended_array_present : boolean = false;
-  procedure fail;
-   begin
-     WriteLn('Failed!');
-     has_errors:=true;
-   end;
-
-
-procedure dotest;
-var failed : boolean;
-    tinystruct : _1BYTE_;
-    smallstruct : _3BYTE_;
-    smallstruct_s : _3BYTE_S;
-    mediumstruct : _5BYTE_;
-    bigstruct : _7BYTE_;
-    pc: pchar;
-begin
-  failed := false;
-
-  clear_values;
-  clear_globals;
-
-{$ifdef FPC_HAS_TYPE_EXTENDED}
-  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
-          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');
-          halt(2);
-        end
-      else
-        failed := true;
-    end;
-
-  If failed then
-   fail
-  else
-    WriteLn('Passed!');
-{$endif FPC_HAS_TYPE_EXTENDED}
-
-  if has_errors then
-    Halt(1);
-end;
-
-begin
-  dotest;
-end.