modula2: Remove unused parameter warnings seen in build

This patch removes unused parameters in gm2-compiler/M2Check.mod.
It also removes a --fixme-- and completes the missing code
which type checks unbounded arrays.  The patch also fixes a
build error seen when building m2/stage2/cc1gm2.

gcc/m2/ChangeLog:

	* gm2-compiler/M2Check.mod (checkUnboundedArray): New
	procedure function.
	(checkUnboundedUnbounded): Ditto.
	(checkUnbounded): Rewrite to check the unbounded data
	type.
	(checkPair): Add comment.
	(doCheckPair): Add comment.
	Remove tinfo parameter from the call to checkTypeKindViolation.
	(checkTypeKindViolation): Remove ununsed parameter tinfo.
	* gm2-libs-ch/UnixArgs.cc (GM2RTS.h): Remove include.
	* gm2-libs-ch/m2rts.h (M2RTS_INIT): New define.
	(M2RTS_DEP): Ditto.
	(M2RTS_RegisterModule): New prototype.
	(GM2RTS.h): Add include to the MC_M2 block.

gcc/testsuite/ChangeLog:

	* gm2/iso/fail/testarrayunbounded2.mod: New test.
	* gm2/iso/fail/testarrayunbounded3.mod: New test.
	* gm2/iso/fail/testarrayunbounded4.mod: New test.
	* gm2/iso/fail/testarrayunbounded5.mod: New test.
	* gm2/iso/fail/testarrayunbounded6.mod: New test.
	* gm2/iso/pass/testarrayunbounded.mod: New test.

Signed-off-by: Gaius Mulley <gaiusmod2@gmail.com>

9 files changed, 213 insertions, 15 deletions

diff --git a/gcc/m2/gm2-compiler/M2Check.mod b/gcc/m2/gm2-compiler/M2Check.mod
index 1750fe0..d096646 100644
--- a/gcc/m2/gm2-compiler/M2Check.mod
+++ b/gcc/m2/gm2-compiler/M2Check.mod
@@ -48,7 +48,7 @@ FROM SymbolTable IMPORT NulSym, IsRecord, IsSet, GetDType, GetSType, IsType,
                         GetMode, GetType, IsUnbounded, IsComposite, IsConstructor,
                         IsParameter, IsConstString, IsConstLitInternal, IsConstLit,
                         GetStringLength, GetProcedureProcType, IsHiddenType,
-                        IsHiddenReallyPointer ;
+                        IsHiddenReallyPointer, GetDimension ;
 
 FROM M2GCCDeclare IMPORT GetTypeMin, GetTypeMax ;
 FROM M2System IMPORT Address ;
@@ -260,11 +260,92 @@ END checkSubrange ;
 
 
 (*
+   checkUnboundedArray - returns status if unbounded is parameter compatible with array.
+                         It checks all type equivalences of the static array for a
+                         match with the dynamic (unbounded) array.
+*)
+
+PROCEDURE checkUnboundedArray (result: status;
+                               unbounded, array: CARDINAL) : status ;
+VAR
+   dim   : CARDINAL ;
+   ubtype,
+   type  : CARDINAL ;
+BEGIN
+   (* Firstly check to see if we have resolved this as false.  *)
+   IF isFalse (result)
+   THEN
+      RETURN result
+   ELSE
+      Assert (IsUnbounded (unbounded)) ;
+      Assert (IsArray (array)) ;
+      dim := GetDimension (unbounded) ;
+      ubtype := GetType (unbounded) ;
+      type := array ;
+      REPEAT
+         type := GetType (type) ;
+         DEC (dim) ;
+         (* Check type equivalences.  *)
+         IF checkTypeEquivalence (result, type, ubtype) = true
+         THEN
+            RETURN true
+         END ;
+         type := SkipType (type) ;
+         (* If we have run out of dimensions we conclude false.  *)
+         IF dim = 0
+         THEN
+            RETURN false
+         END ;
+      UNTIL NOT IsArray (type)
+   END ;
+   RETURN false
+END checkUnboundedArray ;
+
+
+(*
+   checkUnboundedUnbounded - check to see if formal and actual are compatible.
+                             Both are unbounded parameters.
+*)
+
+PROCEDURE checkUnboundedUnbounded (result: status;
+                                   tinfo: tInfo;
+                                   formal, actual: CARDINAL) : status ;
+BEGIN
+   (* Firstly check to see if we have resolved this as false.  *)
+   IF isFalse (result)
+   THEN
+      RETURN result
+   ELSE
+      Assert (IsUnbounded (formal)) ;
+      Assert (IsUnbounded (actual)) ;
+      (* The actual parameter above might be a different symbol to the actual parameter
+         symbol in the tinfo.  So we must compare the original actual parameter against
+         the formal.
+         The actual above maybe a temporary which is created after derefencing an array.
+         For example 'bar[10]' where bar is defined as ARRAY OF ARRAY OF CARDINAL.
+         The GetDimension for 'bar[10]' is 1 indicating that one dimension has been
+         referenced.  We use GetDimension for 'bar' which is 2.  *)
+      IF GetDimension (formal) # GetDimension (tinfo^.actual)
+      THEN
+         RETURN false
+      END ;
+      IF checkTypeEquivalence (result, GetType (formal), GetType (actual)) = true
+      THEN
+         RETURN true
+      END
+   END ;
+   RETURN false
+END checkUnboundedUnbounded ;
+
+
+(*
    checkUnbounded - check to see if the unbounded is type compatible with right.
                     This is only allowed during parameter passing.
 *)
 
