mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-17 07:39:13 +02:00
* several fixes to run also with kylix
This commit is contained in:
peter
parent
df8692dd2e
commit
e2719218f8
@ -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
|
||||
|
||||
@ -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;
|
||||
|
||||
|
||||
@ -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');
|
||||
|
||||
@ -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
|
||||
|
||||
}
|
||||
|
||||
@ -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.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user