M2compiler-V3/compiler/tests/t_packedset.mod

MODULE TPackedSet;
// ISO PACKEDSET: 1/2/4-byte storage, INCL/EXCL/IN, ORD, elements in
// records/arrays, value and VAR parameters, set operations. Exit 42.
TYPE
  Small  = PACKEDSET OF [0..7];
  Wide2  = PACKEDSET OF [0..15];
  Wide4  = PACKEDSET OF [0..31];
  Colour = (red, blue, green, yellow, cyan, purple, black);
  CS     = PACKEDSET OF Colour;
  Rec    = RECORD
             s  : Small;
             tag: CARDINAL;
           END;
  Arr    = ARRAY [0..3] OF Small;
  Set8   = SET OF [0..7];
CONST SC = Small{1, 2};
VAR ExitCode : INTEGER;
VAR s, t : Small;
VAR w2 : Wide2;
VAR w4 : Wide4;
VAR c : CS;
VAR r : Rec;
VAR a, b : Arr;
VAR n : Set8;
VAR i : INTEGER;
PROCEDURE Take (x: Small) : CARDINAL;
BEGIN
  RETURN ORD(x)
END Take;
PROCEDURE AddTo (VAR x: Small; v: CARDINAL);
BEGIN
  INCL(x, v)
END AddTo;
PROCEDURE Has2 (x: Set8) : BOOLEAN;
BEGIN
  RETURN 2 IN x
END Has2;
PROCEDURE TakePacked (x: Small) : CARDINAL;
BEGIN
  RETURN ORD(x)
END TakePacked;
BEGIN
  i := 0;
  s := Small{};
  t := Small{1, 2};
  AddTo(s, 3);
  EXCL(t, 1);
  IF (3 IN s) AND NOT (2 IN s) AND NOT (1 IN s) THEN i := i + 1 END;
  IF (2 IN t) AND NOT (1 IN t) THEN i := i + 2 END;
  c := CS{red, purple};
  IF (red IN c) AND (purple IN c) AND NOT (blue IN c) THEN i := i + 4 END;
  r.s := Small{7};
  INCL(r.s, 6);
  r.tag := 99;
  IF (6 IN r.s) AND (7 IN r.s) AND (r.tag = 99) THEN i := i + 8 END;
  a[0] := Small{1}; a[1] := Small{2}; a[2] := Small{3}; a[3] := Small{4};
  a[2] := Small{};
  IF (4 IN a[3]) AND NOT (3 IN a[2]) THEN i := i + 16 END;
  IF (ORD(SC) = 6) AND (2 IN SC) THEN i := i + 3 END;
  b := a;
  IF (4 IN b[3]) AND NOT (3 IN b[2]) THEN i := i + 5 END;
  s := t + Small{4};                 (* union, assigned back to packed *)
  n := s;                            (* packed -> normal representation *)
  IF (2 IN s) AND (4 IN s) AND (2 IN n) AND (4 IN n)
     AND Has2(s) AND (TakePacked(Set8{2}) = 4) THEN i := i + 3 END;
  w2 := Wide2{15};
  w4 := Wide4{31};
  IF (ORD(Small{2..5}) = 60)
     AND (SIZE(Small) = 1) AND (SIZE(Wide2) = 2) AND (SIZE(Wide4) = 4)
     AND (SIZE(s) = 1) AND (SIZE(w2) = 2) AND (SIZE(w4) = 4)
     AND (15 IN w2) AND (31 IN w4)
     AND (Take(s) = ORD(s)) THEN
    ExitCode := i
  ELSE
    ExitCode := 1
  END
END TPackedSet.