t_id
165
t_adddate
2003/10/03
t_result
0
t_knownrunerror
0
tr_id | run | tr_ok | tr_skip | tr_result |
---|---|---|---|---|
522974247 | 947783 | True | False | Successfully run |
Record count: 1
{****************************************************************} { CODE GENERATOR TEST PROGRAM } {****************************************************************} { NODE TESTED : secondcase() } {****************************************************************} { PRE-REQUISITES: secondload() } { secondassign() } { secondcalln() } {****************************************************************} { DEFINES: } {****************************************************************} { REMARKS: Tests the case statement (except jump table gen.) } {****************************************************************} program tcase; {$ifdef FPC} {$IFNDEF ver1_0} {$define int64_Test} {$endif} {$else} {$define int64_Test} {$endif} { The value is in LOC_REGISTER (operand to test) } procedure fail; begin WriteLn('Failed!'); halt(1); end; {************************************************************************} { LINEAR LIST } {************************************************************************} { low = high } procedure TestCmpListOneShort; var s: smallint; failed :boolean; begin Write('Linear Comparison list without ranges (smallint)...'); s := -12; failed := true; case s of -12 : failed := false; -10 : ; 3 : ; else end; if failed then fail else WriteLn('Passed!'); end; { low = high } procedure TestCmpListTwoShort; var s: smallint; failed :boolean; begin Write('Linear Comparison list without ranges (smallint)...'); s := 30000; failed := true; case s of -12 : ; -10 : ; 3 : ; else failed := false; end; if failed then fail else WriteLn('Passed!'); end; { low = high } procedure TestCmpListOneWord; var s: word; failed :boolean; begin Write('Linear Comparison list without ranges (word)...'); s := 12; failed := true; case s of 12 : failed := false; 10 : ; 3 : ; end; if failed then fail else WriteLn('Passed!'); end; { low = high } procedure TestCmpListTwoWord; var s: word; failed :boolean; begin Write('Linear Comparison list without ranges (word)...'); s := 30000; failed := true; case s of 0 : ; 512 : ; 3 : ; else failed := false; end; if failed then fail else WriteLn('Passed!'); end; {$IFDEF INT64_TEST} { low = high } procedure TestCmpListOneInt64; var s: int64; failed :boolean; begin Write('Linear Comparison list without ranges (int64)...'); s := 3000000; failed := true; case s of 3000000 : failed := false; 10 : ; 3 : ; end; if failed then fail else WriteLn('Passed!'); end; { low = high } procedure TestCmpListTwoInt64; var s: int64; failed :boolean; begin Write('Linear Comparison list without ranges (int64)...'); s := 30000; failed := true; case s of 0 : ; 512 : ; 3 : ; else failed := false; end; if failed then fail else WriteLn('Passed!'); end; { low = high } procedure TestCmpListThreeInt64; var s: int64; l : longint; failed :boolean; begin Write('Linear Comparison list without ranges (int64)...'); l:=3000000; s := (int64(l) shl 32); failed := true; case s of (int64(3000000) shl 32) : failed := false; 10 : ; 3 : ; end; if failed then fail else WriteLn('Passed!'); end; {$ENDIF} procedure TestCmpListRangesOneShort; var s: smallint; failed :boolean; begin Write('Linear Comparison list with ranges (smallint)...'); s := -12; failed := true; case s of -12..-8 : failed := false; -7 : ; 3 : ; else end; if failed then fail else WriteLn('Passed!'); end; procedure TestCmpListRangesTwoShort; var s: smallint; failed :boolean; begin Write('Linear Comparison list with ranges (smallint)...'); s := 30000; failed := true; case s of -12..-8 : ; -7 : ; 3 : ; else failed := false; end; if failed then fail else WriteLn('Passed!'); end; { low = high } procedure TestCmpListRangesOneWord; var s: word; failed :boolean; begin Write('Linear Comparison list with ranges (word)...'); s := 12; failed := true; case s of 12..13 : failed := false; 10 : ; 3..7 : ; end; if failed then fail else WriteLn('Passed!'); end; { low = high } procedure TestCmpListRangesTwoWord; var s: word; failed :boolean; begin Write('Linear Comparison list with ranges (word)...'); s := 30000; failed := true; case s of 0..2 : ; 3..29999 : ; else failed := false; end; if failed then fail else WriteLn('Passed!'); end; procedure TestCmpListRangesThreeWord; var s: word; failed :boolean; begin Write('Linear Comparison list with ranges (word)...'); s := 3; failed := true; case s of 12..13 : ; 10 : ; 3..7 : failed := false; end; if failed then fail else WriteLn('Passed!'); end; {$IFDEF INT64_TEST} { low = high } procedure TestCmpListRangesOneInt64; var s: int64; failed :boolean; begin Write('Linear Comparison list with ranges (int64)...'); s := 3000000; failed := true; case s of 11..3000000 : failed := false; 10 : ; 0..2 : ; end; if failed then fail else WriteLn('Passed!'); end; { low = high } procedure TestCmpListRangesTwoInt64; var s: int64; failed :boolean; begin Write('Linear Comparison list with ranges (int64)...'); s := 30000; failed := true; case s of 513..10000 : ; 512 : ; 0..3 : ; else failed := false; end; if failed then fail else WriteLn('Passed!'); end; {$ENDIF} Begin TestCmpListOneShort; TestCmpListTwoShort; TestCmpListOneWord; TestCmpListTwoWord; TestCmpListRangesOneShort; TestCmpListRangesTwoShort; TestCmpListRangesOneWord; TestCmpListRangesTwoWord; TestCmpListRangesThreeWord; {$ifdef int64_test} TestCmpListOneInt64; TestCmpListTwoInt64; TestCmpListThreeInt64; TestCmpListRangesOneInt64; TestCmpListRangesTwoInt64; {$endif} end. { $Log: tcase.pp,v $ Revision 1.4 2002/11/16 15:38:12 peter * fix int64 test Revision 1.3 2002/09/29 14:37:22 carl * must more 64-bit testing (to detect endian specific problems) Revision 1.2 2002/09/07 15:40:55 peter * old logs removed and tabs fixed Revision 1.1 2002/07/28 09:45:24 carl + case node testing }