mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-22 11:49:23 +02:00
792 lines
20 KiB
ObjectPascal
792 lines
20 KiB
ObjectPascal
{ %FILES=ctest.o }
|
|
{****************************************************************}
|
|
{ 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,ctypes;
|
|
{$L ctest.o}
|
|
{$endif USE_PASCAL_OBJECT}
|
|
|
|
{$ifdef FPC_HAS_TYPE_EXTENDED}
|
|
{$define test_longdouble}
|
|
{$endif}
|
|
|
|
{$if defined(cpux86_64) and defined(android) and (sizeof(clongdouble)<>16)}
|
|
// On x86_64-android long double is 128-bit. There is no support for 128-bit floats in FPC yet.
|
|
{$undef test_longdouble}
|
|
{$endif}
|
|
|
|
{ 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;
|
|
clongdouble_array = array [0..1] of clongdouble;
|
|
|
|
|
|
{ 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: clongdouble); 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: clongdouble_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: clongdouble; 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;
|
|
function test_function_longdouble: clongdouble; cdecl; external;
|
|
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 : clongdouble; 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 clongdouble;
|
|
|
|
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;
|
|
|
|
{ in sub procedure to detect stack corruption when exiting }
|
|
procedure dotest;
|
|
const
|
|
has_errors : boolean = false;
|
|
|
|
procedure fail;
|
|
begin
|
|
WriteLn('Failed!');
|
|
has_errors:=true;
|
|
end;
|
|
|
|
|
|
var failed : boolean;
|
|
tinystruct : _1BYTE_;
|
|
smallstruct : _3BYTE_;
|
|
smallstruct_s : _3BYTE_S;
|
|
mediumstruct : _5BYTE_;
|
|
bigstruct : _7BYTE_;
|
|
pc: pchar;
|
|
begin
|
|
Write('External simple parameter testing...');
|
|
failed := false;
|
|
|
|
clear_values;
|
|
clear_globals;
|
|
|
|
value_u8bit := RESULT_U8BIT;
|
|
test_param_u8(value_u8bit);
|
|
if global_u8bit <> RESULT_U8BIT then
|
|
failed := true;
|
|
|
|
clear_values;
|
|
clear_globals;
|
|
|
|
value_u16bit := RESULT_U16BIT;
|
|
test_param_u16(value_u16bit);
|
|
if global_u16bit <> RESULT_U16BIT then
|
|
failed := true;
|
|
|
|
clear_values;
|
|
clear_globals;
|
|
|
|
value_u32bit := RESULT_U32BIT;
|
|
test_param_u32(value_u32bit);
|
|
if global_u32bit <> RESULT_U32BIT then
|
|
failed := true;
|
|
|
|
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
|
|
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;
|
|
|
|
{$ifdef test_longdouble}
|
|
clear_values;
|
|
clear_globals;
|
|
|
|
value_long_double := RESULT_LONGDOUBLE;
|
|
test_param_longdouble(value_long_double);
|
|
if Abs(RESULT_LONGDOUBLE - global_long_double) > 1E-15 then
|
|
failed := true;
|
|
{$endif}
|
|
|
|
{ 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
|
|
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;
|
|
|
|
{$ifdef test_longdouble}
|
|
array_long_double[1] := RESULT_LONGDOUBLE;
|
|
test_array_param_longdouble(array_long_double);
|
|
if Abs(RESULT_LONGDOUBLE - global_long_double) > 1E-15 then
|
|
failed := true;
|
|
{$endif test_longdouble}
|
|
|
|
If failed then
|
|
fail
|
|
else
|
|
WriteLn('Passed!');
|
|
|
|
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;
|
|
|
|
value_u8bit := RESULT_U8BIT;
|
|
value_u16bit := RESULT_U16BIT;
|
|
test_param_mixed_u16(value_u8bit, value_u16bit, value_u8bit);
|
|
if global_u16bit <> RESULT_U16BIT then
|
|
failed := true;
|
|
if global_u8bit <> RESULT_U8BIT then
|
|
failed := true;
|
|
|
|
clear_values;
|
|
clear_globals;
|
|
|
|
value_u8bit := RESULT_U8BIT;
|
|
value_u32bit := RESULT_U32BIT;
|
|
test_param_mixed_u32(value_u8bit, value_u32bit, value_u8bit);
|
|
if global_u32bit <> RESULT_U32BIT then
|
|
failed := true;
|
|
if global_u8bit <> RESULT_U8BIT then
|
|
failed := true;
|
|
|
|
clear_values;
|
|
clear_globals;
|
|
|
|
value_u8bit := RESULT_U8BIT;
|
|
value_s64bit := RESULT_S64BIT;
|
|
test_param_mixed_s64(value_u8bit, value_s64bit, value_u8bit);
|
|
if global_s64bit <> RESULT_S64BIT then
|
|
failed := true;
|
|
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...');
|
|
failed := false;
|
|
|
|
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;
|
|
|
|
{$ifdef test_longdouble}
|
|
value_u8bit := RESULT_U8BIT;
|
|
value_long_double := RESULT_LONGDOUBLE;
|
|
test_param_mixed_long_double(value_long_double, value_u8bit);
|
|
if Abs(RESULT_LONGDOUBLE - global_long_double) > 1E-15 then
|
|
failed := true;
|
|
if global_u8bit <> RESULT_U8BIT then
|
|
failed := true;
|
|
{$endif}
|
|
|
|
If failed then
|
|
fail
|
|
else
|
|
WriteLn('Passed!');
|
|
|
|
Write('External struct parameter testing...');
|
|
failed := false;
|
|
|
|
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);
|
|
if global_u16bit <> RESULT_U16BIT then
|
|
failed := true;
|
|
if global_u8bit <> RESULT_U8BIT then
|
|
failed := true;
|
|
|
|
clear_values;
|
|
clear_globals;
|
|
|
|
smallstruct_s.u16 := RESULT_U16BIT;
|
|
smallstruct_s.w8 := RESULT_U8BIT;
|
|
test_param_struct_small_s(smallstruct_s);
|
|
if global_u16bit <> RESULT_U16BIT then
|
|
failed := true;
|
|
if global_u8bit <> RESULT_U8BIT then
|
|
failed := true;
|
|
|
|
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;
|
|
bigstruct.s64 := RESULT_S64BIT;
|
|
test_param_struct_large(bigstruct);
|
|
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('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;
|
|
|
|
smallstruct_s.u16 := RESULT_U16BIT;
|
|
test_param_mixed_struct_small_s(smallstruct_s,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;
|
|
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_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;
|
|
|
|
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
|
|
failed := true;
|
|
|
|
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;
|
|
|
|
clear_values;
|
|
clear_globals;
|
|
|
|
value_double := test_function_double;
|
|
if trunc(value_double) <> trunc(RESULT_DOUBLE) then
|
|
failed := true;
|
|
|
|
{$ifdef test_longdouble}
|
|
clear_values;
|
|
clear_globals;
|
|
|
|
value_long_double := test_function_longdouble;
|
|
if Abs(RESULT_LONGDOUBLE - value_long_double) > 1E-15 then
|
|
failed := true;
|
|
{$endif}
|
|
|
|
clear_values;
|
|
clear_globals;
|
|
|
|
If failed then
|
|
fail
|
|
else
|
|
WriteLn('Passed!');
|
|
|
|
Write('Function result testing for struct...');
|
|
failed := false;
|
|
|
|
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;
|
|
|
|
smallstruct_s := test_function_small_struct_s;
|
|
if smallstruct_s.u16 <> RESULT_U16BIT then
|
|
failed := true;
|
|
if smallstruct_s.w8 <> RESULT_U8BIT 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;
|
|
if bigstruct.s64 <> RESULT_S64BIT then
|
|
failed := true;
|
|
if bigstruct.u16 <> RESULT_U16BIT then
|
|
failed := true;
|
|
|
|
If failed then
|
|
fail
|
|
else
|
|
WriteLn('Passed!');
|
|
|
|
if has_errors then
|
|
Halt(1);
|
|
end;
|
|
|
|
begin
|
|
dotest;
|
|
end.
|