mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-15 20:39:24 +02:00
0040eecf9f
is <> 0 (Delphi compatible now, + various tests)
+ support for enums and sets in is_in_limit()
* fixed converting smallset expressions to varsets
* improved choosing an appropriate common set type when mixing
set types in an expression
- removed no longer used normalset code from nadd.pas
- disabled large set (>256 elements) support for now, because
they are not yet supported entirely throughout the compiler
and this causes errors at run time in several situations
git-svn-id: trunk@8515 -
743 lines
18 KiB
ObjectPascal
743 lines
18 KiB
ObjectPascal
{$ifdef fpc}
|
|
{$packset 1}
|
|
{$endif}
|
|
|
|
{****************************************************************}
|
|
{ CODE GENERATOR TEST PROGRAM }
|
|
{****************************************************************}
|
|
{ NODE TESTED : secondadd() }
|
|
{****************************************************************}
|
|
{ PRE-REQUISITES: secondload() }
|
|
{ secondassign() }
|
|
{ secondsetelement() }
|
|
{****************************************************************}
|
|
{ DEFINES: }
|
|
{ FPC = Target is FreePascal compiler }
|
|
{****************************************************************}
|
|
{ REMARKS: }
|
|
{ }
|
|
{ }
|
|
{ }
|
|
{****************************************************************}
|
|
|
|
Program tneg;
|
|
|
|
var
|
|
Err : boolean;
|
|
|
|
type
|
|
{ DO NOT CHANGE THE VALUES OF THESE ENUMERATIONS! }
|
|
tsmallenum = (dA=23,dB,dC,dd,de,df,dg,dh,di,dj,dk,dl,dm,dn,dop,dp,dq,dr);
|
|
tsmallsubenum = dk..dr;
|
|
tasmop = (A_ABCD=13,
|
|
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);
|
|
tsubasmop = A_BFINS..A_FSEQ;
|
|
tsubasmop2 = A_BCS..A_BHI;
|
|
|
|
|
|
|
|
type
|
|
topset = set of tasmop;
|
|
tsubopset = set of tsubasmop;
|
|
tsmallset = set of tsmallenum;
|
|
tsubsmallset = set of tsmallsubenum;
|
|
|
|
const
|
|
|
|
{ NORMAL SETS }
|
|
constset1 : array[1..3] of topset =
|
|
(
|
|
{ 66 } { 210 } { 225 }
|
|
([A_MOVE, { 66 : LONG 2 - BIT 2 }
|
|
A_FTST, { 210 : LONG 6 - BIT 18 }
|
|
A_CPSAVE]),{ 225 : LONG 7 - BIT 1 }
|
|
{ 1..8 }
|
|
([A_ADD..A_ASL]),
|
|
{ 134 }
|
|
([A_CHK2])
|
|
);
|
|
|
|
constset2 : array[1..4] of topset =
|
|
(
|
|
([A_MOVE,A_FTST,A_CPSAVE]),
|
|
([A_ADD..A_ASL]),
|
|
([A_CHK2]),
|
|
([A_CMP2,A_TRAPVC,A_FADD])
|
|
);
|
|
|
|
{ SMALL SETS }
|
|
constset3 : array[1..3] of tsmallset =
|
|
(
|
|
([DA, { 0 : LONG 0 : bit 0 }
|
|
DD, { 3 : LONG 0 : bit 3 }
|
|
DM]), { 12 : LONG 0 : bit 12 }
|
|
([DB..DI]), { 1..8 : LONG 0 : bits 1-8 }
|
|
([DR]) { 17 : LONG 0 : bit 17 }
|
|
);
|
|
|
|
constset4 : array[1..3] of tsmallset =
|
|
(
|
|
([DA,DD,DM]),
|
|
([DB..DI]),
|
|
([DR])
|
|
);
|
|
|
|
constsubset1: array[1..1] of tsubopset =
|
|
(
|
|
([A_CMP2,A_TRAPVC,A_FADD])
|
|
);
|
|
|
|
|
|
procedure CheckPassed(passed:boolean);
|
|
begin
|
|
if passed then
|
|
WriteLn('Success.')
|
|
else
|
|
begin
|
|
WriteLn('Failure.');
|
|
Halt(1);
|
|
Err:=true;
|
|
end;
|
|
end;
|
|
|
|
procedure SetTestEqual;
|
|
{ FPC_SET_COMP_SETS }
|
|
var
|
|
op2list :set of tasmop;
|
|
oplist: set of tasmop;
|
|
soplist : tsubopset;
|
|
soplist2: set of tsubasmop2;
|
|
passed : boolean;
|
|
Begin
|
|
Write('Normal Set == Normal Set test...');
|
|
passed := true;
|
|
op2list:=[];
|
|
oplist:=[];
|
|
soplist:=[];
|
|
soplist2:=[];
|
|
if not (oplist=op2list) then
|
|
passed := false;
|
|
if not (soplist=op2list) then
|
|
passed := false;
|
|
if not(soplist=soplist2) then
|
|
passed:=false;
|
|
if not (constset1[2] = constset2[2]) then
|
|
passed := false;
|
|
if not(constset2[4] = constsubset1[1]) then
|
|
passed:=false;
|
|
if (constset1[1] = constset2[2]) then
|
|
passed := false;
|
|
if (constset1[1] = constsubset1[1]) then
|
|
passed := false;
|
|
if soplist2 = constsubset1[1] then
|
|
passed:=false;
|
|
if not (constset1[1] = [A_MOVE,A_FTST,A_CPSAVE]) then
|
|
passed := false;
|
|
if not (constsubset1[1] = [A_CMP2,A_TRAPVC,A_FADD]) then
|
|
passed := false;
|
|
CheckPassed(passed);
|
|
end;
|
|
|
|
procedure SetTestNotEqual;
|
|
{ FPC_SET_COMP_SETS }
|
|
var
|
|
op2list :set of tasmop;
|
|
oplist: set of tasmop;
|
|
soplist: set of tsubasmop;
|
|
passed : boolean;
|
|
Begin
|
|
Write('Normal Set <> Normal Set test...');
|
|
passed := true;
|
|
op2list:=[];
|
|
oplist:=[];
|
|
soplist:=[];
|
|
if not (oplist=op2list) then
|
|
passed := false;
|
|
if not (oplist=soplist) then
|
|
passed := false;
|
|
if (constset1[2] <> constset2[2]) then
|
|
passed := false;
|
|
if not (constset1[1] <> constset2[2]) then
|
|
passed := false;
|
|
{ if ( [A_ADD] <> [A_ADD] ) then optimized out.
|
|
passed := false;
|
|
if ( [A_BLE..A_BPL] <> [A_BLE..A_BPL] ) then
|
|
passed := false; }
|
|
if (constset1[1] <> [A_MOVE,A_FTST,A_CPSAVE]) then
|
|
passed := false;
|
|
CheckPassed(passed);
|
|
end;
|
|
|
|
procedure SetTestLt;
|
|
var
|
|
op2list :set of tasmop;
|
|
oplist: set of tasmop;
|
|
soplist : tsubopset;
|
|
soplist2: set of tsubasmop2;
|
|
passed : boolean;
|
|
begin
|
|
Write('Normal Set <= Normal Set test...');
|
|
passed := true;
|
|
if constset1[1] <= constset2[2] then
|
|
passed := false;
|
|
if constset1[1] <= constsubset1[1] then
|
|
passed := false;
|
|
oplist := [];
|
|
op2list := [A_MOVE];
|
|
if op2list <= oplist then
|
|
passed := false;
|
|
oplist := [A_MOVE,A_CPRESTORE..A_CPSAVE];
|
|
if oplist <= op2list then
|
|
passed := false;
|
|
soplist2:=[A_BHI];
|
|
soplist:=[A_BFINS..A_FSEQ];
|
|
if soplist2<=soplist then
|
|
passed:=false;
|
|
CheckPassed(passed);
|
|
end;
|
|
|
|
Procedure SetTestAddOne;
|
|
{ FPC_SET_SET_BYTE }
|
|
{ FPC_SET_ADD_SETS }
|
|
var
|
|
op : tasmop;
|
|
sop : tsubasmop;
|
|
sop2: tsubasmop2;
|
|
oplist: set of tasmop;
|
|
soplist: set of tsubasmop;
|
|
soplist2, soplist3: set of tsubasmop2;
|
|
passed: boolean;
|
|
Begin
|
|
Write('Set + Set element testing...');
|
|
passed:=true;
|
|
op:=A_LABEL;
|
|
oplist:=[];
|
|
oplist:=oplist+[op];
|
|
if oplist<>[A_LABEL] then
|
|
passed:=false;
|
|
|
|
sop:=A_UNPK;
|
|
oplist:=[];
|
|
oplist:=[sop];
|
|
if oplist<>[A_UNPK] then
|
|
passed:=false;
|
|
|
|
soplist:=[];
|
|
op:=A_UNPK;
|
|
soplist:=[op];
|
|
if soplist<>[A_UNPK] then
|
|
passed:=false;
|
|
|
|
soplist:=[];
|
|
op:=A_FBLE;
|
|
sop:=A_FABS;
|
|
soplist:=[op,sop];
|
|
if soplist<>[A_FBLE,A_FABS] then
|
|
passed:=false;
|
|
|
|
soplist:=[];
|
|
soplist:=[sop,op];
|
|
if soplist<>[A_FBLE,A_FABS] then
|
|
passed:=false;
|
|
|
|
oplist:=[];
|
|
oplist:=soplist+[A_FADD];
|
|
if (oplist<>[A_FBLE,A_FABS,A_FADD]) then
|
|
passed:=false;
|
|
|
|
oplist:=[];
|
|
sop:=A_UNPK;
|
|
oplist:=soplist+[sop];
|
|
if (oplist<>[A_FBLE,A_FABS,A_UNPK]) then
|
|
passed:=false;
|
|
|
|
soplist2:=[];
|
|
oplist:=soplist2+[A_BGE];
|
|
if (oplist<>[A_BGE]) then
|
|
passed:=false;
|
|
include(soplist2,A_BGT);
|
|
oplist:=soplist2-[A_BHI];
|
|
if (oplist<>[A_BGT]) then
|
|
passed:=false;
|
|
soplist3:=[A_BGT,A_BHI];
|
|
oplist:=soplist2*soplist3;
|
|
if (oplist<>[A_BGT]) then
|
|
passed:=false;
|
|
sop2:=A_BHI;
|
|
oplist:=[sop2];
|
|
if (oplist<>[A_BHI]) then
|
|
passed:=false;
|
|
CheckPassed(passed);
|
|
end;
|
|
|
|
Procedure SetTestAddTwo;
|
|
{ SET_ADD_SETS }
|
|
var
|
|
op2list :set of tasmop;
|
|
oplist: set of tasmop;
|
|
Begin
|
|
Write('Complex Set + Set element testing...');
|
|
op2list:=[];
|
|
oplist:=[];
|
|
oplist:=[A_MOVE]+[A_JSR];
|
|
op2list:=[A_LABEL];
|
|
oplist:=op2list+oplist;
|
|
CheckPassed(oplist = [A_MOVE,A_JSR,A_LABEL]);
|
|
end;
|
|
|
|
|
|
|
|
|
|
|
|
Procedure SetTestSubOne;
|
|
{ SET_SUB_SETS }
|
|
var
|
|
op2list :set of tasmop;
|
|
oplist: set of tasmop;
|
|
op :tasmop;
|
|
passed : boolean;
|
|
Begin
|
|
Write('Set - Set element testing...');
|
|
passed := true;
|
|
op2list:=[];
|
|
oplist:=[];
|
|
op := A_TRACS;
|
|
oplist:=[A_MOVE]+[A_JSR]+[op];
|
|
op2list:=[A_MOVE]+[A_JSR];
|
|
oplist:=oplist-op2list;
|
|
if oplist <> [A_TRACS] then
|
|
passed := false;
|
|
|
|
oplist:=[A_MOVE]+[A_JSR]+[op];
|
|
op2list:=[A_MOVE]+[A_JSR];
|
|
oplist:=op2list-oplist;
|
|
if oplist <> [] then
|
|
passed := false;
|
|
CheckPassed(passed);
|
|
end;
|
|
|
|
Procedure SetTestSubTwo;
|
|
{ FPC_SET_SUB_SETS }
|
|
const
|
|
b: tasmop = (A_BSR);
|
|
var
|
|
op2list :set of tasmop;
|
|
oplist: set of tasmop;
|
|
op : tasmop;
|
|
passed : boolean;
|
|
Begin
|
|
Write('Complex Set - Set element testing...');
|
|
op := A_BKPT;
|
|
passed := true;
|
|
oplist:=[A_MOVE]+[A_JSR]-[op];
|
|
op2list:=[A_MOVE]+[A_JSR];
|
|
if oplist <> op2list then
|
|
passed := false;
|
|
oplist := [A_MOVE];
|
|
oplist := oplist - [A_MOVE];
|
|
if oplist <> [] then
|
|
passed := false;
|
|
oplist := oplist + [b];
|
|
if oplist <> [b] then
|
|
passed := false;
|
|
oplist := oplist - [b];
|
|
if oplist <> [] then
|
|
passed := false;
|
|
CheckPassed(passed);
|
|
end;
|
|
|
|
|
|
Procedure SetTestMulSets;
|
|
{ FPC_SET_MUL_SETS }
|
|
var
|
|
op2list :set of tasmop;
|
|
oplist: set of tasmop;
|
|
passed : boolean;
|
|
Begin
|
|
passed := true;
|
|
Write('Set * Set element testing...');
|
|
op2list:=[];
|
|
oplist:=[];
|
|
oplist:=[A_MOVE]+[A_JSR];
|
|
op2list:=[A_MOVE];
|
|
oplist:=oplist*op2list;
|
|
if oplist <> [A_JSR] then
|
|
passed := false;
|
|
oplist := [A_MOVE,A_FTST];
|
|
op2list := [A_MOVE,A_FTST];
|
|
oplist := oplist * op2list;
|
|
if oplist <> [A_MOVE,A_FTST] then
|
|
passed := false;
|
|
CheckPassed(passed);
|
|
end;
|
|
|
|
procedure SetTestRange;
|
|
var
|
|
op2list :set of tasmop;
|
|
oplist: set of tasmop;
|
|
passed : boolean;
|
|
op1 : tasmop;
|
|
op2 : tasmop;
|
|
begin
|
|
passed := true;
|
|
Write('Range Set + element testing...');
|
|
op1 := A_ADD;
|
|
op2 := A_ASL;
|
|
oplist := [];
|
|
oplist := [op1..op2];
|
|
if oplist <> constset1[2] then
|
|
passed := false;
|
|
CheckPassed(passed);
|
|
end;
|
|
|
|
procedure SetTestByte;
|
|
var
|
|
op2list :set of tasmop;
|
|
oplist: set of tasmop;
|
|
passed : boolean;
|
|
op1 : tasmop;
|
|
op2 : tasmop;
|
|
op : tasmop;
|
|
begin
|
|
Write('Simple Set + element testing...');
|
|
passed := true;
|
|
op := A_LABEL;
|
|
oplist := [A_MOVE,op,A_JSR];
|
|
if oplist <> [A_MOVE,A_LABEL,A_JSR] then
|
|
passed := false;
|
|
CheckPassed(passed);
|
|
end;
|
|
|
|
|
|
{------------------------------ TESTS FOR SMALL VALUES ---------------------}
|
|
procedure SmallSetTestEqual;
|
|
var
|
|
op2list :set of tsmallenum;
|
|
oplist: set of tsmallenum;
|
|
passed : boolean;
|
|
Begin
|
|
Write('Small Set == Small Set test...');
|
|
passed := true;
|
|
op2list:=[];
|
|
oplist:=[];
|
|
if not (oplist=op2list) then
|
|
passed := false;
|
|
if not (constset3[2] = constset4[2]) then
|
|
passed := false;
|
|
if (constset3[1] = constset4[2]) then
|
|
passed := false;
|
|
if not (constset3[1] = [DA,DD,DM]) then
|
|
passed := false;
|
|
CheckPassed(passed);
|
|
end;
|
|
|
|
procedure SmallSetTestNotEqual;
|
|
var
|
|
op2list :set of tsmallenum;
|
|
oplist: set of tsmallenum;
|
|
passed : boolean;
|
|
Begin
|
|
Write('Small Set <> Small Set test...');
|
|
passed := true;
|
|
op2list:=[];
|
|
oplist:=[];
|
|
if not (oplist=op2list) then
|
|
passed := false;
|
|
if (constset3[2] <> constset4[2]) then
|
|
passed := false;
|
|
if not (constset3[1] <> constset4[2]) then
|
|
passed := false;
|
|
{ if ( [A_ADD] <> [A_ADD] ) then optimized out.
|
|
passed := false;
|
|
if ( [A_BLE..A_BPL] <> [A_BLE..A_BPL] ) then
|
|
passed := false; }
|
|
if (constset3[1] <> [DA,DD,DM]) then
|
|
passed := false;
|
|
CheckPassed(passed);
|
|
end;
|
|
|
|
procedure SmallSetTestLt;
|
|
var
|
|
op2list :set of tsmallenum;
|
|
oplist: set of tsmallenum;
|
|
passed : boolean;
|
|
begin
|
|
Write('Small Set <= Small Set test...');
|
|
passed := true;
|
|
if constset3[1] <= constset4[2] then
|
|
passed := false;
|
|
oplist := [];
|
|
op2list := [DC];
|
|
if op2list <= oplist then
|
|
passed := false;
|
|
oplist := [DC,DF..DM];
|
|
if oplist <= op2list then
|
|
passed := false;
|
|
CheckPassed(passed);
|
|
end;
|
|
|
|
Procedure SmallSetTestAddOne;
|
|
var
|
|
op : tsmallenum;
|
|
oplist: set of tsmallenum;
|
|
Begin
|
|
Write('Small Set + Small Set element testing...');
|
|
op:=DG;
|
|
oplist:=[];
|
|
oplist:=oplist+[op];
|
|
CheckPassed( oplist = [DG] );
|
|
end;
|
|
|
|
Procedure SmallSetTestAddTwo;
|
|
var
|
|
op2list :set of tsmallenum;
|
|
oplist: set of tsmallenum;
|
|
Begin
|
|
Write('Small Complex Set + Small Set element testing...');
|
|
op2list:=[];
|
|
oplist:=[];
|
|
oplist:=[DG]+[DI];
|
|
op2list:=[DM];
|
|
oplist:=op2list+oplist;
|
|
CheckPassed( oplist = [DG,DI,DM] );
|
|
end;
|
|
|
|
|
|
Procedure SmallSetTestSubOne;
|
|
var
|
|
op2list :set of tsmallenum;
|
|
oplist: set of tsmallenum;
|
|
op :tsmallenum;
|
|
passed : boolean;
|
|
Begin
|
|
Write('Small Set - Small Set element testing...');
|
|
passed := true;
|
|
op2list:=[];
|
|
oplist:=[];
|
|
op := DL;
|
|
oplist:=[DG]+[DI]+[op];
|
|
op2list:=[DG]+[DI];
|
|
oplist:=oplist-op2list;
|
|
if oplist <> [DL] then
|
|
passed := false;
|
|
|
|
oplist:=[DG]+[DI]+[op];
|
|
op2list:=[DG]+[DI];
|
|
oplist:=op2list-oplist;
|
|
if oplist <> [] then
|
|
passed := false;
|
|
CheckPassed(passed);
|
|
end;
|
|
|
|
Procedure SmallSetTestSubTwo;
|
|
const
|
|
b: tsmallenum = (DH);
|
|
var
|
|
op2list :set of tsmallenum;
|
|
oplist: set of tsmallenum;
|
|
op : tsmallenum;
|
|
passed : boolean;
|
|
Begin
|
|
Write('Small Complex Set - Small Set element testing...');
|
|
op := DL;
|
|
passed := true;
|
|
oplist:=[DG]+[DI]-[op];
|
|
op2list:=[DG]+[DI];
|
|
if oplist <> op2list then
|
|
passed := false;
|
|
oplist := [DG];
|
|
oplist := oplist - [DG];
|
|
if oplist <> [] then
|
|
passed := false;
|
|
oplist := oplist + [b];
|
|
if oplist <> [b] then
|
|
passed := false;
|
|
oplist := oplist - [b];
|
|
if oplist <> [] then
|
|
passed := false;
|
|
CheckPassed(passed);
|
|
end;
|
|
|
|
|
|
Procedure SmallSetTestMulSets;
|
|
var
|
|
op2list : set of tsmallenum;
|
|
oplist: set of tsmallenum;
|
|
passed : boolean;
|
|
Begin
|
|
passed := true;
|
|
Write('Small Set * Small Set element testing...');
|
|
op2list:=[];
|
|
oplist:=[];
|
|
oplist:=[DG]+[DI];
|
|
op2list:=[DG];
|
|
oplist:=oplist*op2list;
|
|
if oplist <> [DI] then
|
|
passed := false;
|
|
oplist := [DG,DK];
|
|
op2list := [DG,DK];
|
|
oplist := oplist * op2list;
|
|
if oplist <> [DG,DK] then
|
|
passed := false;
|
|
CheckPassed(passed);
|
|
end;
|
|
|
|
procedure SmallSetTestRange;
|
|
var
|
|
op2list :set of tsmallenum;
|
|
oplist: set of tsmallenum;
|
|
passed : boolean;
|
|
op1 : tsmallenum;
|
|
op2 : tsmallenum;
|
|
begin
|
|
passed := true;
|
|
Write('Small Range Set + element testing...');
|
|
op1 := DB;
|
|
op2 := DI;
|
|
oplist := [];
|
|
oplist := [op1..op2];
|
|
if oplist <> constset3[2] then
|
|
passed := false;
|
|
CheckPassed(passed);
|
|
end;
|
|
|
|
procedure SmallSetTestByte;
|
|
var
|
|
op2list : set of tsmallenum;
|
|
oplist: set of tsmallenum;
|
|
passed : boolean;
|
|
op1 : tsmallenum;
|
|
op2 : tsmallenum;
|
|
op : tsmallenum;
|
|
begin
|
|
Write('Small Simple Set + element testing...');
|
|
passed := true;
|
|
op := DD;
|
|
oplist := [DG,op,DI];
|
|
if oplist <> [DG,DD,DI] then
|
|
passed := false;
|
|
CheckPassed(passed);
|
|
end;
|
|
|
|
(*
|
|
|
|
const
|
|
b: myenum = (dA);
|
|
var
|
|
enum: set of myenum;
|
|
oplist: set of tasmop;
|
|
l : word;
|
|
Begin
|
|
SetTestEqual;
|
|
SetTestNotEqual;
|
|
{ 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;
|
|
|
|
*)
|
|
Begin
|
|
WriteLn('----------------------- Normal sets -----------------------');
|
|
{ Normal sets }
|
|
SetTestEqual;
|
|
SetTestNotEqual;
|
|
SetTestAddOne;
|
|
SetTestAddTwo;
|
|
SetTestSubOne;
|
|
SetTestSubTwo;
|
|
SetTestRange;
|
|
SetTestLt;
|
|
SetTestByte;
|
|
{ Small sets }
|
|
WriteLn('----------------------- Small sets -----------------------');
|
|
SmallSetTestEqual;
|
|
SmallSetTestNotEqual;
|
|
SmallSetTestAddOne;
|
|
SmallSetTestAddTwo;
|
|
SmallSetTestSubOne;
|
|
SmallSetTestSubTwo;
|
|
SmallSetTestRange;
|
|
SmallSetTestLt;
|
|
SmallSetTestByte;
|
|
|
|
if Err then
|
|
Halt(1);
|
|
end.
|