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

[Peter Klausler via flang-commits]

https://github.com/klausler created https://github.com/llvm/llvm-project/pull/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 https://github.com/llvm/llvm-project/issues/65572.

>From 7640dc5bb5c359937c07d33dd410f2e92c879dab Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Fri, 8 Sep 2023 12:23:43 -0700
Subject: [PATCH] [flang] Fix compile-time infinite loop

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 https://github.com/llvm/llvm-project/issues/65572.
---
 flang/lib/Semantics/resolve-names.cpp  | 22 +++++++++++-----------
 flang/test/Semantics/equivalence01.f90 | 14 ++++++++++++++
 2 files changed, 25 insertions(+), 11 deletions(-)

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