home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / Pascal / BPASCAL.700 / LIB / TESTPRGS.ZIP / SETTEST.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-02-14  |  3.6 KB  |  147 lines
  1. PROGRAM SetTest;  { Copyright (c) 1992,1993 Norbert Juffa }
  2.  
  3. USES Time;
  4.  
  5. VAR Box1, Box2:         ARRAY [0..255] OF BYTE;
  6.     OneWOTwo, TwoWOOne,
  7.     UnionSet, InterSet,
  8.     Set1, Set2, Set3:   SET OF BYTE;
  9.     K, MaxNr, L,
  10.     N, Low, Hi:         INTEGER;
  11.     Start:              LONGINT;
  12.  
  13. BEGIN
  14.    WriteLn ('Set operators functional and speed test');
  15.    WriteLn;
  16.  
  17.    RandSeed := 17;
  18.  
  19.    FOR L := 0 TO 255 DO BEGIN
  20.       Box1 [L] := L;
  21.    END;
  22.    MaxNr := 255;
  23.    FOR L := 0 TO 255 DO BEGIN
  24.       K := Random (MaxNr+1);
  25.       Box2 [L] := Box1 [K];
  26.       Box1 [K] := Box1 [MaxNr];
  27.       Dec (MaxNr);
  28.    END;
  29.  
  30.    Start := Clock;
  31.  
  32.    Set1 := [];
  33.    Set2 := [];
  34.    FOR L := 0 TO 255 DO BEGIN
  35.       Set1 := Set1 + [Box2 [L]];
  36.       IF NOT (Box2 [L] IN Set1) THEN BEGIN
  37.          WriteLn ('error in AddElem or InSet functions');
  38.          Halt;
  39.          END;
  40.       Set2 := Set2 + [Box2 [L]] + [];
  41.    END;
  42.  
  43.    IF (Set1 <> Set2) OR (NOT (Set1 <= Set2)) OR (NOT (Set1 >= Set2)) THEN BEGIN
  44.       WriteLn ('error in relational operators 1');
  45.       Halt;
  46.       END;
  47.  
  48.    FOR L := 0 TO 255 DO BEGIN
  49.       Set1 := Set1 - [Box2 [L]];
  50.       IF Box2 [L] IN Set1 THEN BEGIN
  51.          WriteLn ('error in set difference 1');
  52.          Halt;
  53.          END;
  54.    END;
  55.  
  56.    IF Set1 <> [] THEN BEGIN
  57.       WriteLn ('error in set difference 2');
  58.       Halt;
  59.       END;
  60.  
  61.    FOR L := 1 TO 10000 DO BEGIN
  62.       REPEAT
  63.          Low := Random (256);
  64.          Hi  := Random (256);
  65.       UNTIL Low <= Hi;
  66.  
  67.       Set1 := [];
  68.       Set1 := Set1 + [Low..Hi];
  69.       FOR K := 0 TO 255 DO BEGIN
  70.          IF (K IN Set1) AND ((K < Low) OR (K > Hi)) THEN BEGIN
  71.             WriteLn ('wrong set inclusion in add range');
  72.             Halt;
  73.             END;
  74.          IF (NOT (K IN Set1)) AND ((K >= Low) AND (K <= Hi)) THEN BEGIN
  75.             WriteLn ('wrong set exclusion in add range');
  76.             Halt;
  77.             END;
  78.       END;
  79.    END;
  80.  
  81.    FOR L := 1 TO 10000 DO BEGIN
  82.       Set1 := [];
  83.       Set2 := [];
  84.  
  85.       FOR K := 1 TO 10 DO BEGIN
  86.          Low := Random (256);
  87.          Hi  := Random (256);
  88.          Set2:= Set1 + [Low..Hi];
  89.          IF (Set1 >= Set2) AND (Set1 <> Set2) THEN BEGIN
  90.             WriteLn ('error in relational operators 2');
  91.             Halt;
  92.             END;
  93.          IF NOT (Set1 <= Set2) THEN BEGIN
  94.             WriteLn ('error in relational operators 3');
  95.             Halt;
  96.             END;
  97.          Set1 := Set2;
  98.  
  99.       END;
  100.    END;
  101.  
  102.    FOR L := 1 TO 10000 DO BEGIN
  103.       Set1 := [];
  104.       FOR K := 1 TO 10 DO BEGIN
  105.          Low := Random (256);
  106.          Hi  := Random (256);
  107.          Set1:= Set1 + [Low..Hi];
  108.       END;
  109.       Set2 := [];
  110.       FOR K := 1 TO 10 DO BEGIN
  111.          Low := Random (256);
  112.          Hi  := Random (256);
  113.          Set2:= Set2 + [Low..Hi];
  114.       END;
  115.  
  116.       OneWOTwo := Set1 - Set2;
  117.       TwoWOOne := Set2 - Set1;
  118.       InterSet := Set1 * Set2;
  119.       UnionSet := Set1 + Set2;
  120.  
  121.       IF InterSet <> (Set2 * Set1) THEN BEGIN
  122.          WriteLn ('error in set difference');
  123.          Halt;
  124.          END;
  125.  
  126.       IF (InterSet + OneWOTwo) <> Set1 THEN BEGIN
  127.          WriteLn ('error in set difference or intersection');
  128.          Halt;
  129.          END;
  130.  
  131.       IF (InterSet + TwoWOOne) <> Set2 THEN BEGIN
  132.          WriteLn ('error in set difference or intersection');
  133.          Halt;
  134.          END;
  135.  
  136.       IF (OneWOTwo + TwoWOOne + InterSet) <> UnionSet THEN BEGIN
  137.          WriteLn ('error in set union, intersection or difference');
  138.          Halt;
  139.          END;
  140.  
  141.    END;
  142.  
  143.    WriteLn ('Set test completes in ', (Clock-Start)*1e-3:0:3, ' seconds');
  144.  
  145. END.
  146.  
  147.