diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp index 865c198424696..ec0115ba90f07 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 &, 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 66f183c489258..7ef47fb554b5e 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