PR modula2/110161 Comparing a typed procedure variable to 0 gives ICE or assertion

This patch allows a proc type to be compared against an address.

gcc/m2/ChangeLog:

	PR modula2/110161
	* gm2-compiler/M2Check.mod (checkProcTypeEquivalence): New
	procedure function.
	(checkTypeKindEquivalence): Call checkProcTypeEquivalence
	if either left or right is a proc type.
	* gm2-compiler/M2Quads.mod (BuildRelOp): Create
	combinedTok prior to creating the range check quadruple.
	Use combinedTok when creating the range check quadruple.

gcc/testsuite/ChangeLog:

	PR modula2/110161
	* gm2/pim/fail/badxproc.mod: New test.

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

diff --git a/gcc/m2/gm2-compiler/M2Check.mod b/gcc/m2/gm2-compiler/M2Check.mod
index f7e72d3f6671f887fe9380aa139088220e8cc890..af2c7c7ccadb9db8967fae3bb6caa0b71cded1ce 100644 (file)
--- a/gcc/m2/gm2-compiler/M2Check.mod
+++ b/gcc/m2/gm2-compiler/M2Check.mod
@@ -901,6 +901,37 @@ BEGIN
 END checkPointerType ;
 
 
+(*
+   checkProcTypeEquivalence - allow proctype to be compared against another
+                              proctype or procedure.  It is legal to be compared
+                              against an address.
+*)
+
+PROCEDURE checkProcTypeEquivalence (result: status; tinfo: tInfo;
+                                    left, right: CARDINAL) : status ;
+BEGIN
+   IF isFalse (result)
+   THEN
+      RETURN result
+   ELSIF IsProcedure (left) AND IsProcType (right)
+   THEN
+      RETURN checkProcedure (result, tinfo, right, left)
+   ELSIF IsProcType (left) AND IsProcedure (right)
+   THEN
+      RETURN checkProcedure (result, tinfo, left, right)
+   ELSIF IsProcType (left) AND IsProcType (right)
+   THEN
+      RETURN checkProcType (result, tinfo, left, right)
+   ELSIF (left = Address) OR (right = Address)
+   THEN
+      RETURN true
+   ELSE
+      RETURN false
+   END
+END checkProcTypeEquivalence ;
+
+
+
 (*
    checkTypeKindEquivalence -
 *)
@@ -928,15 +959,9 @@ BEGIN
       ELSIF IsEnumeration (left) AND IsEnumeration (right)
       THEN
          RETURN checkEnumerationEquivalence (result, left, right)
-      ELSIF IsProcedure (left) AND IsProcType (right)
-      THEN
-         RETURN checkProcedure (result, tinfo, right, left)
-      ELSIF IsProcType (left) AND IsProcedure (right)
-      THEN
-         RETURN checkProcedure (result, tinfo, left, right)
       ELSIF IsProcType (left) OR IsProcType (right)
       THEN
-         RETURN checkProcType (result, tinfo, left, right)
+         RETURN checkProcTypeEquivalence (result, tinfo, right, left)
       ELSIF IsReallyPointer (left) AND IsReallyPointer (right)
       THEN
          RETURN checkPointerType (result, left, right)

diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod
index 031ee8947107c7b340aab840b21d536ebee6a3cc..c11e61fbb0c3295eb04df4db35a5ee902a18f9bc 100644 (file)
--- a/gcc/m2/gm2-compiler/M2Quads.mod
+++ b/gcc/m2/gm2-compiler/M2Quads.mod
@@ -12969,11 +12969,13 @@ BEGIN
 
       CheckVariableOrConstantOrProcedure (rightpos, right) ;
       CheckVariableOrConstantOrProcedure (leftpos, left) ;
+      combinedTok := MakeVirtualTok (optokpos, leftpos, rightpos) ;
 
       IF (left#NulSym) AND (right#NulSym)
       THEN
          (* BuildRange will check the expression later on once gcc knows about all data types.  *)
-         BuildRange (InitTypesExpressionCheck (optokpos, left, right, TRUE, Op = InTok))
+         BuildRange (InitTypesExpressionCheck (combinedTok, left, right, TRUE,
+                                               Op = InTok))
       END ;
 
       (* Must dereference LeftValue operands.  *)
@@ -12993,7 +12995,6 @@ BEGIN
          doIndrX (leftpos, t, left) ;
          left := t
       END ;
-      combinedTok := MakeVirtualTok (optokpos, leftpos, rightpos) ;
 
       IF DebugTokPos
       THEN

diff --git a/gcc/testsuite/gm2/pim/fail/badxproc.mod b/gcc/testsuite/gm2/pim/fail/badxproc.mod
new file mode 100644 (file)
index 0000000..54a0931
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/badxproc.mod
@@ -0,0 +1,8 @@
+MODULE badxproc ;
+
+TYPE xProc = PROCEDURE(): BOOLEAN;
+VAR x: xProc;
+
+BEGIN
+  IF x = 0 THEN END;
+END badxproc.