https://gcc.gnu.org/g:99d537558ebffb52cb8f784ab550b962958fedef
commit r14-10982-g99d537558ebffb52cb8f784ab550b962958fedef
Author: Gaius Mulley <gaiusm...@gmail.com>
Date: Tue Nov 26 12:57:12 2024 +0000
[PATCH] PR modula2/115957 ICE on procedure local const declaration
An ICE would occur if a constant was declared using a variable term.
This fix catches variable terms in constant expressions and generates
an unrecoverable error.
gcc/m2/ChangeLog:
PR modula2/115957
* gm2-compiler/M2StackAddress.mod (PopAddress): Detect tail=NIL
and generate an internal error.
* gm2-compiler/PCBuild.bnf (InConstParameter): New variable.
(InConstBlock): New variable.
(ErrorString): Rewrite using MetaErrorStringT0.
(ErrorArrayAt): Rewrite using MetaErrorStringT0.
(WarnMissingToken): Use MetaErrorStringT0.
(CompilationUnit): Set seenError FALSE.
(init): Initialize InConstParameter and InConstBlock.
(ConstantDeclaration): Set InConstBlock.
(ConstSetOrQualidentOrFunction): Call CheckNotVar if not
InConstParameter and InConstBlock.
(ConstActualParameters): Set InConstParameter TRUE and restore
value at the end.
* gm2-compiler/PCSymBuild.def (CheckNotVar): New procedure.
Remove all unnecessary export qualified list.
* gm2-compiler/PCSymBuild.mod (CheckNotVar): New procedure.
gcc/testsuite/ChangeLog:
PR modula2/115957
* gm2/errors/fail/badconst.mod: New test.
* gm2/pim/fail/tinyadr.mod: New test.
(cherry picked from commit d9709fafb2c498ba2f4c920f953c9b78fa3bf114)
Signed-off-by: Gaius Mulley <gaiusm...@gmail.com>
Diff:
---
gcc/m2/gm2-compiler/M2StackAddress.mod | 11 +++++---
gcc/m2/gm2-compiler/PCBuild.bnf | 40 +++++++++++++++++++++---------
gcc/m2/gm2-compiler/PCSymBuild.def | 38 +++++-----------------------
gcc/m2/gm2-compiler/PCSymBuild.mod | 18 +++++++++++++-
gcc/testsuite/gm2/errors/fail/badconst.mod | 19 ++++++++++++++
gcc/testsuite/gm2/pim/fail/tinyadr.mod | 12 +++++++++
6 files changed, 90 insertions(+), 48 deletions(-)
diff --git a/gcc/m2/gm2-compiler/M2StackAddress.mod
b/gcc/m2/gm2-compiler/M2StackAddress.mod
index c7262dce3b38..ff65b42059c4 100644
--- a/gcc/m2/gm2-compiler/M2StackAddress.mod
+++ b/gcc/m2/gm2-compiler/M2StackAddress.mod
@@ -157,9 +157,14 @@ BEGIN
END ;
DISPOSE(b)
END ;
- WITH s^.tail^ DO
- DEC(items) ;
- RETURN( bucket[items] )
+ IF s^.tail = NIL
+ THEN
+ InternalError ('stack underflow')
+ ELSE
+ WITH s^.tail^ DO
+ DEC(items) ;
+ RETURN( bucket[items] )
+ END
END
END
END
diff --git a/gcc/m2/gm2-compiler/PCBuild.bnf b/gcc/m2/gm2-compiler/PCBuild.bnf
index 46f46af73ffe..0e45b2e889cc 100644
--- a/gcc/m2/gm2-compiler/PCBuild.bnf
+++ b/gcc/m2/gm2-compiler/PCBuild.bnf
@@ -47,7 +47,7 @@ IMPLEMENTATION MODULE PCBuild ;
FROM M2LexBuf IMPORT currentstring, currenttoken, GetToken, InsertToken,
InsertTokenAndRewind, GetTokenNo, MakeVirtualTok ;
-FROM M2Error IMPORT ErrorStringAt, WriteFormat1, WriteFormat2 ;
+FROM M2MetaError IMPORT MetaErrorStringT0 ;
FROM NameKey IMPORT NulName, Name, makekey ;
FROM DynamicStrings IMPORT String, InitString, KillString, Mark, ConCat,
ConCatChar ;
FROM M2Printf IMPORT printf0 ;
@@ -102,7 +102,8 @@ FROM PCSymBuild IMPORT PCStartBuildProgModule,
PushConstType,
PushConstAttributeType,
PushConstAttributePairType,
- PushRType ;
+ PushRType,
+ CheckNotVar ;
FROM SymbolTable IMPORT MakeGnuAsm, PutGnuAsmVolatile, PutGnuAsm,
PutGnuAsmInput,
PutGnuAsmOutput, PutGnuAsmTrash, PutGnuAsmVolatile,
@@ -127,13 +128,15 @@ CONST
Pass1 = FALSE ;
VAR
- WasNoError : BOOLEAN ;
+ InConstParameter,
+ InConstBlock,
+ seenError : BOOLEAN ;
PROCEDURE ErrorString (s: String) ;
BEGIN
- ErrorStringAt (s, GetTokenNo ()) ;
- WasNoError := FALSE
+ MetaErrorStringT0 (GetTokenNo (), s) ;
+ seenError := TRUE
END ErrorString ;
@@ -145,7 +148,7 @@ END ErrorArray ;
PROCEDURE ErrorArrayAt (a: ARRAY OF CHAR; tok: CARDINAL) ;
BEGIN
- ErrorStringAt (InitString(a), tok)
+ MetaErrorStringT0 (tok, InitString (a))
END ErrorArrayAt ;
@@ -220,7 +223,7 @@ BEGIN
str := DescribeStop(s0, s1, s2) ;
str := ConCat(InitString('syntax error,'), Mark(str)) ;
- ErrorStringAt(str, GetTokenNo())
+ MetaErrorStringT0 (GetTokenNo (), str)
END WarnMissingToken ;
@@ -338,9 +341,9 @@ END Expect ;
PROCEDURE CompilationUnit () : BOOLEAN ;
BEGIN
- WasNoError := TRUE ;
+ seenError := FALSE ;
FileUnit(SetOfStop0{eoftok}, SetOfStop1{}, SetOfStop2{}) ;
- RETURN( WasNoError )
+ RETURN NOT seenError
END CompilationUnit ;
@@ -403,6 +406,9 @@ BEGIN
END Real ;
% module PCBuild end
+BEGIN
+ InConstParameter := FALSE ;
+ InConstBlock := FALSE
END PCBuild.
% rules
error 'ErrorArray' 'ErrorString'
@@ -591,6 +597,7 @@ Qualident :=
% VAR
=:
ConstantDeclaration := %
VAR top: CARDINAL ; %
+ %
InConstBlock := TRUE %
%
top := Top() %
%
PushAutoOn %
( Ident "=" %
StartDesConst %
@@ -600,6 +607,7 @@ ConstantDeclaration :=
% VAR
%
EndDesConst %
%
PopAuto %
%
Assert(top=Top()) %
+ %
InConstBlock := FALSE %
=:
ConstExpression := %
VAR top: CARDINAL ; %
@@ -706,7 +714,10 @@ ConstSetOrQualidentOrFunction :=
% Pus
%
VAR tokpos: CARDINAL ; %
%
tokpos := GetTokenNo () %
(
- PushQualident
+ PushQualident %
IF (NOT InConstParameter) AND InConstBlock
+
THEN
+
CheckNotVar (tokpos)
+
END %
( ConstructorOrConstActualParameters | %
PushConstType %
%
PopNothing %
)
@@ -714,8 +725,13 @@ ConstSetOrQualidentOrFunction :=
% Pus
Constructor ) %
PopAuto %
=:
-ConstActualParameters := %
PushT(0) %
- "(" [ ConstExpList ] ")" =:
+ConstActualParameters := %
VAR oldConstParameter: BOOLEAN ; %
+ %
oldConstParameter := InConstParameter %
+ %
InConstParameter := TRUE %
+ %
PushT(0) %
+ "(" [ ConstExpList ] ")"
+ %
InConstParameter := oldConstParameter %
+ =:
ConstExpList := %
VAR n: CARDINAL ; %
ConstExpression %
PopT(n) %
diff --git a/gcc/m2/gm2-compiler/PCSymBuild.def
b/gcc/m2/gm2-compiler/PCSymBuild.def
index 9ce07adbc61b..c130135d7438 100644
--- a/gcc/m2/gm2-compiler/PCSymBuild.def
+++ b/gcc/m2/gm2-compiler/PCSymBuild.def
@@ -29,38 +29,12 @@ DEFINITION MODULE PCSymBuild ;
the import/export symbols and assigns types to constructors.
*)
-EXPORT QUALIFIED PCStartBuildDefModule,
- PCEndBuildDefModule,
- PCStartBuildImpModule,
- PCEndBuildImpModule,
- PCStartBuildProgModule,
- PCEndBuildProgModule,
- PCStartBuildInnerModule,
- PCEndBuildInnerModule,
- PCBuildProcedureHeading,
- PCStartBuildProcedure,
- PCEndBuildProcedure,
- BuildNulName,
- BuildConst,
- PCBuildImportOuterModule,
- PCBuildImportInnerModule,
- StartDesConst,
- EndDesConst,
- BuildRelationConst,
- BuildUnaryConst,
- BuildBinaryConst,
- PushInConstructor,
- PopInConstructor,
- SkipConst,
- PushConstType,
- PushConstAttributeType,
- PushConstAttributePairType,
- PushConstructorCastType,
- PushRType,
- PushConstFunctionType,
- PushIntegerType,
- PushStringType,
- ResolveConstTypes ;
+
+(*
+ CheckNotVar - checks to see that the top of stack is not a variable.
+*)
+
+PROCEDURE CheckNotVar (tok: CARDINAL) ;
(*
diff --git a/gcc/m2/gm2-compiler/PCSymBuild.mod
b/gcc/m2/gm2-compiler/PCSymBuild.mod
index 6d615b9a311c..fd1fd075bbe0 100644
--- a/gcc/m2/gm2-compiler/PCSymBuild.mod
+++ b/gcc/m2/gm2-compiler/PCSymBuild.mod
@@ -78,7 +78,7 @@ FROM SymbolTable IMPORT NulSym, ModeOfAddr,
IsParameterVar, PutProcTypeParam,
PutProcTypeVarParam, IsParameterUnbounded,
PutFunction, PutProcTypeParam,
- GetType,
+ GetType, IsVar,
IsAModula2Type, GetDeclaredMod ;
FROM M2Batch IMPORT MakeDefinitionSource,
@@ -192,6 +192,22 @@ BEGIN
END GetSkippedType ;
+(*
+ CheckNotVar - checks to see that the top of stack is not a variable.
+*)
+
+PROCEDURE CheckNotVar (tok: CARDINAL) ;
+VAR
+ const: CARDINAL ;
+BEGIN
+ const := OperandT (1) ;
+ IF (const # NulSym) AND IsVar (const)
+ THEN
+ MetaErrorT1 (tok, 'not expecting a variable {%Aad} as a term in a
constant expression', const)
+ END
+END CheckNotVar ;
+
+
(*
StartBuildDefinitionModule - Creates a definition module and starts
a new scope.
diff --git a/gcc/testsuite/gm2/errors/fail/badconst.mod
b/gcc/testsuite/gm2/errors/fail/badconst.mod
new file mode 100644
index 000000000000..1820b6f33864
--- /dev/null
+++ b/gcc/testsuite/gm2/errors/fail/badconst.mod
@@ -0,0 +1,19 @@
+MODULE badconst ;
+
+IMPORT SYSTEM;
+
+TYPE
+ T = POINTER TO CONS;
+ CONS = RECORD
+ CAR: SYSTEM.ADDRESS;
+ CDR: T;
+ END ;
+
+PROCEDURE POP(VAR LST: T): SYSTEM.ADDRESS;
+CONST CAR = LST.CAR;
+BEGIN
+ RETURN NIL;
+END POP;
+
+BEGIN
+END badconst.
diff --git a/gcc/testsuite/gm2/pim/fail/tinyadr.mod
b/gcc/testsuite/gm2/pim/fail/tinyadr.mod
new file mode 100644
index 000000000000..2f79469f0ca9
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/tinyadr.mod
@@ -0,0 +1,12 @@
+MODULE tinyadr ;
+
+FROM SYSTEM IMPORT ADR ;
+
+CONST
+ foo = ADR (bar) ;
+
+VAR
+ bar: CARDINAL ;
+BEGIN
+
+END tinyadr.
