https://gcc.gnu.org/g:bcb8f401101455e1e6098bb9808d2059f4425de7
commit r14-10983-gbcb8f401101455e1e6098bb9808d2059f4425de7
Author: Gaius Mulley <gaiusm...@gmail.com>
Date: Tue Nov 26 13:04:05 2024 +0000
[PATCH] PR modula2/116048 ICE when encountering wrong kind of qualident
Following on from PR-115957 further ICEs can be generated by using the
wrong kind of qualident symbol. For example using a variable instead of
a type or using a type instead of a const. This fix tracks the expected
qualident kind state when parsing const, type and variable declarations.
If the error is unrecoverable then a detailed message explaining the
context of the qualident (and why the seen qualident is wrong) is
generated.
gcc/m2/ChangeLog:
PR modula2/116048
* Make-lang.in (GM2-COMP-BOOT-DEFS): Add M2StateCheck.def.
(GM2-COMP-BOOT-MODS): Add M2StateCheck.mod.
(GM2-COMP-DEFS): Add M2StateCheck.def.
(GM2-COMP-MODS): Add M2StateCheck.mod.
* gm2-compiler/M2Quads.mod (StartBuildWith): Generate
unrecoverable error is the qualident type is NulSym.
Replace MetaError1 with MetaErrorT1 and position the error
to the qualident.
* gm2-compiler/P3Build.bnf (M2StateCheck): Import procedures.
(seenError): New variable.
(WasNoError): Remove variable.
(BlockState): New variable.
(ErrorString): Rewrite using seenError.
(CompilationUnit): Ditto.
(QualidentCheck): New rule.
(ConstantDeclaration): Bookend with InclConst and ExclConst.
(Constructor): Add InclConstructor, ExclConstructor and call
CheckQualident.
(ConstActualParameters): Call PushState, PopState, InclConstFunc
and CheckQualident.
(TypeDeclaration): Bookend with InclType and ExclType.
(SimpleType): Call QualidentCheck.
(CaseTag): Ditto.
(OptReturnType): Ditto.
(VariableDeclaration): Bookend with InclVar and ExclVar.
(Designator): Call QualidentCheck.
(Formal;Type): Ditto.
* gm2-compiler/PCBuild.bnf (M2StateCheck): Import procedures.
(ConstantDeclaration): Rewrite using InclConst and ExclConst.
(Constructor): Bookend with InclConstructor and ExclConstructor.
Call CheckQualident.
(ConstructorOrConstActualParameters): Rewrite and cal
l CheckQualident.
(ConstActualParameters): Bookend with PushState PopState.
Call InclConstFunc and CheckQualident.
* gm2-gcc/init.cc (_M2_M2StateCheck_init): New declaration.
(_M2_P3Build_init): New declaration.
(init_PerCompilationInit): Call _M2_M2StateCheck_init and
_M2_P3Build_init.
* gm2-compiler/M2StateCheck.def: New file.
* gm2-compiler/M2StateCheck.mod: New file.
gcc/testsuite/ChangeLog:
PR modula2/116048
* gm2/errors/fail/errors-fail.exp: Remove -Wstudents
and add -Wuninit-variable-checking=all.
Replace gm2_init_pim with gm2_init_iso.
* gm2/errors/fail/testfio.mod: Modify test code to
provoke an error in the first basic block.
* gm2/errors/fail/testparam.mod: Ditto.
* gm2/errors/fail/array1.mod: Ditto.
* gm2/errors/fail/badtype.mod: New test.
* gm2/errors/fail/badvar.mod: New test.
(cherry picked from commit 7f8064ff0e2ac90c5bb6c30cc61acc5a28ebbe4c)
Signed-off-by: Gaius Mulley <gaiusm...@gmail.com>
Diff:
---
gcc/m2/Make-lang.in | 4 +
gcc/m2/gm2-compiler/M2Quads.mod | 45 ++--
gcc/m2/gm2-compiler/M2StateCheck.def | 154 ++++++++++++
gcc/m2/gm2-compiler/M2StateCheck.mod | 344 ++++++++++++++++++++++++++
gcc/m2/gm2-compiler/P3Build.bnf | 65 +++--
gcc/m2/gm2-compiler/PCBuild.bnf | 45 ++--
gcc/m2/gm2-gcc/init.cc | 4 +
gcc/testsuite/gm2/errors/fail/array1.mod | 5 +
gcc/testsuite/gm2/errors/fail/badtype.mod | 10 +
gcc/testsuite/gm2/errors/fail/badvar.mod | 10 +
gcc/testsuite/gm2/errors/fail/errors-fail.exp | 2 +-
gcc/testsuite/gm2/errors/fail/testfio.mod | 8 +
gcc/testsuite/gm2/errors/fail/testparam.mod | 5 +
13 files changed, 645 insertions(+), 56 deletions(-)
diff --git a/gcc/m2/Make-lang.in b/gcc/m2/Make-lang.in
index daa7ef6747a5..2bd60ca29393 100644
--- a/gcc/m2/Make-lang.in
+++ b/gcc/m2/Make-lang.in
@@ -808,6 +808,7 @@ GM2-COMP-BOOT-DEFS = \
M2Size.def \
M2StackAddress.def \
M2StackWord.def \
+ M2StateCheck.def \
M2Students.def \
M2Swig.def \
M2SymInit.def \
@@ -882,6 +883,7 @@ GM2-COMP-BOOT-MODS = \
M2Size.mod \
M2StackAddress.mod \
M2StackWord.mod \
+ M2StateCheck.mod \
M2Students.mod \
M2Swig.mod \
M2SymInit.mod \
@@ -1090,6 +1092,7 @@ GM2-COMP-DEFS = \
M2Size.def \
M2StackAddress.def \
M2StackWord.def \
+ M2StateCheck.def \
M2Students.def \
M2Swig.def \
M2SymInit.def \
@@ -1161,6 +1164,7 @@ GM2-COMP-MODS = \
M2Size.mod \
M2StackAddress.mod \
M2StackWord.mod \
+ M2StateCheck.mod \
M2Students.mod \
M2Swig.mod \
M2SymInit.mod \
diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod
index 6476806ac358..6230bf7d139e 100644
--- a/gcc/m2/gm2-compiler/M2Quads.mod
+++ b/gcc/m2/gm2-compiler/M2Quads.mod
@@ -12068,31 +12068,34 @@ BEGIN
PopTFtok (Sym, Type, tok) ;
DebugLocation (tok, "expression") ;
Type := SkipType (Type) ;
-
- Ref := MakeTemporary (tok, LeftValue) ;
- PutVar (Ref, Type) ;
- IF GetMode (Sym) = LeftValue
+ IF Type = NulSym
THEN
- (* Copy LeftValue. *)
- GenQuadO (tok, BecomesOp, Ref, NulSym, Sym, TRUE)
+ MetaErrorT1 (tok,
+ '{%1Aa} {%1d} has a no type, the {%kWITH} statement
requires a variable or parameter of a {%kRECORD} type',
+ Sym)
ELSE
- (* Calculate the address of Sym. *)
- GenQuadO (tok, AddrOp, Ref, NulSym, Sym, TRUE)
- END ;
+ Ref := MakeTemporary (tok, LeftValue) ;
+ PutVar (Ref, Type) ;
+ IF GetMode (Sym) = LeftValue
+ THEN
+ (* Copy LeftValue. *)
+ GenQuadO (tok, BecomesOp, Ref, NulSym, Sym, TRUE)
+ ELSE
+ (* Calculate the address of Sym. *)
+ GenQuadO (tok, AddrOp, Ref, NulSym, Sym, TRUE)
+ END ;
- PushWith (Sym, Type, Ref, tok) ;
- DebugLocation (tok, "with ref") ;
- IF Type = NulSym
- THEN
- MetaError1 ('{%1Ea} {%1d} has a no type, the {%kWITH} statement requires
a variable or parameter of a {%kRECORD} type',
- Sym)
- ELSIF NOT IsRecord(Type)
- THEN
- MetaError1 ('the {%kWITH} statement requires that {%1Ea} {%1d} be of a
{%kRECORD} {%1tsa:type rather than {%1tsa}}',
- Sym)
+ PushWith (Sym, Type, Ref, tok) ;
+ DebugLocation (tok, "with ref") ;
+ IF NOT IsRecord(Type)
+ THEN
+ MetaErrorT1 (tok,
+ 'the {%kWITH} statement requires that {%1Ea} {%1d} be of
a {%kRECORD} {%1tsa:type rather than {%1tsa}}',
+ Sym)
+ END ;
+ StartScope (Type)
END ;
- StartScope (Type)
- ; DisplayStack ;
+ DisplayStack ;
END StartBuildWith ;
diff --git a/gcc/m2/gm2-compiler/M2StateCheck.def
b/gcc/m2/gm2-compiler/M2StateCheck.def
new file mode 100644
index 000000000000..ca597c2d87f7
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2StateCheck.def
@@ -0,0 +1,154 @@
+(* M2StateCheck.def provide state check tracking for declarations.
+
+Copyright (C) 2024 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaiusm...@gmail.com>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Modula-2; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. *)
+
+DEFINITION MODULE M2StateCheck ;
+
+(* This module provides state tracking for VAR, TYPE and CONST
+ declarations. It should be used by any pass creating
+ symbols in these blocks and it will detect a constant
+ being created from a variable, type from a variable,
+ variable from a constant (instead of type) etc. *)
+
+TYPE
+ StateCheck ;
+
+
+(*
+ InitState - returns a new initialized StateCheck.
+*)
+
+PROCEDURE InitState () : StateCheck ;
+
+
+(*
+ KillState - destructor for StateCheck.
+*)
+
+PROCEDURE KillState (VAR s: StateCheck) ;
+
+
+(*
+ PushState - duplicates the StateCheck s and chains the new copy to s.
+ Return the copy.
+*)
+
+PROCEDURE PushState (VAR s: StateCheck) ;
+
+
+(*
+ PopState - pops the current state.
+*)
+
+PROCEDURE PopState (VAR s: StateCheck) ;
+
+
+(*
+ InclVar - s := s + {var}.
+*)
+
+PROCEDURE InclVar (s: StateCheck) ;
+
+
+(*
+ InclConst - s := s + {const}.
+*)
+
+PROCEDURE InclConst (s: StateCheck) ;
+
+
+(*
+ InclType - s := s + {type}.
+*)
+
+PROCEDURE InclType (s: StateCheck) ;
+
+
+(*
+ InclConstFunc - s := s + {constfunc}.
+*)
+
+PROCEDURE InclConstFunc (s: StateCheck) ;
+
+
+(*
+ InclVarParam - s := s + {varparam}.
+*)
+
+PROCEDURE InclVarParam (s: StateCheck) ;
+
+
+(*
+ InclConstructor - s := s + {constructor}.
+*)
+
+PROCEDURE InclConstructor (s: StateCheck) ;
+
+
+(*
+ ExclVar - s := s + {var}.
+*)
+
+PROCEDURE ExclVar (s: StateCheck) ;
+
+
+(*
+ ExclConst - s := s + {const}.
+*)
+
+PROCEDURE ExclConst (s: StateCheck) ;
+
+
+(*
+ ExclType - s := s + {type}.
+*)
+
+PROCEDURE ExclType (s: StateCheck) ;
+
+
+(*
+ ExclConstFunc - s := s + {constfunc}.
+*)
+
+PROCEDURE ExclConstFunc (s: StateCheck) ;
+
+
+(*
+ ExclVarParam - s := s + {varparam}.
+*)
+
+PROCEDURE ExclVarParam (s: StateCheck) ;
+
+
+(*
+ ExclConstructor - s := s - {varparam}.
+*)
+
+PROCEDURE ExclConstructor (s: StateCheck) ;
+
+
+(*
+ CheckQualident - checks to see that qualident sym is allowed in the state s.
+*)
+
+PROCEDURE CheckQualident (tok: CARDINAL; s: StateCheck; sym: CARDINAL) ;
+
+
+END M2StateCheck.
diff --git a/gcc/m2/gm2-compiler/M2StateCheck.mod
b/gcc/m2/gm2-compiler/M2StateCheck.mod
new file mode 100644
index 000000000000..e53cb174474c
--- /dev/null
+++ b/gcc/m2/gm2-compiler/M2StateCheck.mod
@@ -0,0 +1,344 @@
+(* M2StateCheck.mod provide state check tracking for declarations.
+
+Copyright (C) 2024 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaiusm...@gmail.com>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Modula-2; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. *)
+
+IMPLEMENTATION MODULE M2StateCheck ;
+
+FROM Storage IMPORT ALLOCATE ;
+FROM M2MetaError IMPORT MetaErrorStringT1 ;
+FROM DynamicStrings IMPORT String, InitString, ConCat, Mark ;
+FROM SymbolTable IMPORT NulSym, IsType, IsVar, IsConst ;
+
+
+TYPE
+ StateCheck = POINTER TO RECORD
+ state: StateSet ;
+ stack,
+ next : StateCheck ;
+ END ;
+
+ State = (const, var, type, constfunc, varparam, constructor) ;
+
+ StateSet = SET OF State ;
+
+VAR
+ FreeList: StateCheck ;
+
+
+(*
+ InitState - returns a new initialized StateCheck.
+*)
+
+PROCEDURE InitState () : StateCheck ;
+VAR
+ s: StateCheck ;
+BEGIN
+ s := New () ;
+ WITH s^ DO
+ state := StateSet {} ;
+ stack := NIL ;
+ next := NIL
+ END ;
+ RETURN s
+END InitState ;
+
+
+(*
+ New - returns an uninitialized StateCheck.
+*)
+
+PROCEDURE New () : StateCheck ;
+VAR
+ s: StateCheck ;
+BEGIN
+ IF FreeList = NIL
+ THEN
+ NEW (s)
+ ELSE
+ s := FreeList ;
+ FreeList := FreeList^.next
+ END ;
+ RETURN s
+END New ;
+
+
+(*
+ PushState - duplicates the StateCheck s and chains the new copy to s.
+ Return the copy.
+*)
+
+PROCEDURE PushState (VAR s: StateCheck) ;
+VAR
+ copy: StateCheck ;
+BEGIN
+ copy := InitState () ;
+ copy^.state := s^.state ;
+ copy^.stack := s ;
+ s := copy
+END PushState ;
+
+
+(*
+ KillState - destructor for StateCheck.
+*)
+
+PROCEDURE KillState (VAR s: StateCheck) ;
+VAR
+ t: StateCheck ;
+BEGIN
+ WHILE s^.stack # NIL DO
+ t := s^.stack ;
+ s^.stack := t^.stack ;
+ Dispose (t)
+ END ;
+ Dispose (s)
+END KillState ;
+
+
+(*
+ Dispose - place s onto the FreeList and set s to NIL.
+*)
+
+PROCEDURE Dispose (VAR s: StateCheck) ;
+BEGIN
+ s^.next := FreeList ;
+ FreeList := s
+END Dispose ;
+
+
+(*
+ InclVar - s := s + {var}.
+*)
+
+PROCEDURE InclVar (s: StateCheck) ;
+BEGIN
+ INCL (s^.state, var)
+END InclVar ;
+
+
+(*
+ InclConst - s := s + {const}.
+*)
+
+PROCEDURE InclConst (s: StateCheck) ;
+BEGIN
+ INCL (s^.state, const)
+END InclConst ;
+
+
+(*
+ InclType - s := s + {type}.
+*)
+
+PROCEDURE InclType (s: StateCheck) ;
+BEGIN
+ INCL (s^.state, type)
+END InclType ;
+
+
+(*
+ InclConstFunc - s := s + {constfunc}.
+*)
+
+PROCEDURE InclConstFunc (s: StateCheck) ;
+BEGIN
+ INCL (s^.state, constfunc)
+END InclConstFunc ;
+
+
+(*
+ InclVarParam - s := s + {varparam}.
+*)
+
+PROCEDURE InclVarParam (s: StateCheck) ;
+BEGIN
+ INCL (s^.state, varparam)
+END InclVarParam ;
+
+
+(*
+ InclConstructor - s := s + {constructor}.
+*)
+
+PROCEDURE InclConstructor (s: StateCheck) ;
+BEGIN
+ INCL (s^.state, constructor)
+END InclConstructor ;
+
+
+(*
+ ExclVar - s := s - {var}.
+*)
+
+PROCEDURE ExclVar (s: StateCheck) ;
+BEGIN
+ EXCL (s^.state, var)
+END ExclVar ;
+
+
+(*
+ ExclConst - s := s - {const}.
+*)
+
+PROCEDURE ExclConst (s: StateCheck) ;
+BEGIN
+ EXCL (s^.state, const)
+END ExclConst ;
+
+
+(*
+ ExclType - s := s - {type}.
+*)
+
+PROCEDURE ExclType (s: StateCheck) ;
+BEGIN
+ EXCL (s^.state, type)
+END ExclType ;
+
+
+(*
+ ExclConstFunc - s := s - {constfunc}.
+*)
+
+PROCEDURE ExclConstFunc (s: StateCheck) ;
+BEGIN
+ EXCL (s^.state, constfunc)
+END ExclConstFunc ;
+
+
+(*
+ ExclVarParam - s := s - {varparam}.
+*)
+
+PROCEDURE ExclVarParam (s: StateCheck) ;
+BEGIN
+ EXCL (s^.state, varparam)
+END ExclVarParam ;
+
+
+(*
+ ExclConstructor - s := s - {varparam}.
+*)
+
+PROCEDURE ExclConstructor (s: StateCheck) ;
+BEGIN
+ EXCL (s^.state, constructor)
+END ExclConstructor ;
+
+
+(*
+ PopState - pops the current state.
+*)
+
+PROCEDURE PopState (VAR s: StateCheck) ;
+VAR
+ t: StateCheck ;
+BEGIN
+ t := s ;
+ s := s^.stack ;
+ t^.stack := NIL ;
+ Dispose (t)
+END PopState ;
+
+
+(*
+ CheckQualident - checks to see that qualident sym is allowed in the state s.
+*)
+
+PROCEDURE CheckQualident (tok: CARDINAL; s: StateCheck; sym: CARDINAL) ;
+BEGIN
+ IF sym = NulSym
+ THEN
+ (* Ignore. *)
+ ELSIF IsType (sym)
+ THEN
+ IF (constfunc IN s^.state) OR (constructor IN s^.state)
+ THEN
+ (* Ok. *)
+ ELSIF const IN s^.state
+ THEN
+ GenerateError (tok, s, sym)
+ END
+ ELSIF IsConst (sym)
+ THEN
+ IF (constfunc IN s^.state) OR (constructor IN s^.state)
+ THEN
+ (* Ok. *)
+ ELSIF (var IN s^.state) OR (type IN s^.state)
+ THEN
+ GenerateError (tok, s, sym)
+ END
+ ELSIF IsVar (sym)
+ THEN
+ IF constfunc IN s^.state
+ THEN
+ (* Ok. *)
+ ELSIF (const IN s^.state) OR (type IN s^.state) OR (var IN s^.state)
+ THEN
+ GenerateError (tok, s, sym)
+ END
+ END
+END CheckQualident ;
+
+
+(*
+ GenerateError - generates an unrecoverable error string based on the state
and sym.
+*)
+
+PROCEDURE GenerateError (tok: CARDINAL; s: StateCheck; sym: CARDINAL) ;
+VAR
+ str: String ;
+BEGIN
+ str := InitString ('not expecting a {%1Ad} {%1a: }in a ') ;
+ IF const IN s^.state
+ THEN
+ str := ConCat (str, Mark (InitString ('{%kCONST} block')))
+ ELSIF type IN s^.state
+ THEN
+ str := ConCat (str, Mark (InitString ('{%kTYPE} block')))
+ ELSIF var IN s^.state
+ THEN
+ str := ConCat (str, Mark (InitString ('{%kVAR} block')))
+ END ;
+ IF constfunc IN s^.state
+ THEN
+ str := ConCat (str, Mark (InitString (' and within a constant procedure
function actual parameter')))
+ END ;
+ IF constructor IN s^.state
+ THEN
+ str := ConCat (str, Mark (InitString (' and within a constructor')))
+ END ;
+ MetaErrorStringT1 (tok, str, sym)
+END GenerateError ;
+
+
+(*
+ init - initialize the global variables in the module.
+*)
+
+PROCEDURE init ;
+BEGIN
+ FreeList := NIL
+END init ;
+
+
+BEGIN
+ init
+END M2StateCheck.
diff --git a/gcc/m2/gm2-compiler/P3Build.bnf b/gcc/m2/gm2-compiler/P3Build.bnf
index 0cec32914fcd..f48b508ba1dc 100644
--- a/gcc/m2/gm2-compiler/P3Build.bnf
+++ b/gcc/m2/gm2-compiler/P3Build.bnf
@@ -132,6 +132,7 @@ FROM M2Quads IMPORT PushT, PopT, PushTF, PopTF, PopNothing,
Annotate,
PushInConstExpression, PopInConstExpression,
PushInConstParameters, PopInConstParameters,
IsInConstParameters,
BuildDefaultFieldAlignment, BuildPragmaField,
+ OperandT, OperandTok,
IsAutoPushOn, PushAutoOff, PushAutoOn, PopAuto ;
FROM P3SymBuild IMPORT P3StartBuildProgModule,
@@ -177,6 +178,14 @@ FROM M2Batch IMPORT IsModuleKnown ;
FROM M2CaseList IMPORT BeginCaseList, EndCaseList ;
+FROM M2StateCheck IMPORT StateCheck,
+ InitState, PushState, PopState,
+ InclConst, ExclConst,
+ InclType, ExclType,
+ InclVar, ExclVar,
+ InclConstructor, ExclConstructor,
+ InclConstFunc, CheckQualident ;
+
IMPORT M2Error ;
CONST
@@ -184,19 +193,20 @@ CONST
DebugAsm = FALSE ;
VAR
- WasNoError: BOOLEAN ;
+ seenError : BOOLEAN ;
+ BlockState: StateCheck ;
PROCEDURE ErrorString (s: String) ;
BEGIN
- ErrorStringAt(s, GetTokenNo ()) ;
- WasNoError := FALSE
+ ErrorStringAt (s, GetTokenNo ()) ;
+ seenError := TRUE
END ErrorString ;
PROCEDURE ErrorArray (a: ARRAY OF CHAR) ;
BEGIN
- ErrorString(InitString(a))
+ ErrorString (InitString (a))
END ErrorArray ;
@@ -391,9 +401,9 @@ END Expect ;
PROCEDURE CompilationUnit () : BOOLEAN ;
BEGIN
- WasNoError := TRUE ;
+ seenError := FALSE ;
FileUnit(SetOfStop0{eoftok}, SetOfStop1{}, SetOfStop2{}) ;
- RETURN( WasNoError )
+ RETURN NOT seenError
END CompilationUnit ;
@@ -457,6 +467,8 @@ BEGIN
END Real ;
% module P3Build end
+BEGIN
+ BlockState := InitState ()
END P3Build.
% rules
error 'ErrorArray' 'ErrorString'
@@ -662,12 +674,25 @@ Qualident :=
% VAR
{ "." Ident } %
END %
=:
+
+QualidentCheck := %
PushAutoOn %
+ Qualident
+ %
PopAuto %
+ %
CheckQualident (OperandTok (1), BlockState, OperandT (1)) %
+ %
IF NOT IsAutoPushOn ()
+
THEN
+
PopNothing
+
END %
+ =:
+
ConstantDeclaration := %
VAR tokno: CARDINAL ; %
+ %
InclConst (BlockState) %
%
PushAutoOn %
( Ident "=" %
tokno := GetTokenNo () -1 %
%
BuildConst %
ConstExpression ) %
BuildAssignConstant (tokno) %
%
PopAuto %
+ %
ExclConst (BlockState) %
=:
ConstExpression := %
VAR tokpos: CARDINAL ; %
@@ -764,10 +789,14 @@ ArraySetRecordValue := ComponentValue
% Bui
Constructor := %
VAR tokpos: CARDINAL ; %
%
DisplayStack %
+ %
InclConstructor (BlockState) %
+ %
CheckQualident (OperandTok (1), BlockState, OperandT (1)) %
'{' %
tokpos := GetTokenNo () -1 %
%
BuildConstructorStart (tokpos) %
[ ArraySetRecordValue ] %
BuildConstructorEnd (tokpos, GetTokenNo()) %
- '}' =:
+ '}'
+ %
ExclConstructor (BlockState) %
+ =:
ConstSetOrQualidentOrFunction := %
VAR tokpos: CARDINAL ; %
%
tokpos := GetTokenNo () %
@@ -779,8 +808,12 @@ ConstSetOrQualidentOrFunction :=
% VAR
Constructor
) =:
-ConstActualParameters := %
PushInConstParameters %
+ConstActualParameters := %
PushState (BlockState) %
+ %
InclConstFunc (BlockState) %
+ %
CheckQualident (OperandTok (1), BlockState, OperandT (1)) %
+ %
PushInConstParameters %
ActualParameters %
PopInConstParameters %
+ %
PopState (BlockState) %
=:
ConstAttribute := "__ATTRIBUTE__" "__BUILTIN__" "(" "(" %
PushAutoOn %
@@ -802,7 +835,9 @@ ByteAlignment :=
% VAR
Alignment := [ ByteAlignment ] =:
-TypeDeclaration := Ident "=" Type Alignment
+TypeDeclaration := %
InclType (BlockState) %
+ Ident "=" Type Alignment
+ %
ExclType (BlockState) %
=:
Type :=
@@ -814,7 +849,7 @@ Type :=
| ProcedureType ) %
PopAuto %
=:
-SimpleType := Qualident [ SubrangeType ] | Enumeration | SubrangeType =:
+SimpleType := QualidentCheck [ SubrangeType ] | Enumeration | SubrangeType =:
Enumeration := "("
( IdentList
@@ -900,7 +935,7 @@ FieldList := IdentList ":"
TagIdent := [ Ident ] =:
-CaseTag := TagIdent [":" Qualident ] =:
+CaseTag := TagIdent [":" QualidentCheck ] =:
Varient := [ %
BeginVarientList %
VarientCaseLabelList ":" FieldListSequence %
EndVarientList %
@@ -980,7 +1015,7 @@ FormalTypeList := "(" ( ")" FormalReturn |
FormalReturn := [ ":" OptReturnType ] =:
-OptReturnType := "[" Qualident "]" | Qualident =:
+OptReturnType := "[" QualidentCheck "]" | QualidentCheck =:
ProcedureParameters := ProcedureParameter
{ "," ProcedureParameter } =:
@@ -1027,10 +1062,12 @@ VarIdentList := VarIdent
% VAR
=:
VariableDeclaration := VarIdentList ":"
+ %
InclVar (BlockState) %
Type Alignment
+ %
ExclVar (BlockState) %
=:
-Designator := Qualident %
CheckWithReference %
+Designator := QualidentCheck %
CheckWithReference %
{ SubDesignator } =:
SubDesignator := "." %
VAR Sym, Type, tok,
@@ -1419,7 +1456,7 @@ OptArg := "[" Ident ":" FormalType [ "=" ConstExpression
% Bui
DefOptArg := "[" Ident ":" FormalType "=" ConstExpression %
BuildOptArgInitializer %
"]" =:
-FormalType := { "ARRAY" "OF" } Qualident =:
+FormalType := { "ARRAY" "OF" } QualidentCheck =:
ModuleDeclaration := %
VAR modulet: CARDINAL ; %
%
modulet := GetTokenNo () %
diff --git a/gcc/m2/gm2-compiler/PCBuild.bnf b/gcc/m2/gm2-compiler/PCBuild.bnf
index 0e45b2e889cc..6e263b01629d 100644
--- a/gcc/m2/gm2-compiler/PCBuild.bnf
+++ b/gcc/m2/gm2-compiler/PCBuild.bnf
@@ -61,7 +61,8 @@ FROM M2Reserved IMPORT tokToTok, toktype,
OrTok, TimesTok, DivTok, DivideTok, ModTok, RemTok,
AndTok, AmbersandTok, PeriodPeriodTok, ByTok ;
-FROM M2Quads IMPORT Top, PushT, PopT, PushTF, PopTF, PopNothing, OperandT,
PushTFA,
+FROM M2Quads IMPORT Top, PushT, PopT, PushTF, PopTF, PopNothing, OperandT,
OperandTok,
+ PushTFA,
PushTFn, PopTFn, PushTFtok, PopTtok, PopTFtok, PushTtok,
PushTFntok,
PushT, PushTF, IsAutoPushOn, PushAutoOff, PushAutoOn,
PopAuto,
BuildTypeForConstructor, BuildConstructor,
BuildConstructorEnd,
@@ -120,6 +121,11 @@ FROM SymbolTable IMPORT MakeGnuAsm, PutGnuAsmVolatile,
PutGnuAsm, PutGnuAsmInput
FROM M2Batch IMPORT IsModuleKnown ;
+FROM M2StateCheck IMPORT StateCheck,
+ InitState, PushState, PopState, InclConst, ExclConst,
+ InclConstructor, ExclConstructor,
+ InclConstFunc, CheckQualident ;
+
IMPORT M2Error ;
@@ -128,9 +134,8 @@ CONST
Pass1 = FALSE ;
VAR
- InConstParameter,
- InConstBlock,
- seenError : BOOLEAN ;
+ BlockState: StateCheck ;
+ seenError : BOOLEAN ;
PROCEDURE ErrorString (s: String) ;
@@ -407,8 +412,7 @@ END Real ;
% module PCBuild end
BEGIN
- InConstParameter := FALSE ;
- InConstBlock := FALSE
+ BlockState := InitState ()
END PCBuild.
% rules
error 'ErrorArray' 'ErrorString'
@@ -597,7 +601,7 @@ Qualident :=
% VAR
=:
ConstantDeclaration := %
VAR top: CARDINAL ; %
- %
InConstBlock := TRUE %
+ %
InclConst (BlockState) %
%
top := Top() %
%
PushAutoOn %
( Ident "=" %
StartDesConst %
@@ -607,7 +611,7 @@ ConstantDeclaration :=
% VAR
%
EndDesConst %
%
PopAuto %
%
Assert(top=Top()) %
- %
InConstBlock := FALSE %
+ %
ExclConst (BlockState) %
=:
ConstExpression := %
VAR top: CARDINAL ; %
@@ -697,11 +701,14 @@ ComponentValue := ComponentElement [ 'BY' ConstExpression
] =:
ArraySetRecordValue := ComponentValue { ',' %
NextConstructorField %
ComponentValue } =:
-Constructor := '{' %
PushConstructorCastType %
+Constructor := '{' %
InclConstructor (BlockState) %
+ %
CheckQualident (OperandTok (1), BlockState, OperandT (1)) %
+ %
PushConstructorCastType %
%
PushInConstructor %
%
BuildConstructor (GetTokenNo ()-1) %
[ ArraySetRecordValue ] %
PopConstructor %
'}' %
PopInConstructor %
+ %
ExclConstructor (BlockState) %
=:
ConstructorOrConstActualParameters := Constructor | ConstActualParameters %
PushConstFunctionType %
@@ -714,23 +721,21 @@ ConstSetOrQualidentOrFunction :=
% Pus
%
VAR tokpos: CARDINAL ; %
%
tokpos := GetTokenNo () %
(
- PushQualident %
IF (NOT InConstParameter) AND InConstBlock
-
THEN
-
CheckNotVar (tokpos)
-
END %
- ( ConstructorOrConstActualParameters | %
PushConstType %
+ PushQualident
+ ( ConstructorOrConstActualParameters | %
CheckQualident (OperandTok (1), BlockState, OperandT (1)) %
+ %
PushConstType %
%
PopNothing %
)
| %
BuildTypeForConstructor (tokpos) %
Constructor ) %
PopAuto %
=:
-ConstActualParameters := %
VAR oldConstParameter: BOOLEAN ; %
- %
oldConstParameter := InConstParameter %
- %
InConstParameter := TRUE %
+ConstActualParameters := %
PushState (BlockState) %
+ %
InclConstFunc (BlockState) %
+ %
CheckQualident (OperandTok (1), BlockState, OperandT (1)) %
%
PushT(0) %
"(" [ ConstExpList ] ")"
- %
InConstParameter := oldConstParameter %
+ %
PopState (BlockState) %
=:
ConstExpList := %
VAR n: CARDINAL ; %
@@ -1023,9 +1028,9 @@ ConstructorOrSimpleDes := Constructor |
% Pop
SimpleDes [ ActualParameters ]
=:
-SetOrDesignatorOrFunction := %
PushAutoOff %
- %
VAR tokpos: CARDINAL ; %
+SetOrDesignatorOrFunction := %
VAR tokpos: CARDINAL ; %
%
tokpos := GetTokenNo () %
+ %
PushAutoOff %
(
PushQualident
( ConstructorOrSimpleDes | %
PopNothing %
diff --git a/gcc/m2/gm2-gcc/init.cc b/gcc/m2/gm2-gcc/init.cc
index 17ca9189f10c..de9fb9970700 100644
--- a/gcc/m2/gm2-gcc/init.cc
+++ b/gcc/m2/gm2-gcc/init.cc
@@ -105,6 +105,8 @@ EXTERN void _M2_ldtoa_init (int argc, char *argv[], char
*envp[]);
EXTERN void _M2_M2Check_init (int argc, char *argv[], char *envp[]);
EXTERN void _M2_M2SSA_init (int argc, char *argv[], char *envp[]);
EXTERN void _M2_M2SymInit_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_M2StateCheck_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_P3Build_init (int argc, char *argv[], char *envp[]);
EXTERN void exit (int);
EXTERN void M2Comp_compile (const char *filename);
EXTERN void RTExceptions_DefaultErrorCatch (void);
@@ -200,5 +202,7 @@ init_PerCompilationInit (const char *filename)
_M2_M2SymInit_init (0, NULL, NULL);
_M2_M2Check_init (0, NULL, NULL);
_M2_M2LangDump_init (0, NULL, NULL);
+ _M2_M2StateCheck_init (0, NULL, NULL);
+ _M2_P3Build_init (0, NULL, NULL);
M2Comp_compile (filename);
}
diff --git a/gcc/testsuite/gm2/errors/fail/array1.mod
b/gcc/testsuite/gm2/errors/fail/array1.mod
index 274011be953e..221b32ed7be1 100644
--- a/gcc/testsuite/gm2/errors/fail/array1.mod
+++ b/gcc/testsuite/gm2/errors/fail/array1.mod
@@ -17,9 +17,14 @@ Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
02110-1301, USA. *)
MODULE array1 ;
+PROCEDURE init ;
VAR
a: ARRAY [FALSE..TRUE] OF CARDINAL ;
i, j: CARDINAL ;
BEGIN
a[i=j] := j
+END init ;
+
+BEGIN
+ init
END array1.
diff --git a/gcc/testsuite/gm2/errors/fail/badtype.mod
b/gcc/testsuite/gm2/errors/fail/badtype.mod
new file mode 100644
index 000000000000..32ac3a6447c2
--- /dev/null
+++ b/gcc/testsuite/gm2/errors/fail/badtype.mod
@@ -0,0 +1,10 @@
+MODULE badtype ;
+
+PROCEDURE bar (VAR a: CARDINAL) ;
+TYPE
+ Foo = a ;
+BEGIN
+END bar ;
+
+BEGIN
+END badtype.
diff --git a/gcc/testsuite/gm2/errors/fail/badvar.mod
b/gcc/testsuite/gm2/errors/fail/badvar.mod
new file mode 100644
index 000000000000..2d67cb60d0b0
--- /dev/null
+++ b/gcc/testsuite/gm2/errors/fail/badvar.mod
@@ -0,0 +1,10 @@
+MODULE badvar ;
+
+PROCEDURE bar (VAR a: CARDINAL) ;
+VAR
+ Foo: a ;
+BEGIN
+END bar ;
+
+BEGIN
+END badvar.
diff --git a/gcc/testsuite/gm2/errors/fail/errors-fail.exp
b/gcc/testsuite/gm2/errors/fail/errors-fail.exp
index 8af0e7299971..a8fbd2c177de 100644
--- a/gcc/testsuite/gm2/errors/fail/errors-fail.exp
+++ b/gcc/testsuite/gm2/errors/fail/errors-fail.exp
@@ -25,7 +25,7 @@ if $tracelevel then {
# load support procs
load_lib gm2-torture.exp
-gm2_init_pim "${srcdir}/gm2/errors/fail" -Wpedantic -Wstudents
-Wunused-variable
+gm2_init_iso "${srcdir}/gm2/errors/fail" -Wpedantic -Wunused-variable
-Wuninit-variable-checking=all
foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
# If we're only testing specific files and this isn't one of them, skip it.
diff --git a/gcc/testsuite/gm2/errors/fail/testfio.mod
b/gcc/testsuite/gm2/errors/fail/testfio.mod
index fabf93ecb95b..f11e09eeac19 100644
--- a/gcc/testsuite/gm2/errors/fail/testfio.mod
+++ b/gcc/testsuite/gm2/errors/fail/testfio.mod
@@ -22,12 +22,16 @@ FROM StdIO IMPORT Write ;
FROM StrIO IMPORT WriteString, WriteLn ;
FROM FIO IMPORT Exists, OpenToRead, Close, File, IsNoError, EOF, ReadChar ;
+PROCEDURE init ;
VAR
i: INTEGER ;
f: File ;
c: CARDINAL ;
a: ARRAY [0..20] OF CHAR ;
BEGIN
+ IF f = 0
+ THEN
+ END ;
WriteString('testfio starting') ; WriteLn ;
c := 1 ;
WHILE GetArg(a, c) DO
@@ -45,4 +49,8 @@ BEGIN
END ;
INC(c)
END
+END init ;
+
+BEGIN
+ init
END testfio.
diff --git a/gcc/testsuite/gm2/errors/fail/testparam.mod
b/gcc/testsuite/gm2/errors/fail/testparam.mod
index 238334f35bab..142a2517c1c5 100644
--- a/gcc/testsuite/gm2/errors/fail/testparam.mod
+++ b/gcc/testsuite/gm2/errors/fail/testparam.mod
@@ -19,10 +19,15 @@ MODULE testparam ;
FROM FIO IMPORT IsNoError, Close, EOF ;
+PROCEDURE init ;
VAR
i: INTEGER ;
BEGIN
IF EOF(i)
THEN
END
+END init ;
+
+BEGIN
+ init
END testparam.
