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 <[email protected]>

Author: Gaius Mulley

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 ;

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 ;

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,19 +1265,19 @@ 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
       isunknown := IsUnknown(Type) ;
       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 ;
 

gcc/testsuite/gm2/pim/fail/badmodvar.mod

@@ -0,0 +1,7 @@
+MODULE badmodvar ;
+
+VAR
+   x: y ;
+BEGIN
+
+END badmodvar.

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.

gcc/testsuite/gm2/pim/fail/cyclictypes2.mod

@@ -0,0 +1,9 @@
+MODULE cyclictypes2 ;
+
+TYPE
+   A = B;
+   B = A;
+
+VAR
+   bar: A ;
+END cyclictypes2.

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.