t_id
159
t_adddate
2003/10/03
t_result
0
t_knownrunerror
0
tr_id | run | tr_ok | tr_skip | tr_result |
---|---|---|---|---|
525959647 | 948277 | True | False | Successfully run |
Record count: 1
{****************************************************************} { CODE GENERATOR TEST PROGRAM } { By Carl Eric Codere } {****************************************************************} { NODE TESTED : secondcallparan() } {****************************************************************} { PRE-REQUISITES: secondload() } { secondassign() } { secondtypeconv() } { secondtryexcept() } { secondcalln() } { secondadd() } {****************************************************************} { DEFINES: } { FPC = Target is FreePascal compiler } {****************************************************************} { REMARKS: This tests a subset of the secondcalln() node } { (var parameters with cdecl calling convention) } {****************************************************************} program tcalvar4; {$ifdef fpc} {$mode objfpc} {$INLINE ON} {$endif} {$R+} {$P-} {$V+} {$ifdef VER70} {$define tp} {$endif} { REAL should map to single or double } { so it is not checked, since single } { double nodes are checked. } { assumes that enumdef is the same as orddef (same storage format) } const { should be defined depending on CPU target } {$ifdef fpc} {$ifdef cpu68k} BIG_INDEX = 8000; SMALL_INDEX = 13; {$else} BIG_INDEX = 33000; SMALL_INDEX = 13; { value should not be aligned! } {$endif} {$else} BIG_INDEX = 33000; SMALL_INDEX = 13; { value should not be aligned! } {$endif} RESULT_U8BIT = $55; RESULT_U16BIT = $500F; RESULT_S32BIT = $500F0000; RESULT_S64BIT = $500F0000; RESULT_S32REAL = 1777.12; RESULT_S64REAL = 3444.24; RESULT_BOOL8BIT = 1; RESULT_BOOL16BIT = 1; RESULT_BOOL32BIT = 1; RESULT_PCHAR = 'Hello world'; RESULT_BIGSTRING = 'Hello world'; RESULT_SMALLSTRING = 'H'; RESULT_CHAR = 'I'; RESULT_BOOLEAN = TRUE; type {$ifdef fpc} pbytearr=^byte; {$else} pbytearr=^tbytearr; tbytearr=array[0..$fffffff] of byte; {$endif} tclass1 = class end; tprocedure = procedure; tsmallrecord = packed record b: byte; w: word; end; tlargerecord = packed record b: array[1..BIG_INDEX] of byte; end; tsmallarray = packed array[1..SMALL_INDEX] of byte; tsmallsetenum = (A_A,A_B,A_C,A_D); tsmallset = set of tsmallsetenum; tlargeset = set of char; tsmallstring = string[2]; var global_u8bit : byte; global_u16bit : word; global_s32bit : longint; global_s64bit : int64; global_s32real : single; global_s64real : double; global_ptr : pchar; global_proc : tprocedure; global_class : tclass1; global_bigstring : shortstring; global_boolean : boolean; global_char : char; value_u8bit : byte; value_u16bit : word; value_s32bit : longint; value_s64bit : int64; value_s32real : single; value_s64real : double; value_proc : tprocedure; value_ptr : pchar; value_class : tclass1; value_smallrec : tsmallrecord; value_largerec : tlargerecord; value_smallset : tsmallset; value_smallstring : tsmallstring; value_bigstring : shortstring; value_largeset : tlargeset; value_smallarray : tsmallarray; value_boolean : boolean; value_char : char; procedure fail; begin WriteLn('Failure.'); halt(1); end; procedure clear_globals; begin global_u8bit := 0; global_u16bit := 0; global_s32bit := 0; global_s64bit := 0; global_s32real := 0.0; global_s64real := 0.0; global_ptr := nil; global_proc := nil; global_class := nil; global_bigstring := ''; global_boolean := false; global_char := #0; end; procedure clear_values; begin value_u8bit := 0; value_u16bit := 0; value_s32bit := 0; value_s64bit := 0; value_s32real := 0.0; value_s64real := 0.0; value_proc := nil; value_ptr := nil; value_class := nil; fillchar(value_smallrec, sizeof(value_smallrec), #0); fillchar(value_largerec, sizeof(value_largerec), #0); value_smallset := []; value_smallstring := ''; value_bigstring := ''; value_largeset := []; fillchar(value_smallarray, sizeof(value_smallarray), #0); value_boolean := false; value_char:=#0; end; procedure testprocedure; begin end; function getu8bit : byte; begin getu8bit:=RESULT_U8BIT; end; function getu16bit: word; begin getu16bit:=RESULT_U16BIT; end; function gets32bit: longint; begin gets32bit:=RESULT_S32BIT; end; function gets64bit: int64; begin gets64bit:=RESULT_S64BIT; end; function gets32real: single; begin gets32real:=RESULT_S32REAL; end; function gets64real: double; begin gets64real:=RESULT_S64REAL; end; {************************************************************************} { VAR PARAMETERS } {************************************************************************} procedure proc_var_s32bit(var v : longint);cdecl; begin v:=RESULT_S32BIT; end; procedure proc_var_s64bit(var v: int64);cdecl; begin v:=RESULT_S64BIT; end; procedure proc_var_u8bit(var v: byte);cdecl; begin v:=RESULT_U8BIT; end; procedure proc_var_smallrecord(var smallrec : tsmallrecord);cdecl; begin smallrec.b := RESULT_U8BIT; smallrec.w := RESULT_U16BIT; end; procedure proc_var_largerecord(var largerec : tlargerecord);cdecl; begin largerec.b[1] := RESULT_U8BIT; largerec.b[2] := RESULT_U8BIT; end; procedure proc_var_smallset(var smallset : tsmallset);cdecl; begin smallset := [A_A,A_D]; end; procedure proc_var_largeset(var largeset : tlargeset);cdecl; begin largeset:= largeset + ['I']; end; procedure proc_var_smallstring(var s:tsmallstring);cdecl; begin s:=RESULT_SMALLSTRING; end; procedure proc_var_bigstring(var s:shortstring);cdecl; begin s:=RESULT_BIGSTRING; end; procedure proc_var_openstring(var s: OpenString);cdecl; begin global_u8bit := {high(s) is not available with cdecl}255; s:=RESULT_SMALLSTRING; end; procedure proc_var_smallarray(var arr : tsmallarray);cdecl; begin arr[SMALL_INDEX] := RESULT_U8BIT; arr[1] := RESULT_U8BIT; end; procedure proc_var_formaldef_array(var buf);cdecl; var p: pbytearr; begin { array is indexed from 1 } p := @buf; p[SMALL_INDEX-1] := RESULT_U8BIT; p[0] := RESULT_U8BIT; end; procedure proc_var_formaldef_string(var buf);cdecl; var p: pbytearr; begin { array is indexed from 1 } p := @buf; p[SMALL_INDEX-1] := RESULT_U8BIT; p[0] := RESULT_U8BIT; end; {************************************************************************} { MIXED VAR PARAMETERS } {************************************************************************} procedure proc_var_s32bit_mixed(b1 : byte;var v : longint; b2: byte);cdecl; begin v:=RESULT_S32BIT; value_u8bit := RESULT_U8BIT; end; procedure proc_var_s64bit_mixed(b1 : byte;var v: int64; b2: byte);cdecl; begin v:=RESULT_S64BIT; value_u8bit := RESULT_U8BIT; end; procedure proc_var_u8bit_mixed(b1 : byte;var v: byte; b2: byte);cdecl; begin v:=RESULT_U8BIT; value_u8bit := RESULT_U8BIT; end; procedure proc_var_smallrecord_mixed(b1 : byte; var smallrec : tsmallrecord; b2: byte);cdecl; begin smallrec.b := RESULT_U8BIT; smallrec.w := RESULT_U16BIT; value_u8bit := RESULT_U8BIT; end; procedure proc_var_largerecord_mixed(b1 : byte; var largerec : tlargerecord; b2: byte);cdecl; begin largerec.b[1] := RESULT_U8BIT; largerec.b[2] := RESULT_U8BIT; value_u8bit := RESULT_U8BIT; end; procedure proc_var_smallset_mixed(b1 : byte; var smallset : tsmallset; b2: byte);cdecl; begin smallset := [A_A,A_D]; value_u8bit := RESULT_U8BIT; end; procedure proc_var_largeset_mixed(b1 : byte; var largeset : tlargeset; b2: byte);cdecl; begin largeset:= largeset + ['I']; value_u8bit := RESULT_U8BIT; end; procedure proc_var_smallstring_mixed(b1 : byte; var s:tsmallstring; b2: byte);cdecl; begin s:=RESULT_SMALLSTRING; value_u8bit := RESULT_U8BIT; end; procedure proc_var_bigstring_mixed(b1 : byte; var s:shortstring; b2: byte);cdecl; begin s:=RESULT_BIGSTRING; value_u8bit := RESULT_U8BIT; end; procedure proc_var_openstring_mixed(b1 : byte; var s: OpenString; b2: byte);cdecl; begin global_u8bit := {high(s) is not available with cdecl}255; s:=RESULT_SMALLSTRING; value_u8bit := RESULT_U8BIT; end; procedure proc_var_smallarray_mixed(b1 : byte; var arr : tsmallarray; b2: byte);cdecl; begin arr[SMALL_INDEX] := RESULT_U8BIT; arr[1] := RESULT_U8BIT; value_u8bit := RESULT_U8BIT; end; procedure proc_var_formaldef_array_mixed(b1 : byte; var buf; b2: byte);cdecl; var p: pbytearr; begin { array is indexed from 1 } p := @buf; p[SMALL_INDEX-1] := RESULT_U8BIT; p[0] := RESULT_U8BIT; value_u8bit := RESULT_U8BIT; end; procedure proc_var_formaldef_string_mixed(b1 : byte; var buf; b2: byte);cdecl; var p: pbytearr; begin { array is indexed from 1 } p := @buf; p[SMALL_INDEX-1] := RESULT_U8BIT; p[0] := RESULT_U8BIT; value_u8bit := RESULT_U8BIT; end; var failed: boolean; pp : ^pchar; begin {***************************** NORMAL TESTS *******************************} clear_globals; clear_values; failed:=false; write('Var parameter test (src : LOC_REFERENCE (orddef)))...'); proc_var_s32bit(global_s32bit); if global_s32bit <> RESULT_S32BIT then failed:=true; clear_globals; clear_values; proc_var_s64bit(global_s64bit); if global_s64bit <> RESULT_S64BIT then failed:=true; clear_globals; clear_values; proc_var_u8bit(global_u8bit); if global_u8bit <> RESULT_U8BIT then failed:=true; if failed then fail else WriteLn('Passed!'); write('Var parameter test (src : LOC_REFERENCE (recorddef)))...'); clear_globals; clear_values; failed := false; proc_var_smallrecord(value_smallrec); if (value_smallrec.b <> RESULT_U8BIT) or (value_smallrec.w <> RESULT_U16BIT) then failed := true; clear_globals; clear_values; proc_var_largerecord(value_largerec); if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[2] <> RESULT_U8BIT) then failed := true; if failed then fail else WriteLn('Passed!'); write('var parameter test (src : LOC_REFERENCE (setdef)))...'); clear_globals; clear_values; failed := false; proc_var_smallset(value_smallset); if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then failed := true; clear_globals; clear_values; proc_var_largeset(value_largeset); if not ('I' in value_largeset) then failed := true; if failed then fail else WriteLn('Passed!'); write('var parameter test (src : LOC_REFERENCE (stringdef)))...'); clear_globals; clear_values; failed := false; proc_var_smallstring(value_smallstring); if value_smallstring <> RESULT_SMALLSTRING then failed := true; clear_globals; clear_values; proc_var_bigstring(value_bigstring); if value_bigstring <> RESULT_BIGSTRING then failed := true; clear_globals; clear_values; proc_var_openstring(value_smallstring); if (value_smallstring <> RESULT_SMALLSTRING) or { high is not passed to cdecl'ared functions thus value_smallstring should be 255 on retyurn PM } (global_u8bit <> {high(value_smallstring)}255) then failed := true; if failed then fail else WriteLn('Passed!'); write('Var parameter test (src : LOC_REFERENCE (formaldef)))...'); clear_globals; clear_values; failed:=false; proc_var_formaldef_array(value_smallarray); if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then failed := true; if failed then fail else WriteLn('Passed!'); write('Var parameter test (src : LOC_REFERENCE (arraydef)))...'); clear_globals; clear_values; failed:=false; value_smallarray[SMALL_INDEX] := RESULT_U8BIT; proc_var_smallarray(value_smallarray); if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then failed := true; if failed then fail else WriteLn('Passed!'); {***************************** MIXED TESTS *******************************} clear_globals; clear_values; failed:=false; write('Var parameter test (src : LOC_REFERENCE (orddef)))...'); proc_var_s32bit_mixed(RESULT_U8BIT, global_s32bit, RESULT_U8BIT); if global_s32bit <> RESULT_S32BIT then failed:=true; if value_u8bit <> RESULT_U8BIT then failed := true; clear_globals; clear_values; proc_var_s64bit_mixed(RESULT_U8BIT, global_s64bit, RESULT_U8BIT); if global_s64bit <> RESULT_S64BIT then failed:=true; if value_u8bit <> RESULT_U8BIT then failed := true; clear_globals; clear_values; proc_var_u8bit_mixed(RESULT_U8BIT, global_u8bit, RESULT_U8BIT); if global_u8bit <> RESULT_U8BIT then failed:=true; if value_u8bit <> RESULT_U8BIT then failed := true; if failed then fail else WriteLn('Passed!'); write('Var parameter test (src : LOC_REFERENCE (recorddef)))...'); clear_globals; clear_values; failed := false; proc_var_smallrecord_mixed(RESULT_U8BIT,value_smallrec, RESULT_U8BIT); if (value_smallrec.b <> RESULT_U8BIT) or (value_smallrec.w <> RESULT_U16BIT) then failed := true; if value_u8bit <> RESULT_U8BIT then failed := true; clear_globals; clear_values; proc_var_largerecord_mixed(RESULT_U8BIT, value_largerec, RESULT_U8BIT); if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[2] <> RESULT_U8BIT) then failed := true; if value_u8bit <> RESULT_U8BIT then failed := true; if failed then fail else WriteLn('Passed!'); write('var parameter test (src : LOC_REFERENCE (setdef)))...'); clear_globals; clear_values; failed := false; proc_var_smallset_mixed(RESULT_U8BIT, value_smallset, RESULT_U8BIT); if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then failed := true; if value_u8bit <> RESULT_U8BIT then failed := true; clear_globals; clear_values; proc_var_largeset_mixed(RESULT_U8BIT, value_largeset, RESULT_U8BIT); if not ('I' in value_largeset) then failed := true; if value_u8bit <> RESULT_U8BIT then failed := true; if failed then fail else WriteLn('Passed!'); write('var parameter test (src : LOC_REFERENCE (stringdef)))...'); clear_globals; clear_values; failed := false; proc_var_smallstring_mixed(RESULT_U8BIT, value_smallstring, RESULT_U8BIT); if value_smallstring <> RESULT_SMALLSTRING then failed := true; if value_u8bit <> RESULT_U8BIT then failed := true; clear_globals; clear_values; proc_var_bigstring_mixed(RESULT_U8BIT, value_bigstring,RESULT_U8BIT); if value_bigstring <> RESULT_BIGSTRING then failed := true; if value_u8bit <> RESULT_U8BIT then failed := true; clear_globals; clear_values; proc_var_openstring_mixed(RESULT_U8BIT, value_smallstring, RESULT_U8BIT); if (value_smallstring <> RESULT_SMALLSTRING) or { high is not passed to cdecl'ared functions thus value_smallstring should be 255 on retyurn PM } (global_u8bit <> {high(value_smallstring)}255) then failed := true; if value_u8bit <> RESULT_U8BIT then failed := true; if failed then fail else WriteLn('Passed!'); write('Var parameter test (src : LOC_REFERENCE (formaldef)))...'); clear_globals; clear_values; failed:=false; proc_var_formaldef_array_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT); if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then failed := true; if value_u8bit <> RESULT_U8BIT then failed := true; if failed then fail else WriteLn('Passed!'); write('Var parameter test (src : LOC_REFERENCE (arraydef)))...'); clear_globals; clear_values; failed:=false; value_smallarray[SMALL_INDEX] := RESULT_U8BIT; proc_var_smallarray_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT); if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then failed := true; if value_u8bit <> RESULT_U8BIT then failed := true; if failed then fail else WriteLn('Passed!'); end. { $Log: tcalvar4.pp,v $ Revision 1.9 2003/04/22 10:24:29 florian * fixed defines for powerpc Revision 1.8 2002/12/29 15:30:55 peter * updated for 1.1 compiler that does not allow calling conventions for constructor/destructor Revision 1.7 2002/12/05 15:54:20 pierre * update as openstrings are transformed into normal string in cdecl'ared functions Revision 1.6 2002/11/20 19:39:21 carl - high() cannot be used in cdecle'd routines Revision 1.5 2002/11/09 21:47:37 carl + updated tests for correct parsing (array of const now allowed with high!) Revision 1.4 2002/09/22 09:08:41 carl * gets64bit was not returning an int64! Revision 1.3 2002/09/07 15:40:55 peter * old logs removed and tabs fixed Revision 1.2 2002/05/13 13:45:38 peter * updated to compile tests with kylix Revision 1.1 2002/04/13 17:51:00 carl + var parameter passing for different calling conventions }