mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-19 06:19:32 +02:00
* some tests from CEC
This commit is contained in:
peter
parent
efcc15cfee
commit
6ab0380cd9
102
tests/test/testcard.pp
Normal file
102
tests/test/testcard.pp
Normal file
@ -0,0 +1,102 @@
|
||||
Program TestCardinal;
|
||||
|
||||
{ Tests different features of the cardinal type }
|
||||
{ We must also test range checking thereafter }
|
||||
Procedure TestEqualAssign;
|
||||
var
|
||||
l : longint;
|
||||
i : cardinal;
|
||||
j : cardinal;
|
||||
Begin
|
||||
l:=$80000000; { longint }
|
||||
i:=l; { longint -> cardinal }
|
||||
j:=i; { cardinal -> cardinal }
|
||||
l:=j; { cardinal -> longint }
|
||||
end;
|
||||
|
||||
|
||||
Procedure TestBiggerAssign;
|
||||
var
|
||||
b: byte;
|
||||
c: char;
|
||||
s: shortint;
|
||||
i: integer;
|
||||
w: word;
|
||||
j: cardinal;
|
||||
Begin
|
||||
b:=0;
|
||||
c:=#$7f;
|
||||
s:=120;
|
||||
i:=16384;
|
||||
w:=32767;
|
||||
j:=b; { byte -> cardinal }
|
||||
{ THIS LINE CRASHES THE COMPILER FPC v0.99.5a }
|
||||
{ j:=c;} { char -> cardinal }
|
||||
j:=ord(c);{ char -> cardinal }
|
||||
j:=s; { shortint -> cardinal }
|
||||
j:=i; { integer -> cardinal }
|
||||
j:=w; { word -> cardinal }
|
||||
end;
|
||||
|
||||
Procedure TestSmallerAssign;
|
||||
var
|
||||
b: byte;
|
||||
c: char;
|
||||
s: shortint;
|
||||
i: integer;
|
||||
w: word;
|
||||
j: cardinal;
|
||||
Begin
|
||||
j:=$ffffffff;
|
||||
b:=byte(j);
|
||||
c:=char(j);
|
||||
s:=shortint(j);
|
||||
i:=integer(j);
|
||||
w:=word(j);
|
||||
end;
|
||||
|
||||
|
||||
Procedure TestMul;
|
||||
var
|
||||
j: cardinal;
|
||||
k: cardinal;
|
||||
Begin
|
||||
j:=1;
|
||||
k:=$8000000;
|
||||
j:=j*16384;
|
||||
j:=j*k
|
||||
end;
|
||||
|
||||
|
||||
Procedure TestDiv;
|
||||
var
|
||||
j: cardinal;
|
||||
k: cardinal;
|
||||
Begin
|
||||
j:=1;
|
||||
k:=$8000000;
|
||||
j:=j div 16384;
|
||||
j:=j div k;
|
||||
k:=k mod 200;
|
||||
end;
|
||||
|
||||
|
||||
Procedure TestAdd;
|
||||
Begin
|
||||
end;
|
||||
|
||||
|
||||
Procedure TestSub;
|
||||
Begin
|
||||
end;
|
||||
|
||||
|
||||
Begin
|
||||
TestEqualAssign;
|
||||
TestBiggerAssign;
|
||||
TestSmallerAssign;
|
||||
TestMul;
|
||||
TestDiv;
|
||||
end.
|
||||
|
||||
|
||||
74
tests/test/testdiv.pp
Normal file
74
tests/test/testdiv.pp
Normal file
@ -0,0 +1,74 @@
|
||||
|
||||
|
||||
|
||||
Procedure TestDiv;
|
||||
var
|
||||
bx,by: byte;
|
||||
ix,iy: integer;
|
||||
wx,wy: word;
|
||||
lx,ly: longint;
|
||||
Begin
|
||||
{ byte test }
|
||||
bx:=10;
|
||||
by:=5;
|
||||
bx:=bx div by;
|
||||
if bx = 2 then
|
||||
WriteLn('TEST_DIV(1): PASSED.')
|
||||
else
|
||||
WriteLn('TEST_DIV(1): FAILED.');
|
||||
bx:=20;
|
||||
bx:=bx div 10;
|
||||
if bx = 2 then
|
||||
WriteLn('TEST_DIV(2): PASSED.')
|
||||
else
|
||||
WriteLn('TEST_DIV(2): FAILED.');
|
||||
{ integer test }
|
||||
ix:=-10;
|
||||
iy:=5;
|
||||
ix:=ix div iy;
|
||||
if ix = -2 then
|
||||
WriteLn('TEST_DIV(3): PASSED.')
|
||||
else
|
||||
WriteLn('TEST_DIV(3): FAILED.');
|
||||
ix:=-20;
|
||||
ix:=ix div 10;
|
||||
if ix = -2 then
|
||||
WriteLn('TEST_DIV(4): PASSED.')
|
||||
else
|
||||
WriteLn('TEST_DIV(4): FAILED.');
|
||||
{ word test }
|
||||
wx:=64000;
|
||||
wy:=2;
|
||||
wx:=wx div wy;
|
||||
if wx = 32000 then
|
||||
WriteLn('TEST_DIV(5): PASSED.')
|
||||
else
|
||||
WriteLn('TEST_DIV(5): FAILED.');
|
||||
wx:=20;
|
||||
wx:=wx div 10;
|
||||
if wx = 2 then
|
||||
WriteLn('TEST_DIV(6): PASSED.')
|
||||
else
|
||||
WriteLn('TEST_DIV(6): FAILED.');
|
||||
{ longint test }
|
||||
lx:=-1000000;
|
||||
ly:=2;
|
||||
lx:=lx div ly;
|
||||
if lx = -500000 then
|
||||
WriteLn('TEST_DIV(7): PASSED.')
|
||||
else
|
||||
WriteLn('TEST_DIV(7): FAILED.');
|
||||
lx:=-1000000;
|
||||
lx:=lx div 10;
|
||||
if lx = -100000 then
|
||||
WriteLn('TEST_DIV(8): PASSED.')
|
||||
else
|
||||
WriteLn('TEST_DIV(8): FAILED.')
|
||||
end;
|
||||
|
||||
|
||||
|
||||
|
||||
Begin
|
||||
Testdiv;
|
||||
end.
|
||||
103
tests/test/testobj.pp
Normal file
103
tests/test/testobj.pp
Normal file
@ -0,0 +1,103 @@
|
||||
|
||||
|
||||
TYPE
|
||||
|
||||
psimpleobject = ^tsimpleobject;
|
||||
tsimpleobject = object
|
||||
x: longint;
|
||||
z: array[0..34] of byte;
|
||||
Procedure Init(somez: longint);
|
||||
Procedure Hello;
|
||||
end;
|
||||
|
||||
pbase = ^tbase;
|
||||
tbase = object
|
||||
numofentries : longint;
|
||||
constructor init(i : integer);
|
||||
destructor done; virtual;
|
||||
procedure showit; virtual;
|
||||
end;
|
||||
|
||||
pderived = ^tderived;
|
||||
tderived = object(tbase)
|
||||
x: longint;
|
||||
constructor init;
|
||||
destructor done; virtual;
|
||||
procedure showit; virtual;
|
||||
end;
|
||||
|
||||
|
||||
Procedure TsimpleObject.init(somez: longint);
|
||||
var
|
||||
i: byte;
|
||||
Begin
|
||||
for i:=0 to 34 do
|
||||
z[i]:=i;
|
||||
x:=somez;
|
||||
end;
|
||||
|
||||
|
||||
Procedure TSimpleObject.hello;
|
||||
var
|
||||
i: byte;
|
||||
Begin
|
||||
WriteLn('hello world');
|
||||
for i:=0 to 34 do
|
||||
Write(z[i],' ');
|
||||
WriteLn;
|
||||
WriteLN(x);
|
||||
end;
|
||||
|
||||
|
||||
constructor tbase.init(i: integer);
|
||||
Begin
|
||||
numofentries := i;
|
||||
end;
|
||||
|
||||
destructor tbase.done;
|
||||
Begin
|
||||
end;
|
||||
|
||||
procedure tbase.showit;
|
||||
Begin
|
||||
WriteLn('This is the base class');
|
||||
end;
|
||||
|
||||
constructor tderived.init;
|
||||
Begin
|
||||
inherited init(5);
|
||||
x:=10;
|
||||
end;
|
||||
|
||||
procedure tderived.showit;
|
||||
Begin
|
||||
WriteLn('This is the derived class');
|
||||
WriteLn(numofentries);
|
||||
WriteLn(x);
|
||||
end;
|
||||
|
||||
destructor tderived.done;
|
||||
Begin
|
||||
end;
|
||||
|
||||
|
||||
Procedure CreateObject;
|
||||
var
|
||||
obj: pbase;
|
||||
Begin
|
||||
obj^.showit;
|
||||
dispose(obj,done);
|
||||
end;
|
||||
|
||||
var
|
||||
myobj: tsimpleobject;
|
||||
obj: pbase;
|
||||
devobj: tderived;
|
||||
Begin
|
||||
WriteLn(MemAvail);
|
||||
obj:=new(pbase,init(10));
|
||||
obj^.showit;
|
||||
WriteLn(MemAvail);
|
||||
dispose(obj,done);
|
||||
WriteLn(MemAvail);
|
||||
end.
|
||||
76
tests/test/testreal.pp
Normal file
76
tests/test/testreal.pp
Normal file
@ -0,0 +1,76 @@
|
||||
{$E-}
|
||||
|
||||
Procedure TestSub;
|
||||
var
|
||||
i : Real;
|
||||
j : Real;
|
||||
Begin
|
||||
i:=99.9;
|
||||
j:=10.0;
|
||||
i:=i-j;
|
||||
Write('RESULT SHOULD BE: 89.9 :');
|
||||
WriteLn(i);
|
||||
i:=j-i;
|
||||
Write('RESULT SHOULD BE: -79.9 :');
|
||||
WriteLn(i);
|
||||
j:=j-10.0;
|
||||
Write('RESULT SHOULD BE: 0.0 :');
|
||||
WriteLn(j);
|
||||
end;
|
||||
|
||||
Function TestAdd(i : real): Real;
|
||||
Begin
|
||||
i:=i+1.5;
|
||||
if i > 10.0 then
|
||||
Begin
|
||||
Write('RESULT SHOULD BE: 10.5 :');
|
||||
WriteLn(i);
|
||||
exit;
|
||||
end;
|
||||
TestAdd:=TestAdd(i);
|
||||
end;
|
||||
|
||||
Procedure TestDiv;
|
||||
var
|
||||
i : Real;
|
||||
j : Real;
|
||||
Begin
|
||||
i:=-99.9;
|
||||
j:=10.0;
|
||||
i:=i / j;
|
||||
Write('RESULT SHOULD BE: -9.9 :');
|
||||
WriteLn(i);
|
||||
i:=j / i;
|
||||
Write('RESULT SHOULD BE: -1.01 :');
|
||||
WriteLn(i);
|
||||
j:=i / 10.0;
|
||||
Write('RESULT SHOULD BE: -0.1001 :');
|
||||
WriteLn(j);
|
||||
end;
|
||||
|
||||
|
||||
|
||||
Procedure TestComplex;
|
||||
var
|
||||
i : real;
|
||||
Begin
|
||||
Write('RESULT SHOULD BE 2.09 :');
|
||||
i := 4.4;
|
||||
WriteLn(Sqrt(i));
|
||||
Write('RESULT SHOULD BE PI :');
|
||||
WriteLn(Pi);
|
||||
Write('RESULT SHOULD BE 4.0 :');
|
||||
WriteLn(Round(3.6));
|
||||
end;
|
||||
|
||||
|
||||
Begin
|
||||
WriteLn('------------ SUB ---------------');
|
||||
TestSub;
|
||||
WriteLn('------------ ADD ---------------');
|
||||
TestAdd(0);
|
||||
WriteLn('------------ DIV ---------------');
|
||||
TestDiv;
|
||||
WriteLn('------------ COMPLEX ---------------');
|
||||
TestComplex;
|
||||
end.
|
||||
351
tests/test/testset2.pp
Normal file
351
tests/test/testset2.pp
Normal file
@ -0,0 +1,351 @@
|
||||
(*********************************************************************)
|
||||
(* Copyright (C) 1998, Carl Eric Codere *)
|
||||
(*********************************************************************)
|
||||
(* FPC (Free Pascal compiler) testsuite: SETS *)
|
||||
(* Tests the following: in, +, -, *, assignments. *)
|
||||
(* for small sets amd large sets, both with constants *)
|
||||
(* and variables. *)
|
||||
(*********************************************************************)
|
||||
|
||||
type
|
||||
myenum = (dA,dB,dC,dd,dedf,dg,dh,di,dj,dk,dl,dm,dn);
|
||||
tasmop = (A_ABCD,
|
||||
A_ADD,A_ADDA,A_ADDI,A_ADDQ,A_ADDX,A_AND,A_ANDI,
|
||||
A_ASL,A_ASR,A_BCC,A_BCS,A_BEQ,A_BGE,A_BGT,A_BHI,
|
||||
A_BLE,A_BLS,A_BLT,A_BMI,A_BNE,A_BPL,A_BVC,A_BVS,
|
||||
A_BCHG,A_BCLR,A_BRA,A_BSET,A_BSR,A_BTST,A_CHK,
|
||||
A_CLR,A_CMP,A_CMPA,A_CMPI,A_CMPM,A_DBCC,A_DBCS,A_DBEQ,A_DBGE,
|
||||
A_DBGT,A_DBHI,A_DBLE,A_DBLS,A_DBLT,A_DBMI,A_DBNE,A_DBRA,
|
||||
A_DBPL,A_DBT,A_DBVC,A_DBVS,A_DBF,A_DIVS,A_DIVU,
|
||||
A_EOR,A_EORI,A_EXG,A_ILLEGAL,A_EXT,A_JMP,A_JSR,
|
||||
A_LEA,A_LINK,A_LSL,A_LSR,A_MOVE,A_MOVEA,A_MOVEI,A_MOVEQ,
|
||||
A_MOVEM,A_MOVEP,A_MULS,A_MULU,A_NBCD,A_NEG,A_NEGX,
|
||||
A_NOP,A_NOT,A_OR,A_ORI,A_PEA,A_ROL,A_ROR,A_ROXL,
|
||||
A_ROXR,A_RTR,A_RTS,A_SBCD,A_SCC,A_SCS,A_SEQ,A_SGE,
|
||||
A_SGT,A_SHI,A_SLE,A_SLS,A_SLT,A_SMI,A_SNE,
|
||||
A_SPL,A_ST,A_SVC,A_SVS,A_SF,A_SUB,A_SUBA,A_SUBI,A_SUBQ,
|
||||
A_SUBX,A_SWAP,A_TAS,A_TRAP,A_TRAPV,A_TST,A_UNLK,
|
||||
A_RTE,A_RESET,A_STOP,
|
||||
{ MC68010 instructions }
|
||||
A_BKPT,A_MOVEC,A_MOVES,A_RTD,
|
||||
{ MC68020 instructions }
|
||||
A_BFCHG,A_BFCLR,A_BFEXTS,A_BFEXTU,A_BFFFO,
|
||||
A_BFINS,A_BFSET,A_BFTST,A_CALLM,A_CAS,A_CAS2,
|
||||
A_CHK2,A_CMP2,A_DIVSL,A_DIVUL,A_EXTB,A_PACK,A_RTM,
|
||||
A_TRAPCC,A_TRACS,A_TRAPEQ,A_TRAPF,A_TRAPGE,A_TRAPGT,
|
||||
A_TRAPHI,A_TRAPLE,A_TRAPLS,A_TRAPLT,A_TRAPMI,A_TRAPNE,
|
||||
A_TRAPPL,A_TRAPT,A_TRAPVC,A_TRAPVS,A_UNPK,
|
||||
{ FPU Processor instructions - directly supported only. }
|
||||
{ IEEE aware and misc. condition codes not supported }
|
||||
A_FABS,A_FADD,
|
||||
A_FBEQ,A_FBNE,A_FBNGT,A_FBGT,A_FBGE,A_FBNGE,
|
||||
A_FBLT,A_FBNLT,A_FBLE,A_FBGL,A_FBNGL,A_FBGLE,A_FBNGLE,
|
||||
A_FDBEQ,A_FDBNE,A_FDBGT,A_FDBNGT,A_FDBGE,A_FDBNGE,
|
||||
A_FDBLT,A_FDBNLT,A_FDBLE,A_FDBGL,A_FDBNGL,A_FDBGLE,A_FBDNGLE,
|
||||
A_FSEQ,A_FSNE,A_FSGT,A_FSNGT,A_FSGE,A_FSNGE,
|
||||
A_FSLT,A_FSNLT,A_FSLE,A_FSGL,A_FSNGL,A_FSGLE,A_FSNGLE,
|
||||
A_FCMP,A_FDIV,A_FMOVE,A_FMOVEM,
|
||||
A_FMUL,A_FNEG,A_FNOP,A_FSQRT,A_FSUB,A_FSGLDIV,
|
||||
A_FSFLMUL,A_FTST,
|
||||
A_FTRAPEQ,A_FTRAPNE,A_FTRAPGT,A_FTRAPNGT,A_FTRAPGE,A_FTRAPNGE,
|
||||
A_FTRAPLT,A_FTRAPNLT,A_FTRAPLE,A_FTRAPGL,A_FTRAPNGL,A_FTRAPGLE,A_FTRAPNGLE,
|
||||
{ Protected instructions }
|
||||
A_CPRESTORE,A_CPSAVE,
|
||||
{ FPU Unit protected instructions }
|
||||
{ and 68030/68851 common MMU instructions }
|
||||
{ (this may include 68040 MMU instructions) }
|
||||
A_FRESTORE,A_FSAVE,A_PFLUSH,A_PFLUSHA,A_PLOAD,A_PMOVE,A_PTEST,
|
||||
{ Useful for assembly langage output }
|
||||
A_LABEL,A_NONE);
|
||||
|
||||
|
||||
Function X(y:myenum): myenum;
|
||||
Begin
|
||||
x:=y;
|
||||
end;
|
||||
|
||||
|
||||
Procedure SecondInSets;
|
||||
{ SET_IN_BYTE TESTS }
|
||||
var
|
||||
op : tasmop;
|
||||
oplist: set of tasmop;
|
||||
Begin
|
||||
Write('TESTING SET_IN_BYTE:');
|
||||
oplist:=[];
|
||||
op:=A_JSR;
|
||||
if op in oplist then
|
||||
WriteLn(' FAILED.');
|
||||
op:=A_MOVE;
|
||||
oplist:=oplist+[A_MOVE];
|
||||
if op in oplist then
|
||||
WriteLn(' PASSED.');
|
||||
end;
|
||||
|
||||
Procedure SetSetByte;
|
||||
{ SET_SET_BYTE }
|
||||
var
|
||||
op : tasmop;
|
||||
oplist: set of tasmop;
|
||||
Begin
|
||||
Write('TESTING SET_SET_BYTE(1):');
|
||||
op:=A_LABEL;
|
||||
oplist:=[];
|
||||
oplist:=oplist+[op];
|
||||
if op in oplist then
|
||||
Begin
|
||||
WriteLn(' PASSED.');
|
||||
end
|
||||
else
|
||||
Begin
|
||||
WriteLn(' FAILED.');
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
Procedure SetAddSets;
|
||||
{ SET_ADD_SETS }
|
||||
var
|
||||
op2list :set of tasmop;
|
||||
oplist: set of tasmop;
|
||||
Begin
|
||||
op2list:=[];
|
||||
oplist:=[];
|
||||
oplist:=[A_MOVE]+[A_JSR];
|
||||
op2list:=[A_LABEL];
|
||||
oplist:=op2list+oplist;
|
||||
if A_MOVE in oplist then
|
||||
if A_LABEL in oplist then
|
||||
if A_JSR in oplist then
|
||||
WriteLn('TESTING SET_ADD_SETS: PASSED.')
|
||||
else
|
||||
WriteLn('TESTING SET_ADD_SETS: FAILED.')
|
||||
else
|
||||
WriteLn('TESTING SET_ADD_SETS: FAILED.')
|
||||
else
|
||||
WriteLn('TESTING SET_ADD_SETS: FAILED.')
|
||||
end;
|
||||
|
||||
Procedure SetSubsets;
|
||||
{ SET_SUB_SETS }
|
||||
var
|
||||
op2list :set of tasmop;
|
||||
oplist: set of tasmop;
|
||||
Begin
|
||||
op2list:=[];
|
||||
oplist:=[];
|
||||
oplist:=[A_MOVE]+[A_JSR];
|
||||
op2list:=[A_MOVE]+[A_JSR];
|
||||
oplist:=op2list-oplist;
|
||||
if (A_MOVE in oplist) or (A_LABEL in oplist) or (A_JSR in oplist) then
|
||||
WriteLn('TESTING SET_SUB_SETS: FAILED.')
|
||||
else
|
||||
WriteLn('TESTING SET_SUB_SETS: PASSED.')
|
||||
end;
|
||||
|
||||
Procedure SetCompSets;
|
||||
{ SET_COMP_SETS }
|
||||
var
|
||||
op2list :set of tasmop;
|
||||
oplist: set of tasmop;
|
||||
Begin
|
||||
op2list:=[];
|
||||
oplist:=[];
|
||||
oplist:=[A_MOVE]+[A_JSR];
|
||||
op2list:=[A_MOVE]+[A_JSR];
|
||||
if oplist=op2list then
|
||||
WriteLn('TESTING SET_COMP_SETS(1): PASSED.')
|
||||
else
|
||||
WriteLn('TESTING SET_COMP_SETS(1): FAILED.');
|
||||
oplist:=[A_MOVE];
|
||||
if oplist=op2list then
|
||||
WriteLn('TESTING SET_COMP_SETS(2): FAILED.')
|
||||
else
|
||||
WriteLn('TESTING SET_COMP_SETS(2): PASSED.');
|
||||
end;
|
||||
|
||||
Procedure SetMulSets;
|
||||
{ SET_COMP_SETS }
|
||||
var
|
||||
op2list :set of tasmop;
|
||||
oplist: set of tasmop;
|
||||
Begin
|
||||
op2list:=[];
|
||||
oplist:=[];
|
||||
oplist:=[A_MOVE]+[A_JSR];
|
||||
op2list:=[A_MOVE];
|
||||
oplist:=oplist*op2list;
|
||||
if A_JSR in oplist then
|
||||
WriteLn('TESTING SET_MUL_SETS(1): FAILED.')
|
||||
else
|
||||
WriteLn('TESTING SET_MUL_SETS(1): PASSED.');
|
||||
if A_MOVE in oplist then
|
||||
WriteLn('TESTING SET_MUL_SETS(2): PASSED.')
|
||||
else
|
||||
WriteLn('TESTING SET_MUL_SETS(2): FAILED.')
|
||||
end;
|
||||
|
||||
{------------------------------ TESTS FOR SMALL VALUES ---------------------}
|
||||
Procedure SmallInSets;
|
||||
{ SET_IN_BYTE TESTS }
|
||||
var
|
||||
op : myenum;
|
||||
oplist: set of myenum;
|
||||
Begin
|
||||
Write('TESTING IN_BYTE:');
|
||||
oplist:=[];
|
||||
op:=Dn;
|
||||
if op in oplist then
|
||||
WriteLn(' FAILED.');
|
||||
op:=dm;
|
||||
oplist:=oplist+[Dm];
|
||||
if op in oplist then
|
||||
WriteLn(' PASSED.');
|
||||
end;
|
||||
|
||||
Procedure SmallSetByte;
|
||||
{ SET_SET_BYTE }
|
||||
var
|
||||
op : myenum;
|
||||
oplist: set of myenum;
|
||||
Begin
|
||||
Write('TESTING SET_BYTE(1):');
|
||||
op:=DA;
|
||||
oplist:=[];
|
||||
oplist:=oplist+[op];
|
||||
if op in oplist then
|
||||
Begin
|
||||
WriteLn(' PASSED.');
|
||||
end
|
||||
else
|
||||
Begin
|
||||
WriteLn(' FAILED.');
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
Procedure SmallAddSets;
|
||||
{ SET_ADD_SETS }
|
||||
var
|
||||
op2list :set of myenum;
|
||||
oplist: set of myenum;
|
||||
Begin
|
||||
op2list:=[];
|
||||
oplist:=[];
|
||||
oplist:=[DA]+[DC];
|
||||
op2list:=[DB];
|
||||
oplist:=op2list+oplist;
|
||||
if DA in oplist then
|
||||
if DC in oplist then
|
||||
if DB in oplist then
|
||||
WriteLn('TESTING SET_ADD_SETS: PASSED.')
|
||||
else
|
||||
WriteLn('TESTING ADD_SETS: FAILED.')
|
||||
else
|
||||
WriteLn('TESTING ADD_SETS: FAILED.')
|
||||
else
|
||||
WriteLn('TESTING ADD_SETS: FAILED.')
|
||||
end;
|
||||
|
||||
Procedure SmallSubsets;
|
||||
{ SET_SUB_SETS }
|
||||
var
|
||||
op2list :set of myenum;
|
||||
oplist: set of myenum;
|
||||
Begin
|
||||
op2list:=[];
|
||||
oplist:=[];
|
||||
oplist:=[DA]+[DC];
|
||||
op2list:=[DA]+[DC];
|
||||
oplist:=op2list-oplist;
|
||||
if (DA in oplist) or (DB in oplist) or (DC in oplist) then
|
||||
WriteLn('TESTING SUB_SETS: FAILED.')
|
||||
else
|
||||
WriteLn('TESTING SUB_SETS: PASSED.')
|
||||
end;
|
||||
|
||||
Procedure SmallCompSets;
|
||||
{ SET_COMP_SETS }
|
||||
var
|
||||
op2list :set of myenum;
|
||||
oplist: set of myenum;
|
||||
Begin
|
||||
op2list:=[];
|
||||
oplist:=[];
|
||||
oplist:=[DA]+[DC];
|
||||
op2list:=[DA]+[DC];
|
||||
if oplist=op2list then
|
||||
WriteLn('TESTING COMP_SETS(1): PASSED.')
|
||||
else
|
||||
WriteLn('TESTING COMP_SETS(1): FAILED.');
|
||||
oplist:=[DA];
|
||||
if oplist=op2list then
|
||||
WriteLn('TESTING COMP_SETS(2): FAILED.')
|
||||
else
|
||||
WriteLn('TESTING COMP_SETS(2): PASSED.');
|
||||
end;
|
||||
|
||||
Procedure SmallMulSets;
|
||||
{ SET_COMP_SETS }
|
||||
var
|
||||
op2list :set of myenum;
|
||||
oplist: set of myenum;
|
||||
Begin
|
||||
op2list:=[];
|
||||
oplist:=[];
|
||||
oplist:=[DA]+[DC];
|
||||
op2list:=[DA];
|
||||
oplist:=oplist*op2list;
|
||||
if DC in oplist then
|
||||
WriteLn('TESTING MUL_SETS(1): FAILED.')
|
||||
else
|
||||
WriteLn('TESTING MUL_SETS(1): PASSED.');
|
||||
if DA in oplist then
|
||||
WriteLn('TESTING MUL_SETS(2): PASSED.')
|
||||
else
|
||||
WriteLn('TESTING MUL_SETS(2): FAILED.')
|
||||
end;
|
||||
|
||||
const
|
||||
b: myenum = (dA);
|
||||
var
|
||||
enum: set of myenum;
|
||||
oplist: set of tasmop;
|
||||
l : word;
|
||||
Begin
|
||||
{ small sets }
|
||||
enum:=[];
|
||||
{ add }
|
||||
enum:=enum+[da];
|
||||
{ subtract }
|
||||
enum:=enum-[da];
|
||||
if DA in enum then
|
||||
WriteLn('Found A_LABEL');
|
||||
{ very large sets }
|
||||
{ copy loop test }
|
||||
WRITELN('LARGE SETS:');
|
||||
oplist := [A_LABEL];
|
||||
{ secondin test }
|
||||
if A_LABEL in oplist then
|
||||
WriteLn('TESTING SIMPLE SECOND_IN: PASSED.');
|
||||
{ }
|
||||
oplist:=[];
|
||||
if A_LABEL in oplist then
|
||||
WriteLn('SECOND IN FAILED.');
|
||||
SecondinSets;
|
||||
SetSetByte;
|
||||
SetAddSets;
|
||||
SetSubSets;
|
||||
SetCompSets;
|
||||
SetMulSets;
|
||||
WRITELN('SMALL SETS:');
|
||||
SmallInSets;
|
||||
SmallAddSets;
|
||||
SmallSubSets;
|
||||
SmallCompSets;
|
||||
SmallMulSets;
|
||||
l:=word(A_CPRESTORE);
|
||||
if l = word(A_CPRESTORE) then
|
||||
Begin
|
||||
end;
|
||||
end.
|
||||
Loading…
Reference in New Issue
Block a user