diff options
author | Gaius Mulley <gaiusmod2@gmail.com> | 2023-08-02 00:34:29 +0100 |
---|---|---|
committer | Gaius Mulley <gaiusmod2@gmail.com> | 2023-08-02 00:34:29 +0100 |
commit | 8bf244e32a0d505720396fbb7df26f824c7f77eb (patch) | |
tree | 17852afe0ad9f2736b56553fd5dc6cf53998900b /gcc | |
parent | 6cb2f2c7f36c999590a949f663d6057cbc67271f (diff) | |
download | gcc-8bf244e32a0d505720396fbb7df26f824c7f77eb.zip gcc-8bf244e32a0d505720396fbb7df26f824c7f77eb.tar.gz gcc-8bf244e32a0d505720396fbb7df26f824c7f77eb.tar.bz2 |
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>
Diffstat (limited to 'gcc')
-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. |