mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-20 19:09:23 +02:00
- 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 -
This commit is contained in:
Jonas Maebe
parent
c8d75245a9
commit
2a752f2c49
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -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
|
||||
|
||||
@ -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.
|
||||
Loading…
Reference in New Issue
Block a user