t_id
108
t_adddate
2003/10/03
t_result
0
t_knownrunerror
0
tr_id | run | tr_ok | tr_skip | tr_result |
---|---|---|---|---|
949264207 | 1015553 | True | False | Successfully run |
Record count: 1
{****************************************************************} { CODE GENERATOR TEST PROGRAM } { By Carl Eric Codere } {****************************************************************} { NODE TESTED : secondassign() } {****************************************************************} { DEFINES: } { FPC = Target is FreePascal compiler } {****************************************************************} { REMARKS : Tested with Delphi 3 as reference implementation } {****************************************************************} program tassign2; {$ifdef fpc} {$warning Will only work on 32-bit cpu's} {$mode objfpc} {$endif} const RESULT_STRING = 'Hello world'; RESULT_S64BIT = -12; RESULT_S32BIT = -124356; RESULT_U32BIT = 654321; RESULT_U8BIT = $55; RESULT_S16BIT = -12124; RESULT_REAL = 12.12; { adjusts the size of the bigrecord } MAX_INDEX = 7; type { the size of this record should *at least* be the size of a natural register for the target processor } tbigrecord = record x : cardinal; y : cardinal; z : array[0..MAX_INDEX] of byte; end; procedure fail; begin WriteLn('Failure.'); halt(1); end; function getresults64bit: int64; begin getresults64bit := RESULT_S64BIT; end; function getresults32bit : longint; begin getresults32bit := RESULT_S32BIT; end; function getresultu8bit : byte; begin getresultu8bit := RESULT_U8BIT; end; function getresults16bit : smallint; begin getresults16bit := RESULT_S16BIT; end; function getresultreal : real; begin getresultreal := RESULT_REAL; end; var failed : boolean; s64bit : int64; s32bit : longint; s16bit : smallint; u8bit : byte; boolval : boolean; real_val : real; bigrecord1, bigrecord2 : tbigrecord; i: integer; Begin WriteLn('secondassign node testing.'); failed := false; { possibilities : left : any, right : LOC_REFERENCE, LOC_REGISTER, LOC_FPUREGISTER, LOC_CONSTANT, LOC_JUMP and LOC_FLAGS } Write('left : LOC_REFERENCE, right : LOC_CONSTANT tests..'); s64bit := RESULT_S64BIT; if s64bit <> RESULT_S64BIT then failed := true; s32bit := RESULT_S32BIT; if s32bit <> RESULT_S32BIT then failed := true; if failed then fail else WriteLn('Success!'); Write('left : LOC_REFERENCE, right : LOC_REGISTER tests..'); failed := false; s64bit := getresults64bit; if s64bit <> RESULT_S64BIT then failed := true; s32bit := getresults32bit; if s32bit <> RESULT_S32BIT then failed := true; s16bit := getresults16bit; if s16bit <> RESULT_S16BIT then failed := true; u8bit := getresultu8bit; if u8bit <> RESULT_U8BIT then failed := true; if failed then fail else WriteLn('Success!'); Write('left : LOC_REFERENCE, right : LOC_FPUREGISTER tests..'); failed := false; real_val := getresultreal; if trunc(real_val) <> trunc(RESULT_REAL) then failed := true; if failed then fail else WriteLn('Success!'); Write('left : LOC_REFERENCE, right : LOC_REFERENCE tests..'); failed := false; bigrecord1.x := RESULT_U32BIT; bigrecord1.y := RESULT_U32BIT; for i:=0 to MAX_INDEX do bigrecord1.z[i] := RESULT_U8BIT; fillchar(bigrecord2, sizeof(bigrecord2),#0); bigrecord2 := bigrecord1; if bigrecord2.x <> RESULT_U32BIT then failed := true; if bigrecord2.y <> RESULT_U32BIT then failed := true; for i:=0 to MAX_INDEX do begin if bigrecord2.z[i] <> RESULT_U8BIT then begin failed := true; break; end; end; if failed then fail else WriteLn('Success!'); Write('left : LOC_REFERENCE, right : LOC_JUMP tests (32-bit cpus only!)..'); {!!!!! This test will only work on 32-bit CPU's probably, on 64-bit CPUs the location should be in LOC_FLAGS } failed := false; s64bit := RESULT_S64BIT; boolval := s64bit = RESULT_S64BIT; if boolval = FALSE then failed := true; if failed then fail else WriteLn('Success!'); Write('left : LOC_REFERENCE, right : LOC_FLAGS tests..'); failed := false; s32bit := RESULT_S32BIT; boolval := s32bit = RESULT_S32BIT; if boolval = FALSE then failed := true; if failed then fail else WriteLn('Success!'); end. { $Log: tassign2.pp,v $ Revision 1.2 2002/09/07 15:40:49 peter * old logs removed and tabs fixed Revision 1.1 2002/08/10 08:27:43 carl + mre tests for cg testuit }