123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877 |
- { %maxversion=1.9.4 }
- {****************************************************************}
- { 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 }
- { (const parameters with saveregisters }
- { calling convention) }
- {****************************************************************}
- program tcalcst9;
- {$ifdef fpc}
- {$mode objfpc}
- {$INLINE ON}
- {$endif}
- {$R+}
- {$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
- {$ifndef tp}
- tclass1 = class
- end;
- {$else}
- shortstring = string;
- {$endif}
- tprocedure = procedure;
- tsmallrecord =
- {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
- packed
- {$endif FPC_REQUIRES_PROPER_ALIGNMENT}
- 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_s32real : single;
- global_s64real : double;
- global_ptr : pchar;
- global_proc : tprocedure;
- global_bigstring : shortstring;
- global_boolean : boolean;
- global_char : char;
- value_u8bit : byte;
- value_u16bit : word;
- value_s32bit : longint;
- {$ifndef tp}
- global_class : tclass1;
- global_s64bit : int64;
- value_s64bit : int64;
- value_class : tclass1;
- {$endif}
- value_s32real : single;
- value_s64real : double;
- value_proc : tprocedure;
- value_ptr : pchar;
- 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_s32real := 0.0;
- global_s64real := 0.0;
- global_ptr := nil;
- global_proc := nil;
- global_bigstring := '';
- global_boolean := false;
- global_char := #0;
- {$ifndef tp}
- global_s64bit := 0;
- global_class := nil;
- {$endif}
- end;
- procedure clear_values;
- begin
- value_u8bit := 0;
- value_u16bit := 0;
- value_s32bit := 0;
- value_s32real := 0.0;
- value_s64real := 0.0;
- value_proc := nil;
- value_ptr := nil;
- {$ifndef tp}
- value_s64bit := 0;
- value_class := nil;
- {$endif}
- 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;
- {************************************************************************}
- { CONST PARAMETERS }
- {************************************************************************}
- procedure proc_const_s32bit(const v : longint);saveregisters;
- begin
- global_s32bit := v;
- end;
- {$ifndef tp}
- procedure proc_const_s64bit(const v: int64);saveregisters;
- begin
- global_s64bit:= v;
- end;
- procedure proc_const_smallarray_const_1(const arr : array of const);saveregisters;
- var
- i: integer;
- begin
- for i:=0 to high(arr) do
- begin
- case arr[i].vtype of
- vtInteger : global_u8bit := arr[i].vinteger and $ff;
- vtBoolean : global_boolean := arr[i].vboolean;
- vtChar : global_char := arr[i].vchar;
- vtExtended : global_s64real := arr[i].VExtended^;
- vtString : global_bigstring := arr[i].VString^;
- vtPointer : ;
- vtPChar : global_ptr := arr[i].VPchar;
- vtObject : ;
- { vtClass : global_class := (arr[i].VClass) as tclass1;}
- vtAnsiString : ;
- vtInt64 : global_s64bit := arr[i].vInt64^;
- else
- RunError(255);
- end;
- end; {endfor}
- end;
- procedure proc_const_smallarray_const_2(const arr : array of const);saveregisters;
- var
- i: integer;
- begin
- if high(arr)<0 then
- global_u8bit := RESULT_U8BIT;
- end;
- {$endif}
- procedure proc_const_smallrecord(const smallrec : tsmallrecord);saveregisters;
- begin
- if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then
- global_u8bit := RESULT_U8BIT;
- end;
- procedure proc_const_largerecord(const largerec : tlargerecord);saveregisters;
- begin
- if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then
- global_u8bit := RESULT_U8BIT;
- end;
- procedure proc_const_smallset(const smallset : tsmallset);saveregisters;
- begin
- if A_D in smallset then
- global_u8bit := RESULT_U8BIT;
- end;
- procedure proc_const_largeset(const largeset : tlargeset);saveregisters;
- begin
- if 'I' in largeset then
- global_u8bit := RESULT_U8BIT;
- end;
- procedure proc_const_smallstring(const s:tsmallstring);saveregisters;
- begin
- if s = RESULT_SMALLSTRING then
- global_u8bit := RESULT_u8BIT;
- end;
- procedure proc_const_bigstring(const s:shortstring);saveregisters;
- begin
- if s = RESULT_BIGSTRING then
- global_u8bit := RESULT_u8BIT;
- end;
- procedure proc_const_smallarray(const arr : tsmallarray);saveregisters;
- begin
- if arr[SMALL_INDEX] = RESULT_U8BIT then
- global_u8bit := RESULT_U8BIT;
- end;
- procedure proc_const_smallarray_open(const arr : array of byte);saveregisters;
- begin
- { form 0 to N-1 indexes in open arrays }
- if arr[SMALL_INDEX-1] = RESULT_U8BIT then
- global_u8bit := RESULT_U8BIT;
- end;
- procedure proc_const_formaldef_array(const buf);saveregisters;
- var
- p: pchar;
- begin
- { array is indexed from 1 }
- p := @buf;
- global_u8bit := byte(p[SMALL_INDEX-1]);
- end;
- {************************************************************************}
- { MIXED CONST PARAMETERS }
- {************************************************************************}
- procedure proc_const_s32bit_mixed(b1: byte; const v : longint; b2: byte);saveregisters;
- begin
- global_s32bit := v;
- value_u8bit := b2;
- end;
- {$ifndef tp}
- procedure proc_const_s64bit_mixed(b1 : byte; const v: int64; b2: byte);saveregisters;
- begin
- global_s64bit:= v;
- value_u8bit := b2;
- end;
- procedure proc_const_smallarray_const_1_mixed(b1 : byte; const arr : array of const; b2: byte);saveregisters;
- var
- i: integer;
- begin
- for i:=0 to high(arr) do
- begin
- case arr[i].vtype of
- vtInteger : global_u8bit := arr[i].vinteger and $ff;
- vtBoolean : global_boolean := arr[i].vboolean;
- vtChar : global_char := arr[i].vchar;
- vtExtended : global_s64real := arr[i].VExtended^;
- vtString : global_bigstring := arr[i].VString^;
- vtPointer : ;
- vtPChar : global_ptr := arr[i].VPchar;
- vtObject : ;
- { vtClass : global_class := (arr[i].VClass) as tclass1;}
- vtAnsiString : ;
- vtInt64 : global_s64bit := arr[i].vInt64^;
- else
- RunError(255);
- end;
- end; {endfor}
- value_u8bit := b2;
- end;
- procedure proc_const_smallarray_const_2_mixed(b1: byte; const arr : array of const; b2: byte);saveregisters;
- var
- i: integer;
- begin
- if high(arr)<0 then
- global_u8bit := RESULT_U8BIT;
- value_u8bit := b2;
- end;
- {$endif}
- procedure proc_const_smallrecord_mixed(b1 : byte; const smallrec : tsmallrecord; b2: byte);saveregisters;
- begin
- if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then
- global_u8bit := RESULT_U8BIT;
- value_u8bit := b2;
- end;
- procedure proc_const_largerecord_mixed(b1: byte; const largerec : tlargerecord; b2: byte);saveregisters;
- begin
- if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then
- global_u8bit := RESULT_U8BIT;
- value_u8bit := b2;
- end;
- procedure proc_const_smallset_mixed(b1: byte; const smallset : tsmallset; b2: byte);saveregisters;
- begin
- if A_D in smallset then
- global_u8bit := RESULT_U8BIT;
- value_u8bit := b2;
- end;
- procedure proc_const_largeset_mixed(b1: byte; const largeset : tlargeset; b2: byte);saveregisters;
- begin
- if 'I' in largeset then
- global_u8bit := RESULT_U8BIT;
- value_u8bit := b2;
- end;
- procedure proc_const_smallstring_mixed(b1: byte; const s:tsmallstring; b2: byte);saveregisters;
- begin
- if s = RESULT_SMALLSTRING then
- global_u8bit := RESULT_u8BIT;
- value_u8bit := b2;
- end;
- procedure proc_const_bigstring_mixed(b1: byte; const s:shortstring; b2: byte);saveregisters;
- begin
- if s = RESULT_BIGSTRING then
- global_u8bit := RESULT_u8BIT;
- value_u8bit := b2;
- end;
- procedure proc_const_smallarray_mixed(b1: byte; const arr : tsmallarray; b2: byte);saveregisters;
- begin
- if arr[SMALL_INDEX] = RESULT_U8BIT then
- global_u8bit := RESULT_U8BIT;
- value_u8bit := b2;
- end;
- procedure proc_const_smallarray_open_mixed(b1: byte; const arr : array of byte; b2: byte);saveregisters;
- begin
- { form 0 to N-1 indexes in open arrays }
- if arr[high(arr)] = RESULT_U8BIT then
- global_u8bit := RESULT_U8BIT;
- value_u8bit := b2;
- end;
- procedure proc_const_formaldef_array_mixed(b1: byte; const buf; b2: byte);saveregisters;
- var
- p: pchar;
- begin
- { array is indexed from 1 }
- p := @buf;
- global_u8bit := byte(p[SMALL_INDEX-1]);
- value_u8bit := b2;
- end;
- var
- failed: boolean;
- pp : ^pchar;
- begin
- {***************************** NORMAL TESTS *******************************}
- write('Const parameter test (src : LOC_REGISTER (orddef)))...');
- clear_globals;
- clear_values;
- failed:=false;
- proc_const_s32bit(gets32bit);
- if global_s32bit <> RESULT_S32BIT then
- failed:=true;
- {$ifndef tp}
- proc_const_s64bit(gets64bit);
- if global_s64bit <> RESULT_S64BIT then
- failed:=true;
- {$endif}
- if failed then
- fail
- else
- WriteLn('Passed!');
- write('Const parameter test (src : LOC_REFERENCE (recorddef)))...');
- clear_globals;
- clear_values;
- failed := false;
- value_smallrec.b := RESULT_U8BIT;
- value_smallrec.w := RESULT_U16BIT;
- proc_const_smallrecord(value_smallrec);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- clear_globals;
- clear_values;
- fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT);
- proc_const_largerecord(value_largerec);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if failed then
- fail
- else
- WriteLn('Passed!');
- write('const parameter test (src : LOC_REFERENCE (setdef)))...');
- clear_globals;
- clear_values;
- failed := false;
- value_smallset := [A_A,A_D];
- proc_const_smallset(value_smallset);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- clear_globals;
- clear_values;
- value_largeset := ['I'];
- proc_const_largeset(value_largeset);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if failed then
- fail
- else
- WriteLn('Passed!');
- write('const parameter test (src : LOC_REFERENCE (stringdef)))...');
- clear_globals;
- clear_values;
- failed := false;
- value_smallstring := RESULT_SMALLSTRING;
- proc_const_smallstring(value_smallstring);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- clear_globals;
- clear_values;
- value_bigstring := RESULT_BIGSTRING;
- proc_const_bigstring(value_bigstring);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if failed then
- fail
- else
- WriteLn('Passed!');
- write('Const parameter test (src : LOC_REFERENCE (formaldef)))...');
- clear_globals;
- clear_values;
- failed:=false;
- value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
- proc_const_formaldef_array(value_smallarray);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if failed then
- fail
- else
- WriteLn('Passed!');
- write('Const parameter test (src : LOC_REFERENCE (arraydef)))...');
- clear_globals;
- clear_values;
- failed:=false;
- value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
- proc_const_smallarray(value_smallarray);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- clear_globals;
- clear_values;
- value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
- proc_const_smallarray_open(value_smallarray);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- {$ifndef tp}
- clear_globals;
- clear_values;
- value_u8bit := RESULT_U8BIT;
- value_ptr := RESULT_PCHAR;
- value_s64bit := RESULT_S64BIT;
- value_smallstring := RESULT_SMALLSTRING;
- value_class := tclass1.create;
- value_boolean := RESULT_BOOLEAN;
- value_char := RESULT_CHAR;
- value_s64real:=RESULT_S64REAL;
- proc_const_smallarray_const_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real,
- value_boolean,value_class]);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_char <> RESULT_CHAR then
- failed := true;
- if global_boolean <> RESULT_BOOLEAN then
- failed:=true;
- if trunc(global_s64real) <> trunc(RESULT_S64REAL) then
- failed := true;
- if global_bigstring <> RESULT_SMALLSTRING then
- failed := true;
- if global_ptr <> value_ptr then
- failed := true;
- { if value_class <> global_class then
- failed := true;!!!!!!!!!!!!!!!!!!!!}
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if assigned(value_class) then
- value_class.destroy;
- global_u8bit := 0;
- proc_const_smallarray_const_2([]);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- {$endif}
- if failed then
- fail
- else
- WriteLn('Passed!');
- {***************************** MIXED TESTS *******************************}
- write('Mixed const parameter test (src : LOC_REGISTER (orddef)))...');
- clear_globals;
- clear_values;
- failed:=false;
- proc_const_s32bit_mixed(RESULT_U8BIT,gets32bit,RESULT_U8BIT);
- if global_s32bit <> RESULT_S32BIT then
- failed:=true;
- if value_u8bit <> RESULT_U8BIT then
- failed := true;
- {$ifndef tp}
- proc_const_s64bit_mixed(RESULT_U8BIT,gets64bit,RESULT_U8BIT);
- if global_s64bit <> RESULT_S64BIT then
- failed:=true;
- if value_u8bit <> RESULT_U8BIT then
- failed := true;
- {$endif}
- if failed then
- fail
- else
- WriteLn('Passed!');
- write('Mixed const parameter test (src : LOC_REFERENCE (recorddef)))...');
- clear_globals;
- clear_values;
- failed := false;
- value_smallrec.b := RESULT_U8BIT;
- value_smallrec.w := RESULT_U16BIT;
- proc_const_smallrecord_mixed(RESULT_U8BIT,value_smallrec,RESULT_U8BIT);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if value_u8bit <> RESULT_U8BIT then
- failed := true;
- clear_globals;
- clear_values;
- fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT);
- proc_const_largerecord_mixed(RESULT_U8BIT,value_largerec,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('Mixed const parameter test (src : LOC_REFERENCE (setdef)))...');
- clear_globals;
- clear_values;
- failed := false;
- value_smallset := [A_A,A_D];
- proc_const_smallset_mixed(RESULT_U8BIT,value_smallset,RESULT_U8BIT);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if value_u8bit <> RESULT_U8BIT then
- failed := true;
- clear_globals;
- clear_values;
- value_largeset := ['I'];
- proc_const_largeset_mixed(RESULT_U8BIT,value_largeset,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('Mixed const parameter test (src : LOC_REFERENCE (stringdef)))...');
- clear_globals;
- clear_values;
- failed := false;
- value_smallstring := RESULT_SMALLSTRING;
- proc_const_smallstring_mixed(RESULT_U8BIT,value_smallstring,RESULT_U8BIT);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if value_u8bit <> RESULT_U8BIT then
- failed := true;
- clear_globals;
- clear_values;
- value_bigstring := RESULT_BIGSTRING;
- proc_const_bigstring_mixed(RESULT_U8BIT,value_bigstring,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('Mixed const parameter test (src : LOC_REFERENCE (formaldef)))...');
- clear_globals;
- clear_values;
- failed:=false;
- value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
- proc_const_formaldef_array_mixed(RESULT_U8BIT,value_smallarray,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('Mixed const parameter test (src : LOC_REFERENCE (arraydef)))...');
- clear_globals;
- clear_values;
- failed:=false;
- value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
- proc_const_smallarray_mixed(RESULT_U8BIt,value_smallarray,RESULT_U8BIT);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if value_u8bit <> RESULT_U8BIT then
- failed := true;
- clear_globals;
- clear_values;
- value_smallarray[SMALL_INDEX] := RESULT_U8BIT;
- proc_const_smallarray_open_mixed(RESULT_U8BIT,value_smallarray,RESULT_U8BIT);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if value_u8bit <> RESULT_U8BIT then
- failed := true;
- {$ifndef tp}
- clear_globals;
- clear_values;
- value_u8bit := RESULT_U8BIT;
- value_ptr := RESULT_PCHAR;
- value_s64bit := RESULT_S64BIT;
- value_smallstring := RESULT_SMALLSTRING;
- value_class := tclass1.create;
- value_boolean := RESULT_BOOLEAN;
- value_char := RESULT_CHAR;
- value_s64real:=RESULT_S64REAL;
- proc_const_smallarray_const_1_mixed(RESULT_U8BIT, [value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,
- value_s64real,value_boolean,value_class],RESULT_U8BIT);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_char <> RESULT_CHAR then
- failed := true;
- if global_boolean <> RESULT_BOOLEAN then
- failed:=true;
- if trunc(global_s64real) <> trunc(RESULT_S64REAL) then
- failed := true;
- if global_bigstring <> RESULT_SMALLSTRING then
- failed := true;
- if global_ptr <> value_ptr then
- failed := true;
- { if value_class <> global_class then
- failed := true;!!!!!!!!!!!!!!!!!!!!}
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if assigned(value_class) then
- value_class.destroy;
- if value_u8bit <> RESULT_U8BIT then
- failed := true;
- global_u8bit := 0;
- proc_const_smallarray_const_2_mixed(RESULT_U8BIT,[],RESULT_U8BIT);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if value_u8bit <> RESULT_U8BIT then
- failed := true;
- {$endif}
- if failed then
- fail
- else
- WriteLn('Passed!');
- end.
- {
- $Log$
- Revision 1.7 2004-10-24 20:01:42 peter
- * saveregisters calling convention is obsolete
- Revision 1.6 2004/03/27 19:26:40 florian
- * alignment fixed
- Revision 1.5 2003/04/22 10:24:29 florian
- * fixed defines for powerpc
- Revision 1.4 2002/09/22 09:08:41 carl
- * gets64bit was not returning an int64!
- Revision 1.3 2002/09/07 15:40:51 peter
- * old logs removed and tabs fixed
- Revision 1.2 2002/05/13 13:45:36 peter
- * updated to compile tests with kylix
- Revision 1.1 2002/04/13 17:47:06 carl
- + constant parameter passing for different calling conventions
- }
|