-PROCEDURE checkUnbounded (result: status; tinfo: tInfo; unbounded, right: CARDINAL) : status ;
+PROCEDURE checkUnbounded (result: status;
+                          tinfo: tInfo;
+                          unbounded, right: CARDINAL) : status ;
 BEGIN
    (* Firstly check to see if we have resolved this as false.  *)
    IF isFalse (result)
@@ -274,13 +355,32 @@ BEGIN
       Assert (IsUnbounded (unbounded)) ;
       IF tinfo^.kind = parameter
       THEN
-         (* --fixme-- we should check the unbounded data type against the type of right.  *)
-         RETURN true
-      ELSE
-         (* Not allowed to use an unbounded symbol (type) in an expression or assignment.  *)
-         RETURN false
+         (* Check the unbounded data type against the type of right, SYSTEM types
+            are compared by the caller, so no need to test for them again.  *)
+         IF isSkipEquivalence (GetType (unbounded), right)
+         THEN
+            RETURN true
+         ELSIF IsType (right)
+         THEN
+            IF GetType (right) = NulSym
+            THEN
+               (* Base type check.  *)
+               RETURN checkPair (result, tinfo, GetType (unbounded), right)
+            ELSE
+               (* It is safe to GetType (right) and we check the pair
+                  [unbounded, GetType (right)].  *)
+               RETURN checkPair (result, tinfo, unbounded, GetType (right))
+            END
+         ELSIF IsArray (right)
+         THEN
+            RETURN checkUnboundedArray (result, unbounded, right)
+         ELSIF IsUnbounded (right)
+         THEN
+            RETURN checkUnboundedUnbounded (result, tinfo, unbounded, right)
+         END
       END
-   END
+   END ;
+   RETURN false
 END checkUnbounded ;
 
 
@@ -527,7 +627,14 @@ END checkBaseEquivalence ;
 
 
 (*
-   checkPair -
+   checkPair - check whether left and right are type compatible.
+               It will update the visited, unresolved list before
+               calling the docheckPair for the cascaded type checking.
+               Pre-condition: tinfo is initialized.
+                              left and right are modula2 symbols.
+               Post-condition: tinfo visited, resolved, unresolved lists
+                               are updated and the result status is
+                               returned.
 *)
 
 PROCEDURE checkPair (result: status; tinfo: tInfo;
@@ -829,7 +936,7 @@ END checkSystemEquivalence ;
                             a set, record or array.
 *)
 
-PROCEDURE checkTypeKindViolation (result: status; tinfo: tInfo;
+PROCEDURE checkTypeKindViolation (result: status;
                                   left, right: CARDINAL) : status ;
 BEGIN
    IF isFalse (result) OR (result = visited)
@@ -849,7 +956,14 @@ END checkTypeKindViolation ;
 
 
 (*
-   doCheckPair -
+   doCheckPair - invoke a series of ordered type checks checking compatibility
+                 between left and right modula2 symbols.
+                 Pre-condition: left and right are modula-2 symbols.
+                                tinfo is configured.
+                 Post-condition: status is returned determining the
+                                 correctness of the type check.
+                                 The tinfo resolved, unresolved, visited
+                                 lists will be updated.
 *)
 
 PROCEDURE doCheckPair (result: status; tinfo: tInfo;
@@ -889,7 +1003,7 @@ BEGIN
                               result := checkTypeKindEquivalence (result, tinfo, left, right) ;
                               IF NOT isKnown (result)
                               THEN
-                                 result := checkTypeKindViolation (result, tinfo, left, right)
+                                 result := checkTypeKindViolation (result, left, right)
                               END
                            END
                         END
diff --git a/gcc/m2/gm2-libs-ch/UnixArgs.cc b/gcc/m2/gm2-libs-ch/UnixArgs.cc
index ae9765a..850e490 100644
--- a/gcc/m2/gm2-libs-ch/UnixArgs.cc
+++ b/gcc/m2/gm2-libs-ch/UnixArgs.cc
@@ -32,7 +32,6 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 #include "gm2-libs-host.h"
 
 #include "GUnixArgs.h"
-#include "GM2RTS.h"
 
 static int UnixArgs_ArgC;
 static char **UnixArgs_ArgV;
diff --git a/gcc/m2/gm2-libs-ch/m2rts.h b/gcc/m2/gm2-libs-ch/m2rts.h
index df6cbcb..62217bb 100644
--- a/gcc/m2/gm2-libs-ch/m2rts.h
+++ b/gcc/m2/gm2-libs-ch/m2rts.h
@@ -24,13 +24,16 @@ a copy of the GCC Runtime Library Exception along with this program;
 see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 <http://www.gnu.org/licenses/>.  */
 
-#include "GM2RTS.h"
-
 #ifdef MC_M2
+#include "GM2RTS.h"
 /* mc sources do not register their init fini functions as they are
    initialized by a static scaffold (called by main).  */
 #define M2RTS_RegisterModule_Cstr(MODNAME,LIBNAME,init,fini,dep)
 #else
+#define M2RTS_INIT(X) void (*X)(int, char**, char**)
+#define M2RTS_DEP(X) void (*X)(void)
+extern "C" void M2RTS_RegisterModule (void * name, void * libname, M2RTS_INIT(init),
+				      M2RTS_INIT(fini), M2RTS_DEP(dependencies));
 #define M2RTS_RegisterModule_Cstr(MODNAME,LIBNAME,init,fini,dep) \
   M2RTS_RegisterModule (reinterpret_cast <void *> (const_cast <char *> (MODNAME)), \
 			reinterpret_cast <void *> (const_cast <char *> (LIBNAME)), \
diff --git a/gcc/testsuite/gm2/iso/fail/testarrayunbounded2.mod b/gcc/testsuite/gm2/iso/fail/testarrayunbounded2.mod
new file mode 100644
index 0000000..7842671
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/testarrayunbounded2.mod
@@ -0,0 +1,14 @@
+MODULE testarrayunbounded2 ;
+
+
+PROCEDURE foo (a: ARRAY OF ARRAY OF CARDINAL) ;
+BEGIN
+
+END foo ;
+
+
+VAR
+   b: ARRAY [0..10] OF CARDINAL ;
+BEGIN
+   foo (b)
+END testarrayunbounded2.
diff --git a/gcc/testsuite/gm2/iso/fail/testarrayunbounded3.mod b/gcc/testsuite/gm2/iso/fail/testarrayunbounded3.mod
new file mode 100644
index 0000000..affbf5a
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/testarrayunbounded3.mod
@@ -0,0 +1,14 @@
+MODULE testarrayunbounded3 ;
+
+
+PROCEDURE foo (a: ARRAY OF CARDINAL) ;
+BEGIN
+
+END foo ;
+
+
+VAR
+   b: CARDINAL ;
+BEGIN
+   foo (b)
+END testarrayunbounded3.
diff --git a/gcc/testsuite/gm2/iso/fail/testarrayunbounded4.mod b/gcc/testsuite/gm2/iso/fail/testarrayunbounded4.mod
new file mode 100644
index 0000000..4374cb3
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/testarrayunbounded4.mod
@@ -0,0 +1,14 @@
+MODULE testarrayunbounded4 ;
+
+
+PROCEDURE foo (a: ARRAY OF CHAR) ;
+BEGIN
+
+END foo ;
+
+
+VAR
+   b: CHAR ;
+BEGIN
+   foo (b)
+END testarrayunbounded4.
diff --git a/gcc/testsuite/gm2/iso/fail/testarrayunbounded5.mod b/gcc/testsuite/gm2/iso/fail/testarrayunbounded5.mod
new file mode 100644
index 0000000..76f7ecd
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/testarrayunbounded5.mod
@@ -0,0 +1,13 @@
+MODULE testarrayunbounded5 ;
+
+
+PROCEDURE foo (a: ARRAY OF ARRAY OF REAL) ;
+BEGIN
+END foo ;
+
+
+VAR
+   b: ARRAY [0..10] OF REAL ;
+BEGIN
+   foo (b)
+END testarrayunbounded5.
diff --git a/gcc/testsuite/gm2/iso/fail/testarrayunbounded6.mod b/gcc/testsuite/gm2/iso/fail/testarrayunbounded6.mod
new file mode 100644
index 0000000..5ed4c4a
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/testarrayunbounded6.mod
@@ -0,0 +1,13 @@
+MODULE testarrayunbounded6 ;
+
+
+PROCEDURE foo (a: ARRAY OF ARRAY OF REAL) ;
+BEGIN
+END foo ;
+
+
+VAR
+   b: ARRAY [0..10], [0..5] OF CARDINAL ;
+BEGIN
+   foo (b)
+END testarrayunbounded6.
diff --git a/gcc/testsuite/gm2/iso/pass/testarrayunbounded.mod b/gcc/testsuite/gm2/iso/pass/testarrayunbounded.mod
new file mode 100644
index 0000000..3c6afc4
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/testarrayunbounded.mod
@@ -0,0 +1,14 @@
+MODULE testarrayunbounded ;
+
+
+PROCEDURE foo (a: ARRAY OF ARRAY OF CARDINAL) ;
+BEGIN
+
+END foo ;
+
+
+VAR
+   b: ARRAY [0..10], [1..5] OF CARDINAL ;
+BEGIN
+   foo (b)
+END testarrayunbounded.