diff --git a/tests/test/cg/taddbool.pp b/tests/test/cg/taddbool.pp index f99dfd428e..84e3c3c144 100644 --- a/tests/test/cg/taddbool.pp +++ b/tests/test/cg/taddbool.pp @@ -13,6 +13,12 @@ TYPE {$ENDIF} +procedure fail; +begin + WriteLn('Failure.'); + halt(1); +end; + { ---------------------------- BOOLEAN TEST ----------------------------- } { secondadd() } { ----------------------------------------------------------------------- } @@ -50,10 +56,10 @@ begin if result then WriteLn('Success.') else - WriteLn('Failure.'); + Fail; end else - WriteLn('Failure.'); + Fail; { WORDBOOL AND WORDBOOL } result := true; @@ -82,10 +88,10 @@ begin if result then WriteLn('Success.') else - WriteLn('Failure.'); + Fail; end else - WriteLn('Failure.'); + Fail; { LONGBOOL AND LONGBOOL } result := true; @@ -114,10 +120,10 @@ begin if result then WriteLn('Success.') else - WriteLn('Failure.'); + Fail; end else - WriteLn('Failure.'); + Fail; end; @@ -154,10 +160,10 @@ begin if result then WriteLn('Success.') else - WriteLn('Failure.'); + Fail; end else - WriteLn('Failure.'); + Fail; { WORDBOOL AND WORDBOOL } result := false; @@ -184,10 +190,10 @@ begin if result then WriteLn('Success.') else - WriteLn('Failure.'); + Fail; end else - WriteLn('Failure.'); + Fail; { LONGBOOL AND LONGBOOL } result := false; @@ -216,10 +222,10 @@ begin if result then WriteLn('Success.') else - WriteLn('Failure.'); + Fail; end else - WriteLn('Failure.'); + Fail; end; @@ -253,14 +259,14 @@ begin bb2 := true; if bb1 xor bb2 then begin - WriteLn('Failure.'); + Fail; end else begin if result then WriteLn('Success.') else - WriteLn('Failure.'); + Fail; end; { WORDBOOL XOR WORDBOOL } @@ -285,14 +291,14 @@ begin wb2 := true; if wb1 xor wb2 then begin - WriteLn('Failure.'); + Fail; end else begin if result then WriteLn('Success.') else - WriteLn('Failure.'); + Fail; end; { LONGBOOL XOR LONGBOOL } @@ -319,14 +325,14 @@ begin lb2 := true; if lb1 xor lb2 then begin - WriteLn('Failure.'); + Fail; end else begin if result then WriteLn('Success.') else - WriteLn('Failure.'); + Fail; end; end; @@ -359,10 +365,10 @@ Begin if result then WriteLn('Success.') else - WriteLn('Failure.'); + Fail; end else - WriteLn('Failure.'); + Fail; { WORDBOOL = WORDBOOL } result := true; Write('wordbool = wordbool test...'); @@ -383,10 +389,10 @@ Begin if result then WriteLn('Success.') else - WriteLn('Failure.'); + Fail; end else - WriteLn('Failure.'); + Fail; Write('wordbool conversion to boolean...'); result := TRUE; move(values,lb1,sizeof(lb1)); @@ -395,7 +401,7 @@ Begin if result then WriteLn('Success.') else - WriteLn('Failure.'); + Fail; { LONGBOOL = LONGBOOL } result := true; Write('longbool = longbool test...'); @@ -416,10 +422,10 @@ Begin if result then WriteLn('Success.') else - WriteLn('Failure.'); + Fail; end else - WriteLn('Failure.'); + Fail; Write('longbool conversion to boolean...'); result := TRUE; move(values,lb1,sizeof(lb1)); @@ -428,7 +434,7 @@ Begin if result then WriteLn('Success.') else - WriteLn('Failure.'); + Fail; end; @@ -458,14 +464,14 @@ Begin bb2 := false; if bb1 <> bb2 then begin - WriteLn('Failure.'); + Fail; end else begin if result then WriteLn('Success.') else - WriteLn('Failure.'); + Fail; end; { WORDBOOL <> WORDBOOL } result := true; @@ -486,14 +492,14 @@ Begin wb2 := false; if wb1 <> wb2 then begin - WriteLn('Failure.'); + Fail; end else begin if result then WriteLn('Success.') else - WriteLn('Failure.'); + Fail; end; { LONGBOOL <> LONGBOOL } result := true; @@ -514,14 +520,14 @@ Begin lb2 := false; if lb1 <> lb2 then begin - WriteLn('Failure.'); + Fail; end else begin if result then WriteLn('Success.') else - WriteLn('Failure.'); + Fail; end; end; @@ -563,7 +569,10 @@ end. { $Log$ - Revision 1.2 2001-07-27 02:55:35 carl + Revision 1.3 2002-03-05 21:54:52 carl + * Adapted for automated testing + + Revision 1.2 2001/07/27 02:55:35 carl + more complex testing Revision 1.1 2001/05/19 11:51:50 peter diff --git a/tests/test/cg/taddcard.pp b/tests/test/cg/taddcard.pp index a99dac6000..41b603b009 100644 --- a/tests/test/cg/taddcard.pp +++ b/tests/test/cg/taddcard.pp @@ -8,6 +8,11 @@ type cardinal = longint; {$endif} +procedure fail; +begin + Fail; + halt(1); +end; procedure CardinalTestAdd; @@ -36,7 +41,7 @@ begin if i <> 30000 then result := false; if not result then - WriteLn('Failure.') + Fail else WriteLn('Success.'); end; @@ -65,7 +70,7 @@ begin if i <> 800 then result := false; if not result then - WriteLn('Failure.') + Fail else WriteLn('Success.'); end; @@ -112,7 +117,7 @@ begin if i <> 10000000 then result := false; if not result then - WriteLn('Failure.') + Fail else WriteLn('Success.'); end; @@ -141,7 +146,7 @@ begin if i <> $FFFFFFFF then result := false; if not result then - WriteLn('Failure.') + Fail else WriteLn('Success.'); end; @@ -171,7 +176,7 @@ Begin if i <> $FFFFFFFF then result := false; if not result then - WriteLn('Failure.') + Fail else WriteLn('Success.'); end; @@ -212,7 +217,7 @@ Begin if i <> 0 then result := false; if not result then - WriteLn('Failure.') + Fail else WriteLn('Success.'); end; @@ -233,7 +238,7 @@ Begin if j = i then result := false; if not result then - WriteLn('Failure.') + Fail else WriteLn('Success.'); end; @@ -255,7 +260,7 @@ Begin if j <> i then result := false; if not result then - WriteLn('Failure.') + Fail else WriteLn('Success.'); end; @@ -285,10 +290,10 @@ begin if result then WriteLn('Success.') else - WriteLn('Failure.'); + Fail; end else - WriteLn('Failure.'); + Fail; {$endif} end; @@ -319,10 +324,10 @@ begin if result then WriteLn('Success.') else - WriteLn('Failure.'); + Fail; end else - WriteLn('Failure.'); + Fail; {$endif} end; diff --git a/tests/test/cg/taddlong.pp b/tests/test/cg/taddlong.pp index 186b546bed..eea1ae9f4c 100644 --- a/tests/test/cg/taddlong.pp +++ b/tests/test/cg/taddlong.pp @@ -5,6 +5,11 @@ { - if statements function correctly. } { - subroutine calls function correctly. } +procedure fail; +begin + Fail; + halt(1); +end; procedure LongintTestAdd; @@ -33,7 +38,7 @@ begin if i <> 30000 then result := false; if not result then - WriteLn('Failure.') + Fail else WriteLn('Success.'); end; @@ -62,7 +67,7 @@ begin if i <> 800 then result := false; if not result then - WriteLn('Failure.') + Fail else WriteLn('Success.'); end; @@ -104,7 +109,7 @@ begin if i <> 256000 then result := false; if not result then - WriteLn('Failure.') + Fail else WriteLn('Success.'); end; @@ -133,7 +138,7 @@ begin if i <> $FFFFFFFF then result := false; if not result then - WriteLn('Failure.') + Fail else WriteLn('Success.'); end; @@ -163,7 +168,7 @@ Begin if i <> $FFFFFFFF then result := false; if not result then - WriteLn('Failure.') + Fail else WriteLn('Success.'); end; @@ -204,7 +209,7 @@ Begin if i <> 0 then result := false; if not result then - WriteLn('Failure.') + Fail else WriteLn('Success.'); end; @@ -225,7 +230,7 @@ Begin if j = i then result := false; if not result then - WriteLn('Failure.') + Fail else WriteLn('Success.'); end; @@ -247,7 +252,7 @@ Begin if j <> i then result := false; if not result then - WriteLn('Failure.') + Fail else WriteLn('Success.'); end; @@ -276,10 +281,10 @@ begin if result then WriteLn('Success.') else - WriteLn('Failure.'); + Fail; end else - WriteLn('Failure.'); + Fail; end; @@ -308,10 +313,10 @@ begin if result then WriteLn('Success.') else - WriteLn('Failure.'); + Fail; end else - WriteLn('Failure.'); + Fail; end; diff --git a/tests/test/cg/taddreal.pp b/tests/test/cg/taddreal.pp index 250aa1eeeb..54ed15d19c 100644 --- a/tests/test/cg/taddreal.pp +++ b/tests/test/cg/taddreal.pp @@ -24,6 +24,12 @@ { LOC_FPU } { LOC_REFERENCE / LOC_MEM } {$E+} +procedure fail; +begin + Fail; + halt(1); +end; + Procedure RealTestSub; var @@ -48,7 +54,7 @@ result := false; WriteLn('Result (0.0) :',j); if not result then - WriteLn('Failure.') + Fail else WriteLn('Success.'); end; @@ -73,7 +79,7 @@ result := false; WriteLn('Result (212.5) :',i); if not result then - WriteLn('Failure.') + Fail else WriteLn('Success.'); end; @@ -100,7 +106,7 @@ result := false; WriteLn('Result (-1200.0) :',i); if not result then - WriteLn('Failure.') + Fail else WriteLn('Success.'); end; @@ -130,7 +136,7 @@ result := false; WriteLn('Result (-0.1001) :',j); if not result then - WriteLn('Failure.') + Fail else WriteLn('Success.'); end; @@ -166,7 +172,7 @@ if not (trunc(i) = trunc(1000.0)) then result := false; if not result then - WriteLn('Failure.') + Fail else WriteLn('Success.'); end; @@ -186,7 +192,7 @@ if (trunc(i) <> trunc(1000.0)) then result := false; if not result then - WriteLn('Failure.') + Fail else WriteLn('Success.'); end; @@ -213,7 +219,7 @@ if trunc(i) < trunc(999.0) then result := false; if not result then - WriteLn('Failure.') + Fail else WriteLn('Success.'); end; @@ -239,7 +245,7 @@ if trunc(i) > trunc(999.0) then result := false; if not result then - WriteLn('Failure.') + Fail else WriteLn('Success.'); end; @@ -260,7 +266,10 @@ end. { $Log$ - Revision 1.3 2001-07-31 01:55:23 carl + Revision 1.4 2002-03-05 21:55:11 carl + * Adapted for automated testing + + Revision 1.3 2001/07/31 01:55:23 carl * corrected comparing value for real Revision 1.2 2001/06/12 01:12:34 carl diff --git a/tests/test/cg/taddset.pp b/tests/test/cg/taddset.pp index 43a9193b8f..101f77010c 100644 --- a/tests/test/cg/taddset.pp +++ b/tests/test/cg/taddset.pp @@ -126,6 +126,7 @@ const else begin WriteLn('Failure.'); + Halt(1); Err:=true; end; end; @@ -639,7 +640,10 @@ end. { $Log$ - Revision 1.4 2001-10-20 17:26:13 peter + Revision 1.5 2002-03-05 21:55:11 carl + * Adapted for automated testing + + Revision 1.4 2001/10/20 17:26:13 peter * several fixes to run also with kylix Revision 1.3 2001/06/24 22:30:19 carl diff --git a/tests/test/cg/tadint64.pp b/tests/test/cg/tadint64.pp index 34cb6ef056..da2ecc725e 100644 --- a/tests/test/cg/tadint64.pp +++ b/tests/test/cg/tadint64.pp @@ -5,6 +5,11 @@ { - if statements function correctly. } { - subroutine calls function correctly. } +procedure fail; +begin + Fail; + halt(1); +end; procedure int64TestAdd; @@ -33,7 +38,7 @@ begin if i <> 30000 then result := false; if not result then - WriteLn('Failure.') + Fail else WriteLn('Success.'); end; @@ -62,7 +67,7 @@ begin if i <> 800 then result := false; if not result then - WriteLn('Failure.') + Fail else WriteLn('Success.'); end; @@ -104,7 +109,7 @@ begin if i <> 256000 then result := false; if not result then - WriteLn('Failure.') + Fail else WriteLn('Success.'); end; @@ -133,7 +138,7 @@ begin if i <> $FFFFFFFF then result := false; if not result then - WriteLn('Failure.') + Fail else WriteLn('Success.'); end; @@ -163,7 +168,7 @@ Begin if i <> $FFFFFFFF then result := false; if not result then - WriteLn('Failure.') + Fail else WriteLn('Success.'); end; @@ -204,7 +209,7 @@ Begin if i <> 0 then result := false; if not result then - WriteLn('Failure.') + Fail else WriteLn('Success.'); end; @@ -225,7 +230,7 @@ Begin if j = i then result := false; if not result then - WriteLn('Failure.') + Fail else WriteLn('Success.'); end; @@ -247,7 +252,7 @@ Begin if j <> i then result := false; if not result then - WriteLn('Failure.') + Fail else WriteLn('Success.'); end; @@ -276,10 +281,10 @@ begin if result then WriteLn('Success.') else - WriteLn('Failure.'); + Fail; end else - WriteLn('Failure.'); + Fail; end; @@ -308,10 +313,10 @@ begin if result then WriteLn('Success.') else - WriteLn('Failure.'); + Fail; end else - WriteLn('Failure.'); + Fail; end; @@ -334,7 +339,10 @@ end. { $Log$ - Revision 1.2 2001-06-24 23:58:14 carl + Revision 1.3 2002-03-05 21:55:11 carl + * Adapted for automated testing + + Revision 1.2 2001/06/24 23:58:14 carl * fixed problem with log } \ No newline at end of file diff --git a/tests/test/cg/tcnvset.pp b/tests/test/cg/tcnvset.pp index 6d25b77399..a181d728cc 100644 --- a/tests/test/cg/tcnvset.pp +++ b/tests/test/cg/tcnvset.pp @@ -71,6 +71,13 @@ type type tnormalset = set of tbigenum; tsmallset = set of tsmallenum; + +procedure fail; +begin + Fail; + halt(1); +end; + procedure SmallSet2NormalSet; @@ -95,7 +102,7 @@ type if op2 <> [A_BCS,A_MOVE] then passed := false; if not passed then - WriteLn('Failure,') + Fail else WriteLn('Success.'); end; @@ -108,7 +115,10 @@ end. { $Log$ - Revision 1.1 2001-06-24 23:01:22 carl + Revision 1.2 2002-03-05 21:55:42 carl + * Adapted for automated testing + + Revision 1.1 2001/06/24 23:01:22 carl + completed small set -. normal set conversion tests diff --git a/tests/test/cg/tderef.pp b/tests/test/cg/tderef.pp index a61ce1ce3a..fda143ed5a 100644 --- a/tests/test/cg/tderef.pp +++ b/tests/test/cg/tderef.pp @@ -22,6 +22,11 @@ type pbyte = ^byte; +procedure fail; +begin + Fail; + halt(1); +end; var @@ -53,12 +58,15 @@ Begin if passed then WriteLn('Success.') else - WriteLn('Failure.'); + Fail; end. { $Log$ - Revision 1.1 2001-06-30 02:02:06 carl + Revision 1.2 2002-03-05 21:56:02 carl + * Adapted for automated testing + + Revision 1.1 2001/06/30 02:02:06 carl + secondderef() } \ No newline at end of file diff --git a/tests/test/cg/tin.pp b/tests/test/cg/tin.pp index 9624067452..45347c38c2 100644 --- a/tests/test/cg/tin.pp +++ b/tests/test/cg/tin.pp @@ -73,6 +73,18 @@ type type tnormalset = set of tbigenum; tsmallset = set of tsmallenum; + + + procedure checkpassed(passed : boolean); + begin + if passed then + WriteLn('Passed!') + else + begin + WriteLn('Failure.'); + Halt(1); + end; + end; { The following cases are possible } { jump table usage } @@ -124,10 +136,7 @@ type op3 := [DF]; if not (DB in (op2+op3)) then passed := false; - if passed then - WriteLn('Success.') - else - WriteLn('Failure.'); + checkpassed(passed); end; @@ -165,10 +174,7 @@ type passed := false; { LEFT : LOC_REGISTER } { RIGHT : range constant set (carry flag) } - if passed then - WriteLn('Success.') - else - WriteLn('Failure.'); + checkpassed(passed); end; { returns result in register } @@ -207,10 +213,7 @@ type if not (A_MOVE in op1) then passed := false; - if passed then - WriteLn('Success.') - else - WriteLn('Failure.'); + checkpassed(passed); end; @@ -241,10 +244,7 @@ type if not (getop in [A_BFSET,A_MOVE,A_ASL..A_BCC]) then passed := false; - if passed then - WriteLn('Success.') - else - WriteLn('Failure.'); + checkpassed(passed); end; @@ -258,7 +258,10 @@ end. { $Log$ - Revision 1.1 2001-06-25 01:34:03 carl + Revision 1.2 2002-03-05 21:56:02 carl + * Adapted for automated testing + + Revision 1.1 2001/06/25 01:34:03 carl + secondin() node testing diff --git a/tests/test/cg/tmoddiv.pp b/tests/test/cg/tmoddiv.pp index 0f025ebc51..714461effe 100644 --- a/tests/test/cg/tmoddiv.pp +++ b/tests/test/cg/tmoddiv.pp @@ -44,6 +44,17 @@ function getint64cnt: int64; end; {$ENDIF} + +procedure test(value, required: longint); +begin + if value <> required then + begin + writeln('Got ',value,' instead of ',required); + halt(1); + end + else + writeln('Passed!'); +end; var longres : longint; @@ -63,20 +74,14 @@ begin longres := 24; longres := longres div 4; Write('Value should be 6...'); - if longres = 6 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(longres, 6); { RIGHT : power of 2 ordconstn } { LEFT : LOC_REFERENCE } longres := 24; longres := longres mod 4; Write('Value should be 0...'); - if longres = 0 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(longres, 0); WriteLn('(left) : LOC_REFERENCE; (right) : LOC_REFERENCE'); @@ -86,10 +91,7 @@ begin longcnt := -13; longres := longres div longcnt; Write('Value should be -10...'); - if longres = -10 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(longres, -10); { RIGHT : LOC_REFERENCE } { LEFT : LOC_REFERENCE } @@ -97,10 +99,7 @@ begin longcnt := -13; longres := longres mod longcnt; Write('Value should be 10...'); - if longres = 10 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(longres, 10); WriteLn('(left) : LOC_REFERENCE; (right) : LOC_REGISTER'); { RIGHT : LOC_REGISTER } @@ -108,40 +107,28 @@ begin longres := -11111111; longres := longres div getlongcnt; Write('Value should be 1111111...'); - if longres = 1111111 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(longres, 1111111); { RIGHT : LOC_REGISTER } { LEFT : LOC_REFERENCE } longres := -1111111; longres := longres mod getlongcnt; Write('Value should be -1...'); - if longres = -1 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(longres, -1); { RIGHT : LOC_REFERENCE } { LEFT : LOC_REGISTER } longcnt := 2; longres := getlongcnt div longcnt; Write('Value should be -5...'); - if longres = -5 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(longres, -5); { RIGHT : LOC_REFERENCE } { LEFT : LOC_REGISTER } longcnt := 3; longres := getlongcnt mod longcnt; Write('Value should be -1...'); - if longres = -1 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(longres, -1); { special tests for results } Writeln('special numeric values tests...'); @@ -149,30 +136,21 @@ begin longcnt := $80000000; longres := longres div longcnt; Write('Value should be 0...'); - if longres = 0 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(longres, 0); Writeln('special numeric values tests...'); longres := $7FFFFFFF; longcnt := $80000000; longres := longcnt div longres; Write('Value should be -1...'); - if longres = -1 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(longres, -1); Writeln('special numeric values tests...'); cardinalcnt := $80000; cardinalres := $12345; cardinalres := cardinalcnt div cardinalres; Write('Value should be 7...'); - if cardinalres = 7 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(cardinalres, 7); {$IFDEF FPC} WriteLn('------------------- CARDINAL -----------------------'); @@ -182,30 +160,20 @@ begin cardinalcnt := $80000000; cardinalres := cardinalres div cardinalcnt; Write('Value should be 0...'); - if cardinalres = 0 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(cardinalres, 0); Writeln('special numeric values tests...'); cardinalres := $7FFFFFFF; cardinalcnt := $80000000; cardinalres := cardinalcnt div cardinalres; Write('Value should be 1...'); - if cardinalres = 1 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(cardinalres, 1); Writeln('special numeric values tests...'); cardinalcnt := $80000; cardinalres := $12345; cardinalres := cardinalcnt div cardinalres; - Write('Value should be 7...'); - if cardinalres = 7 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(cardinalres, 7); WriteLn('(left) : LOC_REFERENCE; (right) : ordinal constant'); { RIGHT : power of 2 ordconstn } @@ -213,20 +181,14 @@ begin cardinalres := 24; cardinalres := cardinalres div 4; Write('Value should be 6...'); - if cardinalres = 6 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(cardinalres, 6); { RIGHT : power of 2 ordconstn } { LEFT : LOC_REFERENCE } cardinalres := 24; cardinalres := cardinalres mod 4; Write('Value should be 0...'); - if cardinalres = 0 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(cardinalres, 0); WriteLn('(left) : LOC_REFERENCE; (right) : LOC_REFERENCE'); @@ -236,10 +198,7 @@ begin cardinalcnt := 13; cardinalres := cardinalres div cardinalcnt; Write('Value should be 10...'); - if cardinalres = 10 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(cardinalres, 10); { RIGHT : LOC_REFERENCE } { LEFT : LOC_REFERENCE } @@ -247,10 +206,7 @@ begin cardinalcnt := 13; cardinalres := cardinalres mod cardinalcnt; Write('Value should be 10...'); - if cardinalres = 10 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(cardinalres, 10); WriteLn('(left) : LOC_REFERENCE; (right) : LOC_REGISTER'); { RIGHT : LOC_REGISTER } @@ -258,40 +214,28 @@ begin cardinalres := 11111111; cardinalres := cardinalres div getcardinalcnt; Write('Value should be 1111111...'); - if cardinalres = 1111111 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(cardinalres, 1111111); { RIGHT : LOC_REGISTER } { LEFT : LOC_REFERENCE } cardinalres := 1111111; cardinalres := cardinalres mod getcardinalcnt; Write('Value should be 1...'); - if cardinalres = 1 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(cardinalres, 1); { RIGHT : LOC_REFERENCE } { LEFT : LOC_REGISTER } cardinalcnt := 2; cardinalres := getcardinalcnt div cardinalcnt; Write('Value should be 5...'); - if cardinalres = 5 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(cardinalres, 5); { RIGHT : LOC_REFERENCE } { LEFT : LOC_REGISTER } cardinalcnt := 3; cardinalres := getcardinalcnt mod cardinalcnt; Write('Value should be 1...'); - if cardinalres = 1 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(cardinalres, 1); WriteLn('--------------------- INT64 ------------------------'); { special tests for results } @@ -300,39 +244,27 @@ begin int64cnt := $80000000 shl 32; int64res := int64res div int64cnt; Write('Value should be 0...'); - if int64res = 0 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(int64res and $FFFFFFFF, 0); Writeln('special numeric values tests...'); int64res := $7FFFFFFF shl 32; int64cnt := $80000000 shl 32; int64res := int64cnt div int64res; Write('Value should be -1...'); - if int64res = -1 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(int64res and $FFFFFFFF, -1); int64res := $7FFFFFFF; int64cnt := $80000000; int64res := int64res div int64cnt; Write('Value should be 0...'); - if int64res = 0 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(int64res and $FFFFFFFF, 0); Writeln('special numeric values tests...'); int64res := $7FFFFFFF; int64cnt := $80000000; int64res := int64cnt div int64res; Write('Value should be -1...'); - if int64res = -1 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(int64res and $FFFFFFFF, -1); WriteLn('(left) : LOC_REFERENCE; (right) : ordinal constant'); { RIGHT : power of 2 ordconstn } @@ -340,20 +272,14 @@ begin int64res := 24; int64res := int64res div 4; Write('Value should be 6...'); - if int64res = 6 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(int64res and $FFFFFFFF, 6); { RIGHT : power of 2 ordconstn } { LEFT : LOC_REFERENCE } int64res := 24; int64res := int64res mod 4; Write('Value should be 0...'); - if int64res = 0 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(int64res and $FFFFFFFF, 0); WriteLn('(left) : LOC_REFERENCE; (right) : LOC_REFERENCE'); @@ -363,10 +289,7 @@ begin int64cnt := -13; int64res := int64res div int64cnt; Write('Value should be -10...'); - if int64res = -10 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(int64res and $FFFFFFFF, -10); { RIGHT : LOC_REFERENCE } { LEFT : LOC_REFERENCE } @@ -374,10 +297,7 @@ begin int64cnt := -13; int64res := int64res mod int64cnt; Write('Value should be 10...'); - if int64res = 10 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(int64res and $FFFFFFFF, 10); WriteLn('(left) : LOC_REFERENCE; (right) : LOC_REGISTER'); { RIGHT : LOC_REGISTER } @@ -385,40 +305,28 @@ begin int64res := -11111111; int64res := int64res div getint64cnt; Write('Value should be 1111111...'); - if int64res = 1111111 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(int64res and $FFFFFFFF, 1111111); { RIGHT : LOC_REGISTER } { LEFT : LOC_REFERENCE } int64res := -1111111; int64res := int64res mod getint64cnt; Write('Value should be -1...'); - if int64res = -1 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(int64res and $FFFFFFFF, -1); { RIGHT : LOC_REFERENCE } { LEFT : LOC_REGISTER } int64cnt := 2; int64res := getint64cnt div int64cnt; Write('Value should be -5...'); - if int64res = -5 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(int64res and $FFFFFFFF, -5); { RIGHT : LOC_REFERENCE } { LEFT : LOC_REGISTER } int64cnt := 3; int64res := getint64cnt mod int64cnt; Write('Value should be -1...'); - if int64res = -1 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(int64res and $FFFFFFFF, -1); {$ENDIF} end. \ No newline at end of file diff --git a/tests/test/cg/tneg.pp b/tests/test/cg/tneg.pp index 9f81849b17..f291517962 100644 --- a/tests/test/cg/tneg.pp +++ b/tests/test/cg/tneg.pp @@ -30,6 +30,23 @@ Program tneg; { - LOC_FPU } {----------------------------------------------------} +procedure test(value, required: longint); +begin + if value <> required then + begin + writeln('Got ',value,' instead of ',required); + halt(1); + end + else + writeln('Passed!'); +end; + +procedure fail; + begin + writeln('Failure.'); + halt(1); + end; + function getreal: real; begin @@ -50,20 +67,14 @@ Begin longval := 1; longval := - longval; Write('Value should be -1...'); - if longval = -1 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(longval, -1); { CURRENT NODE : REGISTER } { LEFT NODE: REGISTER } byteval := 2; longval := - byteval; Write('Value should be -2...'); - if longval = -2 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(longval, -2); { CURRENT NODE: LOC_FPU } { LEFT NODE : LOC_REFERENCE } @@ -71,9 +82,9 @@ Begin realval := - realval; Write('Value should 1.0...'); if realval - 1.0 = 0.0 then - WriteLn('Success.') + WriteLn('Passed!') else - WriteLn('Failure'); + Fail; { LEFT NODE : LOC_FPU } { CURRENT NODE : LOC_FPU } @@ -81,9 +92,9 @@ Begin realval := -(getreal*(realval)); Write('Value should 1.0...'); if realval - 1.0 = 0.0 then - WriteLn('Success.') + WriteLn('Passed!') else - WriteLn('Failure'); + Fail; {$IFDEF FPC} WriteLn('------------------------------ INT64 --------------------------------'); @@ -92,20 +103,14 @@ Begin int64val := 1; int64val := - int64val; Write('Value should be -1...'); - if int64val = -1 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(int64val and $FFFFFFFF, -1); { CURRENT NODE : REGISTER } { LEFT NODE: REGISTER } byteval := 2; int64val := - byteval; Write('Value should be -2...'); - if int64val = -2 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(int64val and $FFFFFFFF, -2); {$ENDIF} end. diff --git a/tests/test/cg/tnot.pp b/tests/test/cg/tnot.pp index c6b0404c8c..690ab8f360 100644 --- a/tests/test/cg/tnot.pp +++ b/tests/test/cg/tnot.pp @@ -46,6 +46,18 @@ begin getbyteboolval := TRUE; end; +procedure test(value, required: longint); +begin + if value <> required then + begin + writeln('Got ',value,' instead of ',required); + halt(1); + end + else + writeln('Passed!'); +end; + + var longres : longint; @@ -67,20 +79,15 @@ Begin longres := $7F7F7F7F; longres := not longres; Write('Value should be $80808080...'); - if longres = $80808080 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(longres,$80808080); { CURRENT NODE : REGISTER } { LEFT NODE : REGISTER } WriteLn('(current) : LOC_REGISTER; (left) : LOC_REGISTER'); longres := not getintres; Write('Value should be $8080...'); - if longres = $FFFF8080 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(longres, $FFFF8080); + WriteLn('----------------------------- BOOLEAN -----------------------------------'); { CURRENT NODE : LOC_REGISTER } @@ -89,36 +96,24 @@ Begin byteboolval := TRUE; byteboolres := not byteboolval; Write('Value should be FALSE...'); - if byteboolres = FALSE then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(ord(byteboolres),0); wordboolval := TRUE; wordboolres := not wordboolval; Write('Value should be FALSE...'); - if wordboolres = FALSE then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(longint(wordboolres),0); longboolval := TRUE; longboolres := not longboolval; Write('Value should be FALSE...'); - if longboolres = FALSE then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(longint(longboolres),0); { CURRENT NODE : LOC_REGISTER } { LEFT NODE : LOC_REGISTER } WriteLn('(current) : LOC_REGISTER; (left) : LOC_REGISTER'); longboolres := not getbyteboolval; Write('Value should be FALSE...'); - if longboolres = FALSE then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(longint(longboolres),0); { CURRENT NODE : LOC_FLAGS } { LEFT NODE : LOC_FLAGS } @@ -127,10 +122,7 @@ Begin byteboolres := TRUE; byteboolres:= not ((intres = 1)); Write('Value should be FALSE...'); - if byteboolres = FALSE then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(ord(byteboolres),0); { !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! } { CURRENT_NODE : LOC_JUMP } @@ -148,20 +140,14 @@ Begin int64res := $7F7F7F7F; int64res := not int64res; Write('Value should be $80808080...'); - if int64res = $80808080 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(int64res and $FFFFFFFF,$80808080); { CURRENT NODE : REGISTER } { LEFT NODE : REGISTER } WriteLn('(current) : LOC_REGISTER; (left) : LOC_REGISTER'); int64res := not (word(getintres)); Write('Value should be $8080...'); - if int64res = $00008080 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(int64res and $FFFFFFFF,$00008080); {$ENDIF} end. diff --git a/tests/test/cg/tshlshr.pp b/tests/test/cg/tshlshr.pp index 52544ec31e..d3319fb638 100644 --- a/tests/test/cg/tshlshr.pp +++ b/tests/test/cg/tshlshr.pp @@ -28,6 +28,16 @@ Program tshlshr; { - LOC_REFERENCE / LOC_MEM } { - LOC_REGISTER } {----------------------------------------------------} +procedure test(value, required: longint); +begin + if value <> required then + begin + writeln('Got ',value,' instead of ',required); + halt(1); + end + else + writeln('Passed!'); +end; var @@ -47,48 +57,32 @@ Begin longres:=1; longres := longres shl 15; Write('(SHL) Value should be 32768...'); - if longres = 32768 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(longres, 32768); + longres:=-1; longres := longres shl 15; Write('(SHL) Value should be -32768...'); - if longres = -32768 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(longres, -32768); + longres:=1; longres := longres shl 33; Write('(SHL) Value should be 2...'); - if longres = 2 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(longres, 2); longres:=$8000; longres := longres shr 15; Write('(SHR) Value should be 1...'); - if longres = 1 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(longres, 1); longres:=-1; longres := longres shr 15; Write('(SHR) Value should be 131071...'); - if longres = 131071 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(longres, 131071); longres:=$FFFF; longres := longres shr 33; Write('(SHR) Value should be 32767...'); - if longres = 32767 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(longres, 32767); { left : LOC_REFERENCE } { right : LOC_REFERENCE } @@ -98,54 +92,37 @@ Begin longcnt := -2; longres:=longres shl longcnt ; Write('(SHL) Value should be 1073741824...'); - if longres = 1073741824 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(longres, 1073741824); longres:=1; longcnt:=15; longres := longres shl longcnt; Write('(SHL) Value should be 32768...'); - if longres = 32768 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(longres, 32768); longres:=-1; longcnt := 15; longres := longres shl longcnt; Write('(SHL) Value should be -32768...'); - if longres = -32768 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(longres, -32768); longres := 1; longcnt := -2; longres:=longres shr longcnt ; Write('(SHR) Value should be 0...'); - if longres = 0 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(longres, 0); longres:=32768; longcnt:=15; longres := longres shr longcnt; Write('(SHR) Value should be 1...'); - if longres = 1 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(longres, 1); + longres:=-1; longcnt := 15; longres := longres shl longcnt; Write('(SHR) Value should be -32768...'); - if longres = -32768 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(longres, -32768); { left : LOC_REFERENCE } { right : LOC_REGISRER } @@ -154,75 +131,51 @@ Begin bytecnt := -2; longres:=longres shl bytecnt ; Write('(SHL) Value should be 1073741824...'); - if longres = 1073741824 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(longres, 1073741824); longres:=1; bytecnt:=15; longres := longres shl bytecnt; Write('(SHL) Value should be 32768...'); - if longres = 32768 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(longres, 32768); longres:=-1; bytecnt := 15; longres := longres shl bytecnt; Write('(SHL) Value should be -32768...'); - if longres = -32768 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(longres, -32768); longres := 1; bytecnt := -2; longres:=longres shr bytecnt ; Write('(SHR) Value should be 0...'); - if longres = 0 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(longres, 0); longres:=32768; bytecnt:=15; longres := longres shr bytecnt; Write('(SHR) Value should be 1...'); - if longres = 1 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(longres, 1); longres:=-1; bytecnt := 15; longres := longres shr bytecnt; Write('(SHR) Value should be 131071...'); - if longres = 131071 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(longres, 131071); WriteLn('(left) : LOC_REGISTER; (right) : LOC_REGISTER'); byteres := 1; bytecnt := 2; byteres := byteres shl bytecnt; Write('(SHL) Value should be 4...'); - if longres = 4 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(byteres, 4); byteres := 4; bytecnt := 2; byteres := byteres shr bytecnt; Write('(SHR) Value should be 1...'); - if longres = 1 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(byteres, 1); {$IFDEF FPC} WriteLn('------------------------------ INT64 --------------------------------'); @@ -232,35 +185,23 @@ Begin int64res:=1; int64res := int64res shl 15; Write('(SHL) Value should be 32768...'); - if int64res = 32768 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(int64res and $FFFFFFFF, 32768); int64res:=-1; int64res := int64res shl 15; Write('(SHL) Value should be -32768...'); - if int64res = -32768 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(int64res and $FFFFFFFF, -32768); int64res:=1; int64res := int64res shl 65; Write('(SHL) Value should be 2...'); - if int64res = 2 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(int64res and $FFFFFFFF, 2); int64res:=$8000; int64res := int64res shr 15; Write('(SHR) Value should be 1...'); - if int64res = 1 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(int64res and $FFFFFFFF, 1); { int64res:=-1; int64res := int64res shr 15; @@ -268,10 +209,7 @@ Begin int64res:=$FFFF; int64res := int64res shr 65; Write('(SHR) Value should be 0...'); - if int64res = 0 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(int64res and $FFFFFFFF, 0); { left : LOC_REFERENCE } { right : LOC_REFERENCE } @@ -280,57 +218,39 @@ Begin int64cnt := -2; int64res:=int64res shl int64cnt ; Write('(SHL) Value should be 1073741824...'); - if int64res = 1073741824 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(int64res and $FFFFFFFF, 1073741824); int64res:=1; int64cnt:=15; int64res := int64res shl int64cnt; Write('(SHL) Value should be 32768...'); - if int64res = 32768 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(int64res and $FFFFFFFF, 32768); int64res:=-1; int64cnt := 15; int64res := int64res shl int64cnt; Write('(SHL) Value should be -32768...'); - if int64res = -32768 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(int64res and $FFFFFFFF, -32768); int64res := 1; int64cnt := -2; int64res:=int64res shr int64cnt ; Write('(SHR) Value should be 0...'); - if int64res = 0 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(int64res and $FFFFFFFF, 0); int64res:=32768; int64cnt:=15; int64res := int64res shr int64cnt; Write('(SHR) Value should be 1...'); - if int64res = 1 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(int64res and $FFFFFFFF, 1); int64res:=-1; int64cnt := 15; int64res := int64res shl int64cnt; Write('(SHR) Value should be -32768...'); - if int64res = -32768 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(int64res and $FFFFFFFF, -32768); { left : LOC_REFERENCE } { right : LOC_REGISRER } @@ -339,50 +259,35 @@ Begin bytecnt := -2; int64res:=int64res shl bytecnt ; Write('(SHL) Value should be 1073741824...'); - if int64res = 1073741824 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(int64res and $FFFFFFFF, 1073741824); int64res:=1; bytecnt:=15; int64res := int64res shl bytecnt; Write('(SHL) Value should be 32768...'); - if int64res = 32768 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(int64res and $FFFFFFFF, 32768); int64res:=-1; bytecnt := 15; int64res := int64res shl bytecnt; Write('(SHL) Value should be -32768...'); - if int64res = -32768 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(int64res and $FFFFFFFF, -32768); int64res := 1; bytecnt := -2; int64res:=int64res shr bytecnt ; Write('(SHR) Value should be 0...'); - if int64res = 0 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(int64res and $FFFFFFFF, 0); int64res:=32768; bytecnt:=15; int64res := int64res shr bytecnt; Write('(SHR) Value should be 1...'); - if int64res = 1 then - WriteLn('Success.') - else - WriteLn('Failure.'); + test(int64res and $FFFFFFFF, 1); { int64res:=-1; bytecnt := 15; int64res := int64res shr bytecnt; @@ -391,3 +296,9 @@ Begin {$ENDIF} end. +{ + $Log$ + Revision 1.3 2002-03-05 21:56:32 carl + * Adapted for automated testing + +} \ No newline at end of file diff --git a/tests/test/cg/tvec.pp b/tests/test/cg/tvec.pp index dc9c11e757..ba76d0de05 100644 --- a/tests/test/cg/tvec.pp +++ b/tests/test/cg/tvec.pp @@ -90,6 +90,22 @@ var globalindex : longint; globalansi : ansistring; globalboolarray : boolarray; + + + procedure checkpassed(passed: boolean); + begin + if passed then + begin + writeln('Passed!'); + end + else + begin + writeln('Failure.'); + halt(1); + end; + end; + + { this routine clears all arrays } { without calling secondvecn() first } @@ -220,10 +236,7 @@ var end; - if passed then - WriteLn('Success.') - else - WriteLn('Failure.'); + checkpassed(passed); end; @@ -341,10 +354,7 @@ var passed := false; end; - if passed then - WriteLn('Success.') - else - WriteLn('Failure.'); + checkpassed(passed); @@ -388,10 +398,7 @@ var passed := false; end; } - if passed then - WriteLn('Success.') - else - WriteLn('Failure.'); + checkpassed(passed); end; @@ -421,7 +428,10 @@ end. { $Log$ - Revision 1.3 2001-06-30 02:16:28 carl + Revision 1.4 2002-03-05 21:56:44 carl + * Adapted for automated testing + + Revision 1.3 2001/06/30 02:16:28 carl - reduced sizes of arrays to make it work under m68k Revision 1.2 2001/06/30 00:48:37 carl