1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
|
{
Program to test set functions
}
{$define FPC_HAS_SET_INEQUALITIES}
program TestSet;
Procedure InitMSTimer;
begin
end;
{Get MS Timer}
Function MSTimer:longint;
begin
MSTimer:=0;
end;
const
Lval=2000;
VAR Box1, Box2: ARRAY [0..255] OF BYTE;
OneWOTwo, TwoWOOne,
UnionSet, InterSet,
Set1, Set2, Set3: SET OF BYTE;
K, MaxNr, L,
N, Low, Hi: INTEGER;
Start: LONGINT;
begin
WriteLn ('Set operators functional and speed test');
WriteLn;
RandSeed := 17;
for L := 0 TO 255 DO begin
Box1 [L] := L;
end;
MaxNr := 255;
for L := 0 TO 255 DO begin
K := Random (MaxNr+1);
Box2 [L] := Box1 [K];
Box1 [K] := Box1 [MaxNr];
Dec (MaxNr);
end;
Start :=MSTimer;
Set1 := [];
Set2 := [];
for L := 0 TO 255 DO begin
Set1 := Set1 + [Box2 [L]];
if NOT (Box2 [L] IN Set1) then begin
WriteLn ('error in AddElem or InSet functions');
Halt;
end;
Set2 := Set2 + [Box2 [L]] + [];
end;
{$ifdef FPC_HAS_SET_INEQUALITIES }
if (Set1 <> Set2) OR (NOT (Set1 <= Set2)) OR (NOT (Set1 >= Set2)) then begin
{$else FPC_HAS_SET_INEQUALITIES }
if (Set1 <> Set2) then begin
{$endif FPC_HAS_SET_INEQUALITIES }
WriteLn ('error in relational operators 1');
Halt;
end;
for L := 0 TO 255 DO begin
Set1 := Set1 - [Box2 [L]];
if Box2 [L] IN Set1 then begin
WriteLn ('error in set difference 1');
Halt;
end;
end;
if Set1 <> [] then begin
WriteLn ('error in set difference 2');
Halt;
end;
for L := 1 TO LVal DO begin
REPEAT
Low := Random (256);
Hi := Random (256);
UNTIL Low <= Hi;
Set1 := [];
Set1 := Set1 + [Low..Hi];
for K := 0 TO 255 DO begin
if (K IN Set1) AND ((K < Low) OR (K > Hi)) then begin
WriteLn ('wrong set inclusion in add range');
Halt;
end;
if (NOT (K IN Set1)) AND ((K >= Low) AND (K <= Hi)) then begin
WriteLn ('wrong set exclusion in add range');
Halt;
end;
end;
end;
for L := 1 TO LVal DO begin
Set1 := [];
Set2 := [];
for K := 1 TO 10 DO begin
Low := Random (256);
Hi := Random (256);
Set2:= Set1 + [Low..Hi];
{$ifdef FPC_HAS_SET_INEQUALITIES }
if (Set1 >= Set2) AND (Set1 <> Set2) then begin
{$else FPC_HAS_SET_INEQUALITIES }
if (Set1 <> Set2) then begin
{$endif FPC_HAS_SET_INEQUALITIES }
WriteLn ('error in relational operators 2');
Halt;
end;
{$ifdef FPC_HAS_SET_INEQUALITIES }
if NOT (Set1 <= Set2) then begin
WriteLn ('error in relational operators 3');
Halt;
end;
{$endif FPC_HAS_SET_INEQUALITIES }
Set1 := Set2;
end;
end;
for L := 1 TO LVal DO begin
Set1 := [];
for K := 1 TO 10 DO begin
Low := Random (256);
Hi := Random (256);
Set1:= Set1 + [Low..Hi];
end;
Set2 := [];
for K := 1 TO 10 DO begin
Low := Random (256);
Hi := Random (256);
Set2:= Set2 + [Low..Hi];
end;
OneWOTwo := Set1 - Set2;
TwoWOOne := Set2 - Set1;
InterSet := Set1 * Set2;
UnionSet := Set1 + Set2;
if InterSet <> (Set2 * Set1) then begin
WriteLn ('error in set difference');
Halt;
end;
if (InterSet + OneWOTwo) <> Set1 then begin
WriteLn ('error in set difference or intersection');
Halt;
end;
if (InterSet + TwoWOOne) <> Set2 then begin
WriteLn ('error in set difference or intersection');
Halt;
end;
if (OneWOTwo + TwoWOOne + InterSet) <> UnionSet then begin
WriteLn ('error in set union, intersection or difference');
Halt;
end;
end;
Start:=MSTimer-Start;
WriteLn('Set test completes in ',Start,' ms');
end.
|
