diff options
-rw-r--r-- | gcc/m2/gm2-compiler/M2Check.mod | 39 | ||||
-rw-r--r-- | gcc/m2/gm2-compiler/M2Quads.mod | 5 | ||||
-rw-r--r-- | gcc/testsuite/gm2/pim/fail/badxproc.mod | 8 |
3 files changed, 43 insertions, 9 deletions
diff --git a/gcc/m2/gm2-compiler/M2Check.mod b/gcc/m2/gm2-compiler/M2Check.mod index f7e72d3..af2c7c7 100644 --- a/gcc/m2/gm2-compiler/M2Check.mod +++ b/gcc/m2/gm2-compiler/M2Check.mod @@ -902,6 +902,37 @@ 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 031ee89..c11e61f 100644 --- 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 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. |