M2compiler-V3/compiler/tests/showcase18.mod

MODULE Showcase18;
// Session showcase: VIRTUAL dispatch through vtables.
//
// A Shape hierarchy (Circle, Square) with a virtual Area(); an array
// of base-class pointers holds objects of both kinds, and each Area()
// is resolved at run time. The sum is asserted and printed.
// Expected ExitCode: 42.
IMPORT TextIO, Conversions;

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 shapes : ARRAY [0 .. 5] OF POINTER TO Shape;
VAR a, b : POINTER TO Circle;
VAR c, d : POINTER TO Square;
VAR e : POINTER TO Circle;
VAR f : POINTER TO Square;
VAR line, num : ARRAY [0 .. 63] OF CHAR;
VAR i, total : INTEGER;

BEGIN
  ExitCode := 0;
  NEW(a); a^.SetR(3);          (* 9  *)
  NEW(b); b^.SetR(5);          (* 25 *)
  NEW(c); c^.SetS(4);          (* 16 *)
  NEW(d); d^.SetS(6);          (* 36 *)
  NEW(e); e^.SetR(2);          (* 4  *)
  NEW(f); f^.SetS(7);          (* 49 *)

  shapes[0] := a; shapes[1] := b; shapes[2] := c;
  shapes[3] := d; shapes[4] := e; shapes[5] := f;

  total := 0;
  i := 0;
  WHILE i <= 5 DO
    total := total + shapes[i]^.Area();   (* virtual dispatch *)
    INC(i)
  END;

  Conversions.IntToStr(total, num);
  line := "showcase18 areas sum=" + num;
  TextIO.WriteString(line);
  TextIO.WriteLn;

  IF total = 139 THEN ExitCode := 42 ELSE ExitCode := 1 END
END Showcase18.