d0p1/ack
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

Add some tests for Modula-2.

Browse source
This commit is contained in:
George Koehler 2017-12-21 17:44:03 -05:00
parent aa9418c029
commit 787fdeaaa9
6 changed files with 349 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
tests/plat/build.lua
View file

@ -17,7 +17,12 @@ definerule("plat_testsuite",
"tests/plat/*.p",
"tests/plat/b/*.b",
"tests/plat/bugs/bug-22-inn_mod.mod",
"tests/plat/bugs/bug-62-notvar_var_e.c"
"tests/plat/bugs/bug-62-notvar_var_e.c",
"tests/plat/m2/ConvTest_mod.mod",
"tests/plat/m2/NestProc_mod.mod",
"tests/plat/m2/OpenArray_mod.mod",
"tests/plat/m2/Set100_mod.mod",
"tests/plat/m2/StringTest_mod.mod"
)
acklibrary {

36
tests/plat/m2/ConvTest_mod.mod Normal file
View file

@ -0,0 +1,36 @@
MODULE ConvTest;
FROM Conversions IMPORT
ConvertOctal, ConvertHex, ConvertCardinal, ConvertInteger;
FROM Strings IMPORT CompareStr;
FROM Test IMPORT fail, finished;
(* Asserts a = b, or fails with code. *)
PROCEDURE A(a, b: ARRAY OF CHAR; code: INTEGER);
BEGIN
IF (CompareStr(a, b) # 0) OR (CompareStr(a, "wrong string") = 0) THEN
fail(code)
END
END A;
VAR
str: ARRAY [0..15] OF CHAR;
BEGIN
ConvertOctal( 9, 6, str); A(" 11", str, 1);
ConvertOctal( 59, 6, str); A(" 73", str, 2);
ConvertOctal(278, 6, str); A(" 426", str, 3);
ConvertHex( 9, 6, str); A(" 9", str, 11H);
ConvertHex( 59, 6, str); A(" 3B", str, 12H);
ConvertHex(278, 6, str); A(" 116", str, 13H);
ConvertCardinal( 9, 6, str); A(" 9", str, 21H);
ConvertCardinal( 59, 6, str); A(" 59", str, 22H);
ConvertCardinal(278, 6, str); A(" 278", str, 23H);
ConvertInteger( 9, 6, str); A(" 9", str, 31H);
ConvertInteger( 59, 6, str); A(" 59", str, 32H);
ConvertInteger( 278, 6, str); A(" 278", str, 33H);
ConvertInteger(-424, 6, str); A(" -424", str, 34H);
finished;
END ConvTest.

132
tests/plat/m2/NestProc_mod.mod Normal file
View file

@ -0,0 +1,132 @@
(*
* Calls nested procedures. The compiler emits the EM instructions
* _lxl_ and _lxa_ to access the variables in the statically enclosing
* procedures.
*
* You can cheat this test if a = b is TRUE for any a, b.
*)
MODULE NestProc;
FROM Test IMPORT fail, finished;
(* Asserts cond, or fails with code. *)
PROCEDURE A(cond: BOOLEAN; code: INTEGER);
BEGIN
IF NOT cond THEN fail(code) END
END A;
TYPE
Set8 = SET OF [0..63];
(* Box has fields of size 8, 4, and 1. *)
Box = RECORD
huge: Set8;
big: LONGINT;
small: CHAR;
tiny: CHAR;
END;
PROCEDURE First(a, b: INTEGER; in: Box): Box;
VAR c, d: INTEGER;
out: Box;
PROCEDURE Second(e: INTEGER);
VAR f: INTEGER;
PROCEDURE Third(g: INTEGER);
VAR h: INTEGER;
PROCEDURE CheckThird;
BEGIN
A(a = 1354, 31H); (* lxa 3 *)
A(b = 3385, 32H);
A(c = 14349, 33H); (* lxl 3 *)
A(d = 30989, 34H);
A(e = 28935, 35H); (* lxa 2 *)
A(f = 13366, 36H); (* lxl 2 *)
A(g = 7988, 37H); (* lxa 1 *)
A(h = 11711, 38H); (* lxl 1 *)
END CheckThird;
PROCEDURE Fourth(i: INTEGER);
VAR j: INTEGER;
PROCEDURE Fifth(k: INTEGER);
VAR l: INTEGER;
PROCEDURE Sixth(): INTEGER;
BEGIN
A(e = 2, 61H); (* lxa 4 *)
A(f = 11703, 62H); (* lxl 4 *)
b := 3385; (* lxa 5 *)
d := 30989; (* lxl 5 *)
e := 28935; (* lxl 4 *)
f := 13366; (* lxa 4 *)
CheckThird;
(* lxa 5 *)
A(in.huge = Set8{11, 12, 40, 40, 43, 56}, 63H);
A(in.big = 2130020019D, 64H);
A(in.small = 300C, 65H);
A(in.tiny = 175C, 66H);
(* lxl 5 *)
out.huge := Set8{8, 19, 36, 41, 47, 62};
out.big := 385360915D;
out.small := 366C;
out.tiny := 131C;
j := k; (* lxl 2, lxa 1 *)
l := i; (* lxl 1, lxa 2 *)
RETURN 5217;
END Sixth;
PROCEDURE TwiceSixth(): INTEGER;
BEGIN
(* lxa and lxl must follow the static chain from Sixth to
* Fifth, not dynamic chain from Sixth to TwiceSixth. *)
RETURN 2 * Sixth();
END TwiceSixth;
BEGIN (* Fifth *)
A(TwiceSixth() = 10434, 51H);
A(k = 11567, 51H);
A(l = 32557, 52H);
END Fifth;
BEGIN (* Fourth *)
Fifth(11567); (* k *)
A(i = 32557, 41H);
A(j = 11567, 42H);
END Fourth;
BEGIN (* Third *)
h := 11711;
Fourth(32557); (* i *)
END Third;
BEGIN (* Second *)
f := 11703;
Third(7988); (* g *)
END Second;
BEGIN (* First *)
c := 14349;
d := 17850;
Second(2); (* e *)
RETURN out
END First;
VAR
x: Box;
BEGIN
x.huge := Set8{11, 12, 40, 40, 43, 56};
x.big := 2130020019D;
x.small := 300C;
x.tiny := 175C;
x := First(1354, 19516, x); (* a, b, in *)
A(x.huge = Set8{8, 19, 36, 41, 47, 62}, 71H);
A(x.big = 385360915D, 72H);
A(x.small = 366C, 73H);
A(x.tiny = 131C, 74H);
finished;
END NestProc.

59
tests/plat/m2/OpenArray_mod.mod Normal file
View file

@ -0,0 +1,59 @@
(*
* Passes an open array to a procedure. The back end must implement
* some EM instructions for accessing arrays.
*)
MODULE OpenArray;
FROM Test IMPORT fail, finished;
(* Asserts condition or fails with code. *)
PROCEDURE A(cond: BOOLEAN; code: INTEGER);
BEGIN
IF NOT cond THEN fail(code) END
END A;
(* Called as Modify(ary1, 1) or Modify(ary2, 2). *)
PROCEDURE Modify(VAR ary: ARRAY OF INTEGER; what: INTEGER);
VAR hi: INTEGER;
BEGIN
hi := what * 100H;
(* Indices must be from 0 to HIGH(ary). *)
A((what = 1) = (HIGH(ary) = 3), hi + 1);
A((what = 2) = (HIGH(ary) = 9), hi + 2);
(* ary[2] must equal ary1[3] or ary2[3]. *)
A((what = 1) = (ary[2] = 13), hi + 3);
A((what = 2) = (ary[2] = 37), hi + 4);
(* Modify some values. *)
IF HIGH(ary) >= 3 THEN ary[3] := 20 END;
IF HIGH(ary) >= 6 THEN ary[6] := 40 END;
IF HIGH(ary) >= 9 THEN ary[9] := 12 END;
END Modify;
VAR
ary1: ARRAY [1..4] OF INTEGER;
ary2: ARRAY [1..10] OF INTEGER;
BEGIN
(* Initialize the arrays. *)
ary1[1] := 6; ary1[2] := 9; ary1[3] := 13; ary1[4] := 49;
ary2[1] := 56; ary2[2] := 79; ary2[3] := 37; ary2[4] := 0;
ary2[5] := 70; ary2[6] := 62; ary2[7] := 64; ary2[8] := 92;
ary2[9] := 29; ary2[10] := 90;
(* Pass them as open arrays. *)
Modify(ary1, 1);
Modify(ary2, 2);
(* Check that ary1[4], ary2[4, 7, 10] have been modified. *)
A(ary1[1] = 6, 301H); A(ary1[2] = 9, 301H); A(ary1[3] = 13, 303H);
A(ary1[4] = 20, 304H);
A(ary2[1] = 56, 401H); A(ary2[2] = 79, 402H); A(ary2[3] = 37, 403H);
A(ary2[4] = 20, 404H); A(ary2[5] = 70, 406H); A(ary2[6] = 62, 406H);
A(ary2[7] = 40, 407H); A(ary2[8] = 92, 408H); A(ary2[9] = 29, 409H);
A(ary2[10] = 12, 40AH);
finished;
END OpenArray.

61
tests/plat/m2/Set100_mod.mod Normal file
View file

@ -0,0 +1,61 @@
(*
* Operates on sets of 100 integers. The compiler emits, and the back
* end must implement, the EM instructions for large sets.
*)
MODULE Set100;
FROM Test IMPORT fail, finished;
(* Asserts condition or fails with code. *)
PROCEDURE A(cond: BOOLEAN; code: INTEGER);
BEGIN
IF NOT cond THEN fail(code) END
END A;
TYPE
Num = [1..100];
NumSet = SET OF Num;
VAR
(* VAR, not CONST, so compiler can't do constant operations. *)
primes, teens, lowevens, eighties, nineties: NumSet;
CONST
(* These are the expected results of some set operations. *)
primeteen = NumSet{13, 17, 19};
compeighties = NumSet{80..82, 84..88};
teenxoreven = NumSet{2, 4, 6, 8, 10, 12, 13, 15, 17, 19, 20};
eightiesnineties = NumSet{80..99};
(* Checks that some set is equal to the expected result. Also checks
* that the set is not equal to the other sets. *)
PROCEDURE Check(set: NumSet; what: INTEGER);
VAR hi: INTEGER;
BEGIN
hi := what * 100H;
(* The compiler uses cms in EM to check set equality. *)
A((what = 1) = (set = primeteen), hi + 1);
A((what = 2) = (set = compeighties), hi + 2);
A((what = 3) = (set = teenxoreven), hi + 3);
A((what = 4) = (set = eightiesnineties), hi + 4);
END Check;
PROCEDURE Range(min: Num; max: Num): NumSet;
BEGIN
(* The compiler calls LtoUset in lang/m2/libm2/LtoUset.e *)
RETURN NumSet{min..max}
END Range;
BEGIN
primes := NumSet{2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43,
47, 53, 59, 61, 67, 71, 73, 79, 83, 89, 97};
teens := NumSet{13, 14, 15, 16, 17, 18, 19};
lowevens := NumSet{2, 4, 6, 8, 10, 12, 14, 16, 18, 20};
eighties := Range(80, 89);
nineties := Range(90, 99);
Check(primes * teens, 1);
Check(eighties - primes, 2);
Check(teens / lowevens, 3);
Check(eighties + nineties, 4);
finished;
END Set100.

55
tests/plat/m2/StringTest_mod.mod Normal file
View file

@ -0,0 +1,55 @@
MODULE StringTest;
FROM Strings IMPORT
Assign, Insert, Delete, Pos, Copy, Concat, Length, CompareStr;
FROM Test IMPORT fail, finished;
(* Asserts condition or fails with code. *)
PROCEDURE A(cond: BOOLEAN; code: INTEGER);
BEGIN
IF NOT cond THEN fail(code) END
END A;
VAR
small: ARRAY [0..3] OF CHAR;
big: ARRAY [0..99] OF CHAR;
BEGIN
(* CompareStr *)
A(CompareStr("ablaze", "ablaze") = 0, 1);
A(CompareStr("ablaze", "abloom") < 0, 2);
A(CompareStr("abloom", "ablaze") > 0, 3);
A(CompareStr("abloom", "abloom") = 0, 4);
(* Assign, Insert, Delete *)
Assign("obsequiosity", small);
A(CompareStr("obsequiosity", small) > 0, 11H);
Assign("obsequiosity", big);
A(CompareStr("obsequiosity", big) = 0, 12H);
A(big[11] = 'y', 13H);
A(big[11] # 0C, 14H);
A(big[12] # 'y', 15H);
A(big[12] = 0C, 16H);
Insert(" omnihuman", big, 9);
A(CompareStr("obsequios omnihumanity", big) = 0, 17H);
Delete(big, 6, 15);
A(CompareStr("obsequy", big) = 0, 18H);
(* Pos, Concat *)
Assign("Now is the time for all good men to come...", big);
A(Pos("w", big) = 2, 21H);
A(Pos("t", big) = 7, 22H);
A(Pos("ti", big) = 11, 23H);
A(Pos("men", big) = 29, 24H);
A(Pos("women", big) > 42, 25H);
Copy(big, 29, 2, small);
A(CompareStr("me", small) = 0, 26H);
(* Concat, Length *)
Concat("pictorial", "ist", big);
A(CompareStr("pictorialist", big) = 0, 31H);
A(Length(big) = 12, 32H);
Concat("zit", "her", small);
A(CompareStr("zither", small) > 0, 33H);
A(Length(small) < 5, 34H);
finished;
END StringTest.