diff --git a/tests/test/cg/taddset.pp b/tests/test/cg/taddset.pp index 441e99d00d..43a9193b8f 100644 --- a/tests/test/cg/taddset.pp +++ b/tests/test/cg/taddset.pp @@ -18,6 +18,9 @@ Program tneg; +var + Err : boolean; + type { DO NOT CHANGE THE VALUES OF THESE ENUMERATIONS! } tsmallenum = (dA,dB,dC,dd,de,df,dg,dh,di,dj,dk,dl,dm,dn,dop,dp,dq,dr); @@ -116,6 +119,16 @@ const ); + procedure CheckPassed(passed:boolean); + begin + if passed then + WriteLn('Success.') + else + begin + WriteLn('Failure.'); + Err:=true; + end; + end; procedure SetTestEqual; { FPC_SET_COMP_SETS } @@ -136,10 +149,7 @@ const passed := false; if not (constset1[1] = [A_MOVE,A_FTST,A_CPSAVE]) then passed := false; - if passed then - WriteLn('Success.') - else - WriteLn('Failure.'); + CheckPassed(passed); end; procedure SetTestNotEqual; @@ -165,10 +175,7 @@ const passed := false; } if (constset1[1] <> [A_MOVE,A_FTST,A_CPSAVE]) then passed := false; - if passed then - WriteLn('Success.') - else - WriteLn('Failure.'); + CheckPassed(passed); end; procedure SetTestLt; @@ -188,10 +195,7 @@ const oplist := [A_MOVE,A_CPRESTORE..A_CPSAVE]; if oplist <= op2list then passed := false; - if passed then - WriteLn('Success.') - else - WriteLn('Failure.'); + CheckPassed(passed); end; Procedure SetTestAddOne; @@ -205,14 +209,7 @@ const op:=A_LABEL; oplist:=[]; oplist:=oplist+[op]; - if oplist = [A_LABEL] then - Begin - WriteLn('Success.'); - end - else - Begin - WriteLn('Failure.'); - end; + CheckPassed(oplist = [A_LABEL]); end; Procedure SetTestAddTwo; @@ -227,14 +224,7 @@ Begin oplist:=[A_MOVE]+[A_JSR]; op2list:=[A_LABEL]; oplist:=op2list+oplist; - if oplist = [A_MOVE,A_JSR,A_LABEL] then - Begin - WriteLn('Success.'); - end - else - Begin - WriteLn('Failure.'); - end; + CheckPassed(oplist = [A_MOVE,A_JSR,A_LABEL]); end; @@ -265,10 +255,7 @@ Begin oplist:=op2list-oplist; if oplist <> [] then passed := false; - if passed then - WriteLn('Success.') - else - WriteLn('Failure.'); + CheckPassed(passed); end; Procedure SetTestSubTwo; @@ -298,10 +285,7 @@ Begin oplist := oplist - [b]; if oplist <> [] then passed := false; - if not passed then - WriteLn('Failure.') - else - WriteLn('Success.'); + CheckPassed(passed); end; @@ -326,10 +310,7 @@ Begin oplist := oplist * op2list; if oplist <> [A_MOVE,A_FTST] then passed := false; - if passed then - WriteLn('Success.') - else - WriteLn('Failure.'); + CheckPassed(passed); end; procedure SetTestRange; @@ -348,10 +329,7 @@ begin oplist := [op1..op2]; if oplist <> constset1[2] then passed := false; - if not passed then - WriteLn('Failure,') - else - WriteLn('Success.'); + CheckPassed(passed); end; procedure SetTestByte; @@ -369,10 +347,7 @@ begin oplist := [A_MOVE,op,A_JSR]; if oplist <> [A_MOVE,A_LABEL,A_JSR] then passed := false; - if not passed then - WriteLn('Failure,') - else - WriteLn('Success.'); + CheckPassed(passed); end; @@ -395,10 +370,7 @@ end; passed := false; if not (constset3[1] = [DA,DD,DM]) then passed := false; - if passed then - WriteLn('Success.') - else - WriteLn('Failure.'); + CheckPassed(passed); end; procedure SmallSetTestNotEqual; @@ -423,10 +395,7 @@ end; passed := false; } if (constset3[1] <> [DA,DD,DM]) then passed := false; - if passed then - WriteLn('Success.') - else - WriteLn('Failure.'); + CheckPassed(passed); end; procedure SmallSetTestLt; @@ -446,10 +415,7 @@ end; oplist := [DC,DF..DM]; if oplist <= op2list then passed := false; - if passed then - WriteLn('Success.') - else - WriteLn('Failure.'); + CheckPassed(passed); end; Procedure SmallSetTestAddOne; @@ -461,14 +427,7 @@ end; op:=DG; oplist:=[]; oplist:=oplist+[op]; - if oplist = [DG] then - Begin - WriteLn('Success.'); - end - else - Begin - WriteLn('Failure.'); - end; + CheckPassed( oplist = [DG] ); end; Procedure SmallSetTestAddTwo; @@ -482,14 +441,7 @@ Begin oplist:=[DG]+[DI]; op2list:=[DM]; oplist:=op2list+oplist; - if oplist = [DG,DI,DM] then - Begin - WriteLn('Success.'); - end - else - Begin - WriteLn('Failure.'); - end; + CheckPassed( oplist = [DG,DI,DM] ); end; @@ -516,10 +468,7 @@ Begin oplist:=op2list-oplist; if oplist <> [] then passed := false; - if passed then - WriteLn('Success.') - else - WriteLn('Failure.'); + CheckPassed(passed); end; Procedure SmallSetTestSubTwo; @@ -548,10 +497,7 @@ Begin oplist := oplist - [b]; if oplist <> [] then passed := false; - if not passed then - WriteLn('Failure.') - else - WriteLn('Success.'); + CheckPassed(passed); end; @@ -575,10 +521,7 @@ Begin oplist := oplist * op2list; if oplist <> [DG,DK] then passed := false; - if passed then - WriteLn('Success.') - else - WriteLn('Failure.'); + CheckPassed(passed); end; procedure SmallSetTestRange; @@ -597,10 +540,7 @@ begin oplist := [op1..op2]; if oplist <> constset3[2] then passed := false; - if not passed then - WriteLn('Failure,') - else - WriteLn('Success.'); + CheckPassed(passed); end; procedure SmallSetTestByte; @@ -618,10 +558,7 @@ begin oplist := [DG,op,DI]; if oplist <> [DG,DD,DI] then passed := false; - if not passed then - WriteLn('Failure,') - else - WriteLn('Success.'); + CheckPassed(passed); end; (* @@ -695,11 +632,17 @@ Begin SmallSetTestRange; SmallSetTestLt; SmallSetTestByte; + + if Err then + Halt(1); end. { $Log$ - Revision 1.3 2001-06-24 22:30:19 carl + 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 + completed small set tests Revision 1.2 2001/06/22 02:24:40 carl diff --git a/tests/test/tpara1.pp b/tests/test/tpara1.pp index 3776488c6d..de4b3b90f4 100644 --- a/tests/test/tpara1.pp +++ b/tests/test/tpara1.pp @@ -1,6 +1,8 @@ { %VERSION=1.1 } -{$mode objfpc} +{$ifdef fpc} + {$mode objfpc} +{$endif} uses erroru; @@ -13,34 +15,24 @@ type procedure p1(out b : byte); begin - if b<>0 then - do_error(1001); b:=$aa; end; procedure p2(out w : word); begin - if w<>0 then - do_error(1002); w:=$aaaa; end; -procedure p3(out d : dword); +procedure p3(out d : cardinal); begin - if d<>0 then - do_error(1003); d:=$aaaaaaaa; end; procedure p4(out r : tr1); begin - if r.l1<>0 then - do_error(1004); - if r.l2<>0 then - do_error(1005); r.l1:=$aaaaaaaa; r.l2:=$aaaaaaaa; end; @@ -56,7 +48,7 @@ procedure p5(out a : ansistring); var b : byte; w : word; - d : dword; + d : cardinal; r1 : tr1; a : ansistring; diff --git a/tests/test/trange1.pp b/tests/test/trange1.pp index 13cf4f19f9..a75e1d4205 100644 --- a/tests/test/trange1.pp +++ b/tests/test/trange1.pp @@ -1,7 +1,16 @@ { %VERSION=1.1 } -{$mode objfpc} -uses sysutils; +{$ifdef fpc} + {$mode objfpc} +{$endif} + +uses SysUtils; + +{$ifndef fpc} +type + qword=int64; + dword=cardinal; +{$endif} var error: boolean; @@ -88,12 +97,11 @@ begin writeln(i); if not testlongint_int64(i,true) then writeln('test3 failed'); - longint(i) := $80000000; + i := $ffffffff80000000; writeln(i); if not testlongint_int64(i,false) then writeln('test4 failed'); - i := 0; - longint(i) := $80000000; + i := $80000000; writeln(i); if not testlongint_int64(i,true) then writeln('test5 failed'); @@ -101,8 +109,7 @@ begin writeln(i); if not testlongint_int64(i,false) then writeln('test6 failed'); - i := 0; - longint(i) := $ffffffff; + i := $ffffffff; writeln(i); if not testlongint_int64(i,true) then writeln('test7 failed'); @@ -126,12 +133,11 @@ begin writeln(q); if not testlongint_qword(q,true) then writeln('test3 failed'); - longint(q) := $80000000; + q := $ffffffff80000000; writeln(q); if not testlongint_qword(q,true) then writeln('test4 failed'); - q := 0; - longint(q) := $80000000; + q := $80000000; writeln(q); if not testlongint_qword(q,true) then writeln('test5 failed'); @@ -139,8 +145,7 @@ begin writeln(q); if not testlongint_qword(q,false) then writeln('test6 failed'); - q := 0; - longint(q) := $ffffffff; + q := $ffffffff; writeln(q); if not testlongint_qword(q,true) then writeln('test7 failed'); @@ -164,12 +169,11 @@ begin writeln(i); if not testdword_int64(i,true) then writeln('test3 failed'); - longint(i) := $80000000; + i := $ffffffff80000000; writeln(i); if not testdword_int64(i,true) then writeln('test4 failed'); - i := 0; - longint(i) := $80000000; + i := $80000000; writeln(i); if not testdword_int64(i,false) then writeln('test5 failed'); @@ -177,8 +181,7 @@ begin writeln(i); if not testdword_int64(i,false) then writeln('test6 failed'); - i := 0; - longint(i) := $ffffffff; + i := $ffffffff; writeln(i); if not testdword_int64(i,false) then writeln('test7 failed'); @@ -202,12 +205,11 @@ begin writeln(q); if not testdword_qword(q,true) then writeln('test3 failed'); - longint(q) := $80000000; + q := $ffffffff80000000; writeln(q); if not testdword_qword(q,true) then writeln('test4 failed'); - q := 0; - longint(q) := $80000000; + q := $80000000; writeln(q); if not testdword_qword(q,false) then writeln('test5 failed'); @@ -215,8 +217,7 @@ begin writeln(q); if not testdword_qword(q,false) then writeln('test6 failed'); - q := 0; - longint(q) := $ffffffff; + q := $ffffffff; writeln(q); if not testdword_qword(q,false) then writeln('test7 failed'); diff --git a/tests/test/units/system/tdir.pp b/tests/test/units/system/tdir.pp index 96e76f8a4f..c8627cf463 100644 --- a/tests/test/units/system/tdir.pp +++ b/tests/test/units/system/tdir.pp @@ -1,11 +1,11 @@ { Program to test OS-specific features of the system unit } -{ routines to test: } -{ mkdir() } -{ chdir() } +{ routines to test: } +{ mkdir() } +{ chdir() } { This program shoulf not be executed in a roto directory } { Creates the following directory, and sets it as the } -{ current directory. } -{ ../testdir } +{ current directory. } +{ ../testdir } Program tdir; @@ -24,6 +24,10 @@ Begin mkdir('testdir2'); WriteLn('removing directory ...'); rmdir('testdir2'); + WriteLn('going directory up ...'); + chdir('..'); + WriteLn('removing directory ...'); + rmdir('testdir'); WriteLn('getting current directory...'); getdir(0,s); WriteLn(s); @@ -31,7 +35,10 @@ end. { $Log$ - Revision 1.1 2001-07-14 04:25:17 carl + Revision 1.2 2001-10-20 17:26:13 peter + * several fixes to run also with kylix + + Revision 1.1 2001/07/14 04:25:17 carl system unit testing : basic directory services } diff --git a/tests/units/erroru.pp b/tests/units/erroru.pp index a67ded0ef4..5786b2368b 100644 --- a/tests/units/erroru.pp +++ b/tests/units/erroru.pp @@ -1,10 +1,11 @@ +{$J+} unit erroru; interface procedure do_error(l : longint); - + procedure error; - + procedure accept_error(num : longint); procedure require_error(num : longint); @@ -80,6 +81,7 @@ begin end; +initialization finalization error_unit_exit; end.