t_id
119
t_adddate
2003/10/03
t_result
0
t_knownrunerror
2
tr_id | run | tr_ok | tr_skip | tr_result |
---|---|---|---|---|
1022833995 | 1027398 | True | False | Successfully run |
Record count: 1
{ %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} {$STATIC ON} {$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; 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_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: extended; 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 : 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; 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; clear_values; clear_globals; value_long_double := RESULT_LONGDOUBLE; test_param_longdouble(value_long_double); 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 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 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...'); 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 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; clear_values; clear_globals; 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; 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 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'); { if no other error, then notify that we konw about this problem } if not has_errors then halt(2); end; if has_errors then Halt(1); end. { $Log: tcalext.pp,v $ Revision 1.9 2002/11/18 16:48:00 pierre + use KNOWNRUNERROR for i386 long double problem Revision 1.8 2002/11/18 00:42:16 pierre + records with really 3 byte size tests added Revision 1.7 2002/11/17 21:46:17 peter * fixed 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 * fixed long double typo that was using double instead of extended 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 + C module testing (unfinished) }