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.

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

6 files changed, 90 insertions, 48 deletions

diff --git a/gcc/m2/gm2-compiler/M2StackAddress.mod b/gcc/m2/gm2-compiler/M2StackAddress.mod
index c7262dc..ff65b42 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 46f46af..0e45b2e 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 9ce07ad..c130135 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 6d615b9..fd1fd07 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,
@@ -193,6 +193,22 @@ 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 0000000..1820b6f
--- /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 0000000..2f79469
--- /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.