https://gcc.gnu.org/g:fba2f08152375e2c1c167ec921a0197e4c07efc6
commit r16-1546-gfba2f08152375e2c1c167ec921a0197e4c07efc6
Author: Gaius Mulley <gaiusm...@gmail.com>
Date: Tue Jun 17 17:41:21 2025 +0100
PR modula2/120673: Mutually dependent types crash the compiler
This patch fixes an ICE which will occur if cyclic dependent types
are used when declaring a variable. This patch detects the
cyclic dependency and issues an error message for each outstanding
component.
gcc/m2/ChangeLog:
PR modula2/120673
* gm2-compiler/M2GCCDeclare.mod (ErrorDepList): New
global variable set containing every errant dependency symbol.
(mystop): Remove.
(EmitCircularDependancyError): Replace with ...
(EmitCircularDependencyError): ... this.
(AssertAllTypesDeclared): Rewrite.
(DoVariableDeclaration): Ditto.
(TypeDependentsDeclared): New procedure function.
(PrepareGCCVarDeclaration): Ditto.
(DeclareVariable): Remove assert.
(DeclareLocalVariable): Ditto.
(Constructor): Initialize ErrorDepList.
* gm2-compiler/M2MetaError.mod (doErrorScopeProc): Rewrite
and ensure that a symbol with a module scope does not lookup
from a definition module.
* gm2-compiler/P2SymBuild.mod (BuildType): Rewrite so that
a synonym type is created using the token refering to the name
on the lhs.
gcc/testsuite/ChangeLog:
PR modula2/120673
* gm2/pim/fail/badmodvar.mod: New test.
* gm2/pim/fail/cyclictypes.mod: New test.
* gm2/pim/fail/cyclictypes2.mod: New test.
* gm2/pim/fail/cyclictypes4.mod: New test.
Signed-off-by: Gaius Mulley <gaiusm...@gmail.com>
Diff:
---
gcc/m2/gm2-compiler/M2GCCDeclare.mod | 94 +++++++++++++++++++++--------
gcc/m2/gm2-compiler/M2MetaError.mod | 37 ++++--------
gcc/m2/gm2-compiler/P2SymBuild.mod | 31 ++++++----
gcc/testsuite/gm2/pim/fail/badmodvar.mod | 7 +++
gcc/testsuite/gm2/pim/fail/cyclictypes.mod | 13 ++++
gcc/testsuite/gm2/pim/fail/cyclictypes2.mod | 9 +++
gcc/testsuite/gm2/pim/fail/cyclictypes4.mod | 13 ++++
7 files changed, 140 insertions(+), 64 deletions(-)
diff --git a/gcc/m2/gm2-compiler/M2GCCDeclare.mod
b/gcc/m2/gm2-compiler/M2GCCDeclare.mod
index b12add6b26e8..be80695d3e8a 100644
--- a/gcc/m2/gm2-compiler/M2GCCDeclare.mod
+++ b/gcc/m2/gm2-compiler/M2GCCDeclare.mod
@@ -251,6 +251,7 @@ TYPE
VAR
FreeGroup,
GlobalGroup : Group ; (* The global group of all sets. *)
+ ErrorDepList, (* The set of symbols with dependency errors. *)
VisitedList,
ChainedList : Set ;
HaveInitDefaultTypes: BOOLEAN ; (* Have we initialized them yet? *)
@@ -261,9 +262,6 @@ VAR
enumDeps : BOOLEAN ;
-PROCEDURE mystop ; BEGIN END mystop ;
-
-
(* *************************************************** *)
(*
PrintNum -
@@ -1315,14 +1313,26 @@ END CanBeDeclaredPartiallyViaPartialDependants ;
(*
- EmitCircularDependancyError - issue a dependancy error.
+ EmitCircularDependencyError - issue a dependency error.
*)
-PROCEDURE EmitCircularDependancyError (sym: CARDINAL) ;
+PROCEDURE EmitCircularDependencyError (sym: CARDINAL) ;
BEGIN
- MetaError1('circular dependancy error found when trying to resolve {%1Uad}',
- sym)
-END EmitCircularDependancyError ;
+ (* Ensure we only issue one dependency message per symbol for this
+ error classification. *)
+ IF NOT IsElementInSet (ErrorDepList, sym)
+ THEN
+ IncludeElementIntoSet (ErrorDepList, sym) ;
+ IF IsVar (sym) OR IsParameter (sym)
+ THEN
+ MetaError1 ('circular dependency error found when trying to resolve
{%1Had}',
+ sym)
+ ELSE
+ MetaError1 ('circular dependency error found when trying to resolve
{%1Dad}',
+ sym)
+ END
+ END
+END EmitCircularDependencyError ;
TYPE
@@ -1529,17 +1539,17 @@ BEGIN
IF ForeachTryDeclare (todolist,
circulartodo,
NotAllDependantsFullyDeclared,
- EmitCircularDependancyError)
+ EmitCircularDependencyError)
THEN
ELSIF ForeachTryDeclare (partiallydeclared,
circularpartial,
NotAllDependantsPartiallyDeclared,
- EmitCircularDependancyError)
+ EmitCircularDependencyError)
THEN
ELSIF ForeachTryDeclare (niltypedarrays,
circularniltyped,
NotAllDependantsPartiallyDeclared,
- EmitCircularDependancyError)
+ EmitCircularDependencyError)
THEN
END
END ;
@@ -2855,13 +2865,8 @@ BEGIN
n := 1 ;
Var := GetNth(scope, n) ;
WHILE Var#NulSym DO
- IF NOT AllDependantsFullyDeclared(GetSType(Var))
- THEN
- mystop
- END ;
- IF NOT AllDependantsFullyDeclared(GetSType(Var))
+ IF NOT TypeDependentsDeclared (Var, TRUE)
THEN
- EmitCircularDependancyError(GetSType(Var)) ;
failed := TRUE
END ;
INC(n) ;
@@ -3411,15 +3416,55 @@ PROCEDURE DoVariableDeclaration (var: CARDINAL; name:
ADDRESS;
isImported, isExported,
isTemporary, isGlobal: BOOLEAN;
scope: tree) ;
+BEGIN
+ IF NOT (IsComponent (var) OR IsVarHeap (var))
+ THEN
+ IF TypeDependentsDeclared (var, TRUE)
+ THEN
+ PrepareGCCVarDeclaration (var, name, isImported, isExported,
+ isTemporary, isGlobal, scope)
+ END
+ END
+END DoVariableDeclaration ;
+
+
+(*
+ TypeDependentsDeclared - return TRUE if all type dependents of variable
+ have been declared.
+*)
+
+PROCEDURE TypeDependentsDeclared (variable: CARDINAL; errorMessage: BOOLEAN) :
BOOLEAN ;
+VAR
+ type: CARDINAL ;
+BEGIN
+ type := GetSType (variable) ;
+ IF AllDependantsFullyDeclared (type)
+ THEN
+ RETURN TRUE
+ ELSE
+ IF errorMessage
+ THEN
+ EmitCircularDependencyError (variable) ;
+ ForeachElementInSetDo (GlobalGroup^.ToDoList,
EmitCircularDependencyError)
+ END
+ END ;
+ RETURN FALSE
+END TypeDependentsDeclared ;
+
+
+(*
+ PrepareGCCVarDeclaration -
+*)
+
+PROCEDURE PrepareGCCVarDeclaration (var: CARDINAL; name: ADDRESS;
+ isImported, isExported,
+ isTemporary, isGlobal: BOOLEAN;
+ scope: tree) ;
VAR
type : tree ;
varType : CARDINAL ;
location: location_t ;
BEGIN
- IF IsComponent (var) OR IsVarHeap (var)
- THEN
- RETURN
- END ;
IF GetMode (var) = LeftValue
THEN
(*
@@ -3457,7 +3502,7 @@ BEGIN
isGlobal, scope, NIL)) ;
WatchRemoveList (var, todolist) ;
WatchIncludeList (var, fullydeclared)
-END DoVariableDeclaration ;
+END PrepareGCCVarDeclaration ;
(*
@@ -3493,7 +3538,6 @@ BEGIN
THEN
scope := FindContext (ModSym) ;
decl := FindOuterModule (variable) ;
- Assert (AllDependantsFullyDeclared (GetSType (variable))) ;
PushBinding (ModSym) ;
DoVariableDeclaration (variable,
KeyToCharStar (GetFullSymName (variable)),
@@ -3521,7 +3565,6 @@ BEGIN
THEN
scope := FindContext (mainModule) ;
decl := FindOuterModule (variable) ;
- Assert (AllDependantsFullyDeclared (GetSType (variable))) ;
PushBinding (mainModule) ;
DoVariableDeclaration (variable,
KeyToCharStar (GetFullSymName (variable)),
@@ -3618,7 +3661,6 @@ END DeclareImportedVariablesWholeProgram ;
PROCEDURE DeclareLocalVariable (var: CARDINAL) ;
BEGIN
- Assert (AllDependantsFullyDeclared (var)) ;
DoVariableDeclaration (var,
KeyToCharStar (GetFullSymName (var)),
FALSE, (* local variables cannot be imported *)
@@ -3662,7 +3704,6 @@ BEGIN
scope := Mod2Gcc (GetProcedureScope (sym)) ;
Var := GetNth (sym, i) ;
WHILE Var # NulSym DO
- Assert (AllDependantsFullyDeclared (GetSType (Var))) ;
DoVariableDeclaration (Var,
KeyToCharStar (GetFullSymName (Var)),
FALSE, (* inner module variables cannot be
imported *)
@@ -6658,6 +6699,7 @@ END InitDeclarations ;
BEGIN
FreeGroup := NIL ;
GlobalGroup := InitGroup () ;
+ ErrorDepList := InitSet (1) ;
ChainedList := InitSet(1) ;
WatchList := InitSet(1) ;
VisitedList := NIL ;
diff --git a/gcc/m2/gm2-compiler/M2MetaError.mod
b/gcc/m2/gm2-compiler/M2MetaError.mod
index 22bc77f6ad00..3aa7543231d7 100644
--- a/gcc/m2/gm2-compiler/M2MetaError.mod
+++ b/gcc/m2/gm2-compiler/M2MetaError.mod
@@ -1437,35 +1437,22 @@ BEGIN
doError (eb, GetDeclaredDef (sym))
ELSE
M2Error.EnterErrorScope (GetErrorScope (scope)) ;
- IF IsProcedure (scope)
+ IF IsVar (sym) OR IsParameter (sym)
THEN
- IF IsVar (sym) OR IsParameter (sym)
- THEN
- doError (eb, GetVarParamTok (sym))
- ELSE
- doError (eb, GetDeclaredDef (sym))
- END
+ doError (eb, GetVarParamTok (sym))
+ ELSIF IsProcedure (scope)
+ THEN
+ doError (eb, GetDeclaredDef (sym))
+ ELSIF IsModule (scope)
+ THEN
+ doError (eb, GetDeclaredMod (sym))
ELSE
- IF IsModule (scope)
+ Assert (IsDefImp (scope)) ;
+ IF GetDeclaredDefinition (sym) = UnknownTokenNo
THEN
- IF IsInnerModule (scope)
- THEN
- doError (eb, GetDeclaredDef (sym))
- ELSE
- doError (eb, GetDeclaredDef (sym))
- END
+ doError (eb, GetDeclaredMod (sym))
ELSE
- Assert (IsDefImp (scope)) ;
- (* if this fails then we need to skip to the outer scope.
- REPEAT
- OuterModule := GetScope(OuterModule)
- UNTIL GetScope(OuterModule)=NulSym ; *)
- IF GetDeclaredDefinition (sym) = UnknownTokenNo
- THEN
- doError (eb, GetDeclaredMod (sym))
- ELSE
- doError (eb, GetDeclaredDef (sym))
- END
+ doError (eb, GetDeclaredDef (sym))
END
END
END ;
diff --git a/gcc/m2/gm2-compiler/P2SymBuild.mod
b/gcc/m2/gm2-compiler/P2SymBuild.mod
index 8f3b4995ac88..5c82ec8ede05 100644
--- a/gcc/m2/gm2-compiler/P2SymBuild.mod
+++ b/gcc/m2/gm2-compiler/P2SymBuild.mod
@@ -1225,7 +1225,8 @@ VAR
Sym,
Type : CARDINAL ;
name : Name ;
- tokno : CARDINAL ;
+ nametokno,
+ typetokno: CARDINAL ;
BEGIN
(*
Two cases
@@ -1234,8 +1235,8 @@ BEGIN
- when type with a name that is different to Name. In which case
we create a new type.
*)
- PopTtok(Type, tokno) ;
- PopT(name) ;
+ PopTtok (Type, typetokno) ;
+ PopTtok (name, nametokno) ;
IF Debugging
THEN
n1 := GetSymName(GetCurrentModule()) ;
@@ -1264,11 +1265,11 @@ BEGIN
*)
(* WriteString('Blank name type') ; WriteLn ; *)
- PushTFtok(Type, name, tokno) ;
+ PushTFtok(Type, name, typetokno) ;
Annotate("%1s(%1d)|%2n|%3d||type|type name|token no")
ELSIF IsError(Type)
THEN
- PushTFtok(Type, name, tokno) ;
+ PushTFtok(Type, name, typetokno) ;
Annotate("%1s(%1d)|%2n|%3d||error type|error type name|token no")
ELSIF GetSymName(Type)=name
THEN
@@ -1276,7 +1277,7 @@ BEGIN
IF isunknown OR
(NOT IsDeclaredIn(GetCurrentScope(), Type))
THEN
- Sym := MakeType(tokno, name) ;
+ Sym := MakeType (typetokno, name) ;
IF NOT IsError(Sym)
THEN
IF Sym=Type
@@ -1295,19 +1296,23 @@ BEGIN
CheckForEnumerationInCurrentModule(Type)
END
END ;
- PushTFtok(Sym, name, tokno) ;
+ PushTFtok(Sym, name, typetokno) ;
Annotate("%1s(%1d)|%2n|%3d||type|type name|token no")
ELSE
- PushTFtok(Type, name, tokno) ;
+ PushTFtok(Type, name, typetokno) ;
Annotate("%1s(%1d)|%2n|%3d||type|type name|token no")
END
ELSE
(* example TYPE a = CARDINAL *)
- Sym := MakeType(tokno, name) ;
- PutType(Sym, Type) ;
- CheckForExportedImplementation(Sym) ; (* May be an exported hidden
type *)
- PushTFtok(Sym, name, tokno) ;
- Annotate("%1s(%1d)|%2n|%3d||type|type name|token no")
+ Sym := MakeType (nametokno, name) ;
+ PutType (Sym, Type) ;
+ CheckForExportedImplementation (Sym) ; (* May be an exported hidden
type *)
+ PushTFtok (Sym, name, nametokno) ;
+ Annotate ("%1s(%1d)|%2n|%3d||type|type name|token no") ;
+ IF Debugging
+ THEN
+ MetaErrorT1 (nametokno, 'type pos {%1Wa}', Sym)
+ END
END
END BuildType ;
diff --git a/gcc/testsuite/gm2/pim/fail/badmodvar.mod
b/gcc/testsuite/gm2/pim/fail/badmodvar.mod
new file mode 100644
index 000000000000..dd90920af71f
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/badmodvar.mod
@@ -0,0 +1,7 @@
+MODULE badmodvar ;
+
+VAR
+ x: y ;
+BEGIN
+
+END badmodvar.
diff --git a/gcc/testsuite/gm2/pim/fail/cyclictypes.mod
b/gcc/testsuite/gm2/pim/fail/cyclictypes.mod
new file mode 100644
index 000000000000..f2adb49c9082
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/cyclictypes.mod
@@ -0,0 +1,13 @@
+MODULE cyclictypes ;
+
+TYPE
+ A = B;
+ B = A;
+
+PROCEDURE foo ;
+VAR
+ bar: A ;
+END foo ;
+
+
+END cyclictypes.
diff --git a/gcc/testsuite/gm2/pim/fail/cyclictypes2.mod
b/gcc/testsuite/gm2/pim/fail/cyclictypes2.mod
new file mode 100644
index 000000000000..a5630c86ff6a
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/cyclictypes2.mod
@@ -0,0 +1,9 @@
+MODULE cyclictypes2 ;
+
+TYPE
+ A = B;
+ B = A;
+
+VAR
+ bar: A ;
+END cyclictypes2.
diff --git a/gcc/testsuite/gm2/pim/fail/cyclictypes4.mod
b/gcc/testsuite/gm2/pim/fail/cyclictypes4.mod
new file mode 100644
index 000000000000..69f061b6ebb1
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/cyclictypes4.mod
@@ -0,0 +1,13 @@
+MODULE cyclictypes4 ;
+
+TYPE
+ A = B ;
+ B = C ;
+ C = D ;
+ D = A ;
+
+VAR
+ v: A ;
+BEGIN
+
+END cyclictypes4.
