paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-21 01:09:31 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Adapted for automated testing

Browse Source
This commit is contained in:
carl 2002-03-05 21:54:52 +00:00
parent 63d446bb87
commit 312902b36a
14 changed files with 332 additions and 451 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

75
tests/test/cg/taddbool.pp
View File

@ -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

29
tests/test/cg/taddcard.pp
View File

@ -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;

29
tests/test/cg/taddlong.pp
View File

@ -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;

27
tests/test/cg/taddreal.pp
View File

@ -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

6
tests/test/cg/taddset.pp
View File

@ -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

34
tests/test/cg/tadint64.pp
View File

@ -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
}

14
tests/test/cg/tcnvset.pp
View File

@ -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

12
tests/test/cg/tderef.pp
View File

@ -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()
}

37
tests/test/cg/tin.pp
View File

@ -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

182
tests/test/cg/tmoddiv.pp
View File

@ -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.

45
tests/test/cg/tneg.pp
View File

@ -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.

58
tests/test/cg/tnot.pp
View File

@ -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.

199
tests/test/cg/tshlshr.pp
View File

@ -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
}

36
tests/test/cg/tvec.pp
View File

@ -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