M2compiler-V3/compiler/tests/showcase24.mod

MODULE Showcase24;
// Multi-file session showcase.  Combines:
//   * ISO generic modules: GStack(T) instantiated as IntStack, and the
//     two-parameter GPair(K, V) instantiated as PairIC(INTEGER, CHAR),
//   * a Clarion CLASS hierarchy with VIRTUAL dispatch (Shape/Circle/
//     Square) held through base-class pointers,
//   * stdlib libraries: TextIO, Strings, Conversions, Math,
//   * a local helper library, Show24Util.
//
// Pushes each shape's virtual Area() onto the generic stack, pops and
// sums them (9+16+16+1 = 42), builds "showcase24 total=42" in
// Show24Util (Strings + Conversions), reverses it through the same
// generic stack, checks a real sqrt via Math and a pair via PairIC.
// Prints the label and exits 42.
IMPORT TextIO, Strings, IntStack, PairIC, Show24Util;

TYPE
  CLASS Shape;
    VIRTUAL PROCEDURE Area() : INTEGER;
  END Shape;

  CLASS Circle (Shape);
    r : INTEGER;
    PROCEDURE SetR(v : INTEGER);
    VIRTUAL PROCEDURE Area() : INTEGER;
  END Circle;

  CLASS Square (Shape);
    s : INTEGER;
    PROCEDURE SetS(v : INTEGER);
    VIRTUAL PROCEDURE Area() : INTEGER;
  END Square;

CLASS IMPLEMENTATION Shape;
  PROCEDURE Area() : INTEGER;
  BEGIN RETURN 0 END Area;
END Shape;

CLASS IMPLEMENTATION Circle;
  PROCEDURE SetR(v : INTEGER);
  BEGIN r := v END SetR;
  PROCEDURE Area() : INTEGER;
  BEGIN RETURN r * r END Area;
END Circle;

CLASS IMPLEMENTATION Square;
  PROCEDURE SetS(v : INTEGER);
  BEGIN s := v END SetS;
  PROCEDURE Area() : INTEGER;
  BEGIN RETURN s * s END Area;
END Square;

VAR ExitCode : INTEGER;
VAR a, b : POINTER TO Circle;
VAR c, d : POINTER TO Square;
VAR shapes : ARRAY [0 .. 3] OF POINTER TO Shape;
VAR st : IntStack.Stack;
VAR line, rev : ARRAY [0 .. 63] OF CHAR;
VAR i, n, total, v : INTEGER;
VAR ch : CHAR;
VAR ok : BOOLEAN;

BEGIN
  ExitCode := 0;

  (* four polymorphic shapes: Circle(3)=9, Circle(4)=16,
     Square(4)=16, Square(1)=1 -> 42 *)
  NEW(a); a^.SetR(3);
  NEW(b); b^.SetR(4);
  NEW(c); c^.SetS(4);
  NEW(d); d^.SetS(1);
  shapes[0] := a; shapes[1] := b; shapes[2] := c; shapes[3] := d;

  (* generic stack: push each virtual Area(), then pop and sum *)
  IntStack.Init(st);
  i := 0;
  WHILE i <= 3 DO
    IntStack.Push(st, shapes[i]^.Area());
    INC(i)
  END;
  IF IntStack.Depth(st) # 4 THEN ExitCode := 1 END;

  total := 0;
  WHILE IntStack.Pop(st, v) DO total := total + v END;

  (* helper library: line = "showcase24 total=" + IntToStr(total) *)
  Show24Util.Label("showcase24 total=", total, line);

  (* reverse the label through the same generic stack *)
  n := Strings.Length(line);
  IntStack.Init(st);
  i := 0;
  WHILE i < n DO
    IntStack.Push(st, ORD(line[i]));
    INC(i)
  END;
  i := 0; ok := TRUE;
  WHILE ok DO
    ok := IntStack.Pop(st, v);
    IF ok THEN rev[i] := CHR(v); INC(i) END
  END;
  rev[i] := CHR(0);
  IF (n # 19) OR (rev[0] # "2") OR (rev[n - 1] # "s") THEN ExitCode := 1 END;

  (* two-parameter generic: PairIC = GPair(INTEGER, CHAR) *)
  IF PairIC.First(total, "!") # 42 THEN ExitCode := 1 END;
  ch := PairIC.Second(total, "!");
  IF ch # "!" THEN ExitCode := 1 END;

  (* real math through the Math library *)
  IF Show24Util.Root(42) # 6 THEN ExitCode := 1 END;

  TextIO.WriteString(line);
  TextIO.WriteLn;

  IF total = 42 THEN ExitCode := ExitCode + 42 ELSE ExitCode := 99 END
END Showcase24.