https://gcc.gnu.org/g:92ed383eb0bfa0df8d066a0c282ff266816d495f
commit r14-11014-g92ed383eb0bfa0df8d066a0c282ff266816d495f
Author: Gaius Mulley <gaiusm...@gmail.com>
Date: Sun Dec 1 14:41:40 2024 +0000
[PATCH] 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.
(cherry picked from commit 2828ec526eaf5612178b62d48bfd8443c7ecd674)
Signed-off-by: Gaius Mulley <gaiusm...@gmail.com>
Diff:
---
gcc/m2/gm2-compiler/M2Check.mod | 138 +++++++++++++++++++--
gcc/m2/gm2-libs-ch/UnixArgs.cc | 1 -
gcc/m2/gm2-libs-ch/m2rts.h | 7 +-
gcc/testsuite/gm2/iso/fail/testarrayunbounded2.mod | 14 +++
gcc/testsuite/gm2/iso/fail/testarrayunbounded3.mod | 14 +++
gcc/testsuite/gm2/iso/fail/testarrayunbounded4.mod | 14 +++
gcc/testsuite/gm2/iso/fail/testarrayunbounded5.mod | 13 ++
gcc/testsuite/gm2/iso/fail/testarrayunbounded6.mod | 13 ++
gcc/testsuite/gm2/iso/pass/testarrayunbounded.mod | 14 +++
9 files changed, 213 insertions(+), 15 deletions(-)
diff --git a/gcc/m2/gm2-compiler/M2Check.mod b/gcc/m2/gm2-compiler/M2Check.mod
index 1750fe07ecf1..d096646c3877 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 ;
@@ -259,12 +259,93 @@ BEGIN
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 ae9765aed7e7..850e49029e87 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 df6cbcb2c8d6..62217bb62e8d 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 000000000000..784267131948
--- /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 000000000000..affbf5a2a6f0
--- /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 000000000000..4374cb3bef55
--- /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 000000000000..76f7ecd8052a
--- /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 000000000000..5ed4c4afd1bb
--- /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 000000000000..3c6afc40b689
--- /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.
