[flang] Fix compile-time infinite loop

[klausler]

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.

[llvmbot]

@llvm/pr-subscribers-flang-semantics

Changes

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.

Full diff: https://github.com/llvm/llvm-project/pull/66246.diff

2 Files Affected:

• (modified) flang/lib/Semantics/resolve-names.cpp (+11-11)
• (modified) flang/test/Semantics/equivalence01.f90 (+14)

diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 865c198424696a9..ec0115ba90f078c 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/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);
           }
         }
       }
diff --git a/flang/test/Semantics/equivalence01.f90 b/flang/test/Semantics/equivalence01.f90
index 66f183c489258af..7ef47fb554b5eec 100644
--- a/flang/test/Semantics/equivalence01.f90
+++ b/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

[clementval]

LGTM