From 787fdeaaa9330e267dd49aa26818a4e1bd02eded Mon Sep 17 00:00:00 2001
From: George Koehler <xkernigh@netscape.net>
Date: Thu, 21 Dec 2017 17:44:03 -0500
Subject: [PATCH] Add some tests for Modula-2.

---
 tests/plat/build.lua             |   7 +-
 tests/plat/m2/ConvTest_mod.mod   |  36 +++++++++
 tests/plat/m2/NestProc_mod.mod   | 132 +++++++++++++++++++++++++++++++
 tests/plat/m2/OpenArray_mod.mod  |  59 ++++++++++++++
 tests/plat/m2/Set100_mod.mod     |  61 ++++++++++++++
 tests/plat/m2/StringTest_mod.mod |  55 +++++++++++++
 6 files changed, 349 insertions(+), 1 deletion(-)
 create mode 100644 tests/plat/m2/ConvTest_mod.mod
 create mode 100644 tests/plat/m2/NestProc_mod.mod
 create mode 100644 tests/plat/m2/OpenArray_mod.mod
 create mode 100644 tests/plat/m2/Set100_mod.mod
 create mode 100644 tests/plat/m2/StringTest_mod.mod

diff --git a/tests/plat/build.lua b/tests/plat/build.lua
index 609771ed1..666af7d95 100644
--- a/tests/plat/build.lua
+++ b/tests/plat/build.lua
@@ -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 {
diff --git a/tests/plat/m2/ConvTest_mod.mod b/tests/plat/m2/ConvTest_mod.mod
new file mode 100644
index 000000000..9fa828af0
--- /dev/null
+++ b/tests/plat/m2/ConvTest_mod.mod
@@ -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.
diff --git a/tests/plat/m2/NestProc_mod.mod b/tests/plat/m2/NestProc_mod.mod
new file mode 100644
index 000000000..d46731f55
--- /dev/null
+++ b/tests/plat/m2/NestProc_mod.mod
@@ -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.
diff --git a/tests/plat/m2/OpenArray_mod.mod b/tests/plat/m2/OpenArray_mod.mod
new file mode 100644
index 000000000..1aa219a55
--- /dev/null
+++ b/tests/plat/m2/OpenArray_mod.mod
@@ -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.
diff --git a/tests/plat/m2/Set100_mod.mod b/tests/plat/m2/Set100_mod.mod
new file mode 100644
index 000000000..3b200d318
--- /dev/null
+++ b/tests/plat/m2/Set100_mod.mod
@@ -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.
diff --git a/tests/plat/m2/StringTest_mod.mod b/tests/plat/m2/StringTest_mod.mod
new file mode 100644
index 000000000..41552aa7a
--- /dev/null
+++ b/tests/plat/m2/StringTest_mod.mod
@@ -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.