[flang] Fix compile-time infinite loop (#66246)

When a COMMON block object has a derived type that is part of a set of
mutually-dependent types with other members, the compiler loops.

Fixes #65572.

Author: klausler

flang/lib/Semantics/resolve-names.cpp

@@ -1131,7 +1131,8 @@ class DeclarationVisitor : public ArraySpecVisitor,
   bool OkToAddComponent(const parser::Name &, const Symbol * = nullptr);
   ParamValue GetParamValue(
       const parser::TypeParamValue &, common::TypeParamAttr attr);
-  void CheckCommonBlockDerivedType(const SourceName &, const Symbol &);
+  void CheckCommonBlockDerivedType(
+      const SourceName &, const Symbol &, UnorderedSymbolSet &);
   Attrs HandleSaveName(const SourceName &, Attrs);
   void AddSaveName(std::set<SourceName> &, const SourceName &);
   bool HandleUnrestrictedSpecificIntrinsicFunction(const parser::Name &);
@@ -6096,7 +6097,8 @@ void DeclarationVisitor::CheckCommonBlocks() {
               "Derived type '%s' in COMMON block must have the BIND or"
               " SEQUENCE attribute"_err_en_US);
         }
-        CheckCommonBlockDerivedType(name, typeSymbol);
+        UnorderedSymbolSet typeSet;
+        CheckCommonBlockDerivedType(name, typeSymbol, typeSet);
       }
     }
   }
@@ -6120,8 +6122,12 @@ bool DeclarationVisitor::NameIsKnownOrIntrinsic(const parser::Name &name) {
 }
 
 // Check if this derived type can be in a COMMON block.
-void DeclarationVisitor::CheckCommonBlockDerivedType(
-    const SourceName &name, const Symbol &typeSymbol) {
+void DeclarationVisitor::CheckCommonBlockDerivedType(const SourceName &name,
+    const Symbol &typeSymbol, UnorderedSymbolSet &typeSet) {
+  if (auto iter{typeSet.find(SymbolRef{typeSymbol})}; iter != typeSet.end()) {
+    return;
+  }
+  typeSet.emplace(typeSymbol);
   if (const auto *scope{typeSymbol.scope()}) {
     for (const auto &pair : *scope) {
       const Symbol &component{*pair.second};
@@ -6144,13 +6150,7 @@ void DeclarationVisitor::CheckCommonBlockDerivedType(
         if (const auto *type{details->type()}) {
           if (const auto *derived{type->AsDerived()}) {
             const Symbol &derivedTypeSymbol{derived->typeSymbol()};
-            // Don't call this member function recursively if the derived type
-            // symbol is the same symbol that is already being processed.
-            // This can happen when a component is a pointer of the same type
-            // as its parent component, for instance.
-            if (derivedTypeSymbol != typeSymbol) {
-              CheckCommonBlockDerivedType(name, derivedTypeSymbol);
-            }
+            CheckCommonBlockDerivedType(name, derivedTypeSymbol, typeSet);
           }
         }
       }

flang/test/Semantics/equivalence01.f90

@@ -230,3 +230,17 @@ real function f17b()
     equivalence (dupName, y)
   end function f17b
 end module m17
+
+module m18
+  ! Regression test: don't loop when checking mutually-referencing types
+  type t1
+    sequence
+    type (t2), pointer :: p
+  end type
+  type t2
+    sequence
+    type (t1), pointer :: p
+  end type
+  type(t1) x
+  common x
+end