compiler/src/test/confidence/language/TestLanguage.mod
2016-09-13 19:44:01 +01:00

298 lines
11 KiB
Modula-2

MODULE TestLanguage;
IMPORT SYSTEM, Console;
VAR gz: LONGREAL;
PROCEDURE TestShiftResult(of, by, actual, expected: LONGINT; msg: ARRAY OF CHAR);
BEGIN
IF actual # expected THEN
Console.String(msg);
Console.String(" of $"); Console.Hex(of);
Console.String(" by "); Console.Int(by,1);
Console.String(" is $"); Console.Hex(actual);
Console.String(" but should be $"); Console.Hex(expected);
Console.Ln;
END
END TestShiftResult;
PROCEDURE Shift;
VAR c: CHAR; b: SYSTEM.BYTE; s,t,u: SHORTINT; h,i,j,k: INTEGER; l,m,n,r: LONGINT;
(*
Aritmetic shift always returns type LONGINT. Defined as x * 2**n.
LSH and ROT produces results of the same type as the value being shifted.
*)
BEGIN
(* Positive LSH shifts and ROTs without overflow *)
i := 0; m := 1;
WHILE i < SIZE(LONGINT)*8 DO
l := 1; r := SYSTEM.LSH(l,i); TestShiftResult(l, i, r, m, "LSH");
l := 1; r := SYSTEM.ROT(l,i); TestShiftResult(l, i, r, m, "ROT(1)");
m := m * 2; INC(i);
END;
i := 0; k := 1;
WHILE i < SIZE(INTEGER)*8 DO
j := 1; j := SYSTEM.LSH(j,i); ASSERT(j = k, 23);
j := 1; j := SYSTEM.ROT(j,i); ASSERT(j = k, 24);
k := k * 2; INC(i);
END;
i := 0; t := 1;
WHILE i < SIZE(SHORTINT)*8 DO
s := 1; s := SYSTEM.LSH(s,i); ASSERT(s = t, 30);
s := 1; s := SYSTEM.ROT(s,i); ASSERT(s = t, 31);
t := t * 2; INC(i);
END;
(* Negative LSH shifts and ROTs without overflow *)
i := -1; m := 1; m := SYSTEM.LSH(m, SIZE(LONGINT)*8 - 2); n := m*2;
WHILE i > -SIZE(LONGINT)*8 DO
l := n; l := SYSTEM.LSH(l,i); ASSERT(l = m, 39);
l := n; l := SYSTEM.ROT(l,i); ASSERT(l = m, 40);
m := m DIV 2; DEC(i);
END;
i := -1; k := 1; k := SYSTEM.LSH(k, SIZE(INTEGER)*8 - 2); h := k*2;
WHILE i > -SIZE(INTEGER)*8 DO
j := h; j := SYSTEM.LSH(j,i); ASSERT(j = k, 46);
j := h; j := SYSTEM.ROT(j,i); ASSERT(j = k, 47);
k := k DIV 2; DEC(i);
END;
i := -1; t := 1; t := SYSTEM.LSH(t, SIZE(SHORTINT)*8 - 2); u := t*2;
WHILE i > -SIZE(SHORTINT)*8 DO
s := u; s := SYSTEM.LSH(s,i); ASSERT(s = t, 53);
s := u; s := SYSTEM.ROT(s,i); ASSERT(s = t, 54);
t := t DIV 2; DEC(i);
END;
(* Positive ASHs of a negative number *)
i := 0; m := 1; m := SYSTEM.LSH(m, SIZE(LONGINT)*8 - 1); n := m;
WHILE i > -SIZE(LONGINT)*8 DO
l := n; l := ASH(l,i); ASSERT(l = m, 62);
m := m DIV 2; DEC(i);
END;
i := 0; j := 1; j := SYSTEM.LSH(j, SIZE(INTEGER)*8 - 1); k := j;
WHILE i > -SIZE(INTEGER)*8 DO
l := ASH(j,i); ASSERT(l = LONG(k), 68);
k := k DIV 2; DEC(i);
END;
i := 0; s := 1; s := SYSTEM.LSH(s, SIZE(SHORTINT)*8 - 1); t := s;
WHILE i > -SIZE(SHORTINT)*8 DO
l := ASH(s,i); ASSERT(l = LONG(LONG(t)), 74);
t := t DIV 2; DEC(i);
END;
(* Positive ASHs of a positive number *)
i := 0; m := 1; m := SYSTEM.LSH(m, SIZE(LONGINT)*8 - 2); n := m;
WHILE i > 1-SIZE(LONGINT)*8 DO
l := n; l := ASH(l,i); ASSERT(l = m, 82);
m := m DIV 2; DEC(i);
END;
(* Positive LSH shifts and ROTs with overflow *)
i := 1; m := 1;
WHILE i < SIZE(LONGINT)*8 DO
l := MAX(LONGINT); INC(l); r := SYSTEM.LSH(l,i); TestShiftResult(l, i, r, 0, "LSH");
l := MAX(LONGINT); INC(l); r := SYSTEM.ROT(l,i); TestShiftResult(l, i, r, m, "ROT(2)");
m := m * 2; INC(i);
END;
i := 1; k := 1;
WHILE i < SIZE(INTEGER)*8 DO
j := MAX(INTEGER); INC(j); r := SYSTEM.LSH(j,i); TestShiftResult(j, i, r, 0, "LSH");
j := MAX(INTEGER); INC(j); r := SYSTEM.ROT(j,i); TestShiftResult(j, i, r, k, "ROT(3)");
k := k * 2; INC(i);
END;
i := 1; t := 1;
WHILE i < SIZE(SHORTINT)*8 DO
s := MAX(SHORTINT); INC(s); r := SYSTEM.LSH(s,i); TestShiftResult(s, i, r, 0, "LSH");
s := MAX(SHORTINT); INC(s); r := SYSTEM.ROT(s,i); TestShiftResult(s, i, r, t, "ROT(4)");
t := t * 2; INC(i);
END;
(* Negative LSH shifts and ROTs without overflow *)
i := -1; m := MAX(LONGINT); INC(m);
WHILE i > -SIZE(LONGINT)*8 DO
l := 1; r := SYSTEM.LSH(l,i); TestShiftResult(l, i, r, 0, "LSH");
l := 1; r := SYSTEM.ROT(l,i); TestShiftResult(l, i, r, m, "ROT");
m := SYSTEM.LSH(m,-1); (* m := m DIV 2; *)
DEC(i);
END;
i := -1; k := MAX(INTEGER); INC(k);
WHILE i > -SIZE(INTEGER)*8 DO
j := 1; r := SYSTEM.LSH(j,i); TestShiftResult(j, i, r, 0, "LSH");
j := 1; r := SYSTEM.ROT(j,i); TestShiftResult(j, i, r, k, "ROT");
k := SYSTEM.LSH(k,-1); (* k := k DIV 2; *)
DEC(i);
END;
i := -1; t := MAX(SHORTINT); INC(t);
WHILE i > -SIZE(SHORTINT)*8 DO
s := 1; r := SYSTEM.LSH(s,i); TestShiftResult(s, i, r, 0, "LSH");
s := 1; r := SYSTEM.ROT(s,i); TestShiftResult(s, i, r, t, "ROT");
t := SYSTEM.LSH(t,-1); (* t := t DIV 2; *)
DEC(i);
END;
(* Also need full tests for CHAR, and poossibly SYSTEM.BYTE. Here's a simple one *)
c := 1X; c := SYSTEM.LSH(c,2); c := SYSTEM.ROT(c,-2); ASSERT(c=1X, 93);
b := 1; b := SYSTEM.LSH(b,2); b := SYSTEM.ROT(b,-2); ASSERT(SYSTEM.VAL(CHAR,b)=1X, 94);
END Shift;
PROCEDURE TestValue(v,e: LONGINT; name: ARRAY OF CHAR);
BEGIN
IF v # e THEN
Console.String(name);
Console.String(" = ");
Console.Int(v,1);
Console.String(", expected ");
Console.Int(e,1);
Console.Ln;
END
END TestValue;
PROCEDURE side(i: INTEGER): INTEGER; BEGIN RETURN i END side;
PROCEDURE DivMod;
VAR i,j: INTEGER;
BEGIN
j := 2;
i := 4; TestValue(i DIV j, 2, "4 DIV 2"); TestValue(side(i) DIV side(j), 2, "side(4) DIV side(2)");
i := 5; TestValue(i DIV j, 2, "5 DIV 2"); TestValue(side(i) DIV side(j), 2, "side(5) DIV side(2)");
i := 6; TestValue(i DIV j, 3, "6 DIV 2"); TestValue(side(i) DIV side(j), 3, "side(6) DIV side(2)");
i := 7; TestValue(i DIV j, 3, "7 DIV 2"); TestValue(side(i) DIV side(j), 3, "side(7) DIV side(2)");
i := -4; TestValue(i DIV j, -2, "(-4) DIV 2"); TestValue(side(i) DIV side(j), -2, "side(-4) DIV side(2)");
i := -5; TestValue(i DIV j, -3, "(-5) DIV 2"); TestValue(side(i) DIV side(j), -3, "side(-5) DIV side(2)");
i := -6; TestValue(i DIV j, -3, "(-6) DIV 2"); TestValue(side(i) DIV side(j), -3, "side(-6) DIV side(2)");
i := -7; TestValue(i DIV j, -4, "(-7) DIV 2"); TestValue(side(i) DIV side(j), -4, "side(-7) DIV side(2)");
j := -2;
i := 4; TestValue(i DIV j, -2, "4 DIV (-2)"); TestValue(side(i) DIV side(j), -2, "side(4) DIV side(-2)");
i := 5; TestValue(i DIV j, -3, "5 DIV (-2)"); TestValue(side(i) DIV side(j), -3, "side(5) DIV side(-2)");
i := 6; TestValue(i DIV j, -3, "6 DIV (-2)"); TestValue(side(i) DIV side(j), -3, "side(6) DIV side(-2)");
i := 7; TestValue(i DIV j, -4, "7 DIV (-2)"); TestValue(side(i) DIV side(j), -4, "side(7) DIV side(-2)");
i := -4; TestValue(i DIV j, 2, "(-4) DIV (-2)"); TestValue(side(i) DIV side(j), 2, "side(-4) DIV side(-2)");
i := -5; TestValue(i DIV j, 2, "(-5) DIV (-2)"); TestValue(side(i) DIV side(j), 2, "side(-5) DIV side(-2)");
i := -6; TestValue(i DIV j, 3, "(-6) DIV (-2)"); TestValue(side(i) DIV side(j), 3, "side(-6) DIV side(-2)");
i := -7; TestValue(i DIV j, 3, "(-7) DIV (-2)"); TestValue(side(i) DIV side(j), 3, "side(-7) DIV side(-2)");
(* x = (x DIV y) * y + (x MOD y)
=> x MOd y = x - ((x DIV y) * y)
*)
i := 4; j := 3; TestValue(i MOD j, i - ((i DIV j) * j), "4 MOD 3");
i := 5; j := 3; TestValue(i MOD j, i - ((i DIV j) * j), "5 MOD 3");
i := 6; j := 3; TestValue(i MOD j, i - ((i DIV j) * j), "6 MOD 3");
i := 7; j := 3; TestValue(i MOD j, i - ((i DIV j) * j), "7 MOD 3");
i := -4; j := 3; TestValue(i MOD j, i - ((i DIV j) * j), "-4 MOD 3");
i := -5; j := 3; TestValue(i MOD j, i - ((i DIV j) * j), "-5 MOD 3");
i := -6; j := 3; TestValue(i MOD j, i - ((i DIV j) * j), "-6 MOD 3");
i := -7; j := 3; TestValue(i MOD j, i - ((i DIV j) * j), "-7 MOD 3");
i := 4; j := -3; TestValue(i MOD j, i - ((i DIV j) * j), "4 MOD -3");
i := 5; j := -3; TestValue(i MOD j, i - ((i DIV j) * j), "5 MOD -3");
i := 6; j := -3; TestValue(i MOD j, i - ((i DIV j) * j), "6 MOD -3");
i := 7; j := -3; TestValue(i MOD j, i - ((i DIV j) * j), "7 MOD -3");
i := -4; j := -3; TestValue(i MOD j, i - ((i DIV j) * j), "-4 MOD -3");
i := -5; j := -3; TestValue(i MOD j, i - ((i DIV j) * j), "-5 MOD -3");
i := -6; j := -3; TestValue(i MOD j, i - ((i DIV j) * j), "-6 MOD -3");
i := -7; j := -3; TestValue(i MOD j, i - ((i DIV j) * j), "-7 MOD -3");
END DivMod;
PROCEDURE Abs;
VAR
i: INTEGER;
l: LONGINT;
h: SYSTEM.INT64;
BEGIN
i := 5; TestValue(ABS(i), 5, "ABS(INTEGER 5)");
i := -5; TestValue(ABS(i), 5, "ABS(INTEGER -5)");
l := 5; TestValue(ABS(l), 5, "ABS(LONGINT 5)");
l := -5; TestValue(ABS(l), 5, "ABS(LONGINT -5)");
h := 5; TestValue(SYSTEM.VAL(LONGINT,ABS(h)), 5, "ABS(SYSTEM.INT64 5)");
h := -5; TestValue(SYSTEM.VAL(LONGINT,ABS(h)), 5, "ABS(SYSTEM.INT64 -5)");
END Abs;
(* LR does nothing numerically, but is enough to stop the C compiler
optimizing away the LR assignment and ENTIER implementation. *)
PROCEDURE LR(lr: LONGREAL): LONGREAL; BEGIN RETURN lr + gz; END LR;
PROCEDURE Entier;
VAR lr: LONGREAL;
BEGIN
gz := 0.0;
lr := LR(-0.01); TestValue(ENTIER(lr), -1, "ENTIER(-0.01");
lr := LR( 0.00); TestValue(ENTIER(lr), 0, "ENTIER(0.00");
lr := LR( 5.00); TestValue(ENTIER(lr), 5, "ENTIER(5.00");
lr := LR( 5.50); TestValue(ENTIER(lr), 5, "ENTIER(5.50");
lr := LR( 5.99); TestValue(ENTIER(lr), 5, "ENTIER(5.99");
lr := LR(-5.00); TestValue(ENTIER(lr), -5, "ENTIER(-5.00");
lr := LR(-5.50); TestValue(ENTIER(lr), -6, "ENTIER(-5.50");
lr := LR(-5.99); TestValue(ENTIER(lr), -6, "ENTIER(-5.99");
END Entier;
PROCEDURE IntSize;
VAR l: LONGINT;
BEGIN
TestValue(MIN(SHORTINT), -80H, "MIN(SHORTINT)");
TestValue(MAX(SHORTINT), 7FH, "MAX(SHORTINT)");
IF SIZE(INTEGER) = 2 THEN (* 32 bit machine *)
TestValue(MIN(INTEGER), -7FFFH - 1, "MIN(INTEGER)");
TestValue(MAX(INTEGER), 7FFFH, "MAX(INTEGER)");
TestValue(MIN(LONGINT), -7FFFFFFFH - 1, "MIN(LONGINT)");
TestValue(MAX(LONGINT), 7FFFFFFFH, "MAX(LONGINT)");
ELSIF SIZE(INTEGER) = 4 THEN (* 64 bit machine *)
TestValue(MIN(INTEGER), -7FFFFFFFH - 1, "MIN(INTEGER)");
TestValue(MAX(INTEGER), 7FFFFFFFH, "MAX(INTEGER)");
(* Since we need to be compilable on 32 bit machines we cannot use
a 64 bit constant, so use arithmetic. *)
l := 1; l := SYSTEM.LSH(l, 63); l := l-1; (* Generate l = 7FFFFFFFFFFFFFFFH *)
TestValue(MIN(LONGINT), -l - 1, "MIN(LONGINT)");
TestValue(MAX(LONGINT), l, "MAX(LONGINT)");
ELSE
Console.String("SIZE(INTEGER) = ");
Console.Int(SIZE(INTEGER),1);
Console.String(", expected 2 or 4.");
Console.Ln;
END;
END IntSize;
BEGIN
Shift;
DivMod;
IntSize;
Abs;
Entier;
Console.String("Language tests successful."); Console.Ln;
END TestLanguage.