diff --git a/flang/include/flang/Semantics/tools.h b/flang/include/flang/Semantics/tools.h index db73a85768f5b..b977fb812fb11 100644 --- a/flang/include/flang/Semantics/tools.h +++ b/flang/include/flang/Semantics/tools.h @@ -770,5 +770,7 @@ std::string GetCommonBlockObjectName(const Symbol &, bool underscoring); // Check for ambiguous USE associations bool HadUseError(SemanticsContext &, SourceName at, const Symbol *); +bool AreSameModuleSymbol(const Symbol &, const Symbol &); + } // namespace Fortran::semantics #endif // FORTRAN_SEMANTICS_TOOLS_H_ diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp index 7b881008219df..0b9074c911cd2 100644 --- a/flang/lib/Semantics/check-declarations.cpp +++ b/flang/lib/Semantics/check-declarations.cpp @@ -2976,14 +2976,6 @@ static std::optional DefinesGlobalName(const Symbol &symbol) { return std::nullopt; } -static bool IsSameSymbolFromHermeticModule( - const Symbol &symbol, const Symbol &other) { - return symbol.name() == other.name() && symbol.owner().IsModule() && - other.owner().IsModule() && symbol.owner() != other.owner() && - symbol.owner().GetName() && - symbol.owner().GetName() == other.owner().GetName(); -} - // 19.2 p2 void CheckHelper::CheckGlobalName(const Symbol &symbol) { if (auto global{DefinesGlobalName(symbol)}) { @@ -3001,7 +2993,7 @@ void CheckHelper::CheckGlobalName(const Symbol &symbol) { (!IsExternalProcedureDefinition(symbol) || !IsExternalProcedureDefinition(other))) { // both are procedures/BLOCK DATA, not both definitions - } else if (IsSameSymbolFromHermeticModule(symbol, other)) { + } else if (AreSameModuleSymbol(symbol, other)) { // Both symbols are the same thing. } else if (symbol.has()) { Warn(common::LanguageFeature::BenignNameClash, symbol.name(), diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp index 5041a6a08fc3c..dfee5d85fa8fa 100644 --- a/flang/lib/Semantics/resolve-names.cpp +++ b/flang/lib/Semantics/resolve-names.cpp @@ -3963,8 +3963,26 @@ void ModuleVisitor::DoAddUse(SourceName location, SourceName localName, } } + auto AreSameModuleProcOrBothInterfaces{[](const Symbol &p1, + const Symbol &p2) { + if (IsProcedure(p1) && !IsPointer(p1) && IsProcedure(p2) && + !IsPointer(p2)) { + auto classification{ClassifyProcedure(p1)}; + if (classification == ClassifyProcedure(p2)) { + if (classification == ProcedureDefinitionClass::External) { + const auto *subp1{p1.detailsIf()}; + const auto *subp2{p2.detailsIf()}; + return subp1 && subp1->isInterface() && subp2 && subp2->isInterface(); + } else if (classification == ProcedureDefinitionClass::Module) { + return AreSameModuleSymbol(p1, p2); + } + } + } + return false; + }}; + auto AreSameProcedure{[&](const Symbol &p1, const Symbol &p2) { - if (&p1 == &p2) { + if (&p1.GetUltimate() == &p2.GetUltimate()) { return true; } else if (p1.name() != p2.name()) { return false; @@ -3972,31 +3990,16 @@ void ModuleVisitor::DoAddUse(SourceName location, SourceName localName, p2.attrs().test(Attr::INTRINSIC)) { return p1.attrs().test(Attr::INTRINSIC) && p2.attrs().test(Attr::INTRINSIC); - } else if (!IsProcedure(p1) || !IsProcedure(p2)) { - return false; - } else if (IsPointer(p1) || IsPointer(p2)) { - return false; - } else if (const auto *subp{p1.detailsIf()}; - subp && !subp->isInterface()) { - return false; // defined in module, not an external - } else if (const auto *subp{p2.detailsIf()}; - subp && !subp->isInterface()) { - return false; // defined in module, not an external + } else if (AreSameModuleProcOrBothInterfaces(p1, p2)) { + // Both are external interfaces, perhaps to the same procedure, + // or both are module procedures from modules with the same name. + auto p1Chars{evaluate::characteristics::Procedure::Characterize( + p1, GetFoldingContext())}; + auto p2Chars{evaluate::characteristics::Procedure::Characterize( + p2, GetFoldingContext())}; + return p1Chars && p2Chars && *p1Chars == *p2Chars; } else { - // Both are external interfaces, perhaps to the same procedure - auto class1{ClassifyProcedure(p1)}; - auto class2{ClassifyProcedure(p2)}; - if (class1 == ProcedureDefinitionClass::External && - class2 == ProcedureDefinitionClass::External) { - auto chars1{evaluate::characteristics::Procedure::Characterize( - p1, GetFoldingContext())}; - auto chars2{evaluate::characteristics::Procedure::Characterize( - p2, GetFoldingContext())}; - // same procedure interface defined identically in two modules? - return chars1 && chars2 && *chars1 == *chars2; - } else { - return false; - } + return false; } }}; @@ -4097,13 +4100,32 @@ void ModuleVisitor::DoAddUse(SourceName location, SourceName localName, localSymbol = &newSymbol; } if (useGeneric) { - // Combine two use-associated generics + // Combine two use-associated generics. localSymbol->attrs() = useSymbol.attrs() & ~Attrs{Attr::PUBLIC, Attr::PRIVATE}; localSymbol->flags() = useSymbol.flags(); AddGenericUse(*localGeneric, localName, useUltimate); - localGeneric->clear_derivedType(); - localGeneric->CopyFrom(*useGeneric); + // Don't duplicate specific procedures. + std::size_t originalLocalSpecifics{localGeneric->specificProcs().size()}; + std::size_t useSpecifics{useGeneric->specificProcs().size()}; + CHECK(originalLocalSpecifics == localGeneric->bindingNames().size()); + CHECK(useSpecifics == useGeneric->bindingNames().size()); + std::size_t j{0}; + for (const Symbol &useSpecific : useGeneric->specificProcs()) { + SourceName useBindingName{useGeneric->bindingNames()[j++]}; + bool isDuplicate{false}; + std::size_t k{0}; + for (const Symbol &localSpecific : localGeneric->specificProcs()) { + if (localGeneric->bindingNames()[k++] == useBindingName && + AreSameProcedure(localSpecific, useSpecific)) { + isDuplicate = true; + break; + } + } + if (!isDuplicate) { + localGeneric->AddSpecificProc(useSpecific, useBindingName); + } + } } localGeneric->clear_derivedType(); if (combinedDerivedType) { diff --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp index 28829d3eda308..8eddd03faa962 100644 --- a/flang/lib/Semantics/tools.cpp +++ b/flang/lib/Semantics/tools.cpp @@ -1870,4 +1870,9 @@ bool HadUseError( } } +bool AreSameModuleSymbol(const Symbol &symbol, const Symbol &other) { + return symbol.name() == other.name() && symbol.owner().IsModule() && + other.owner().IsModule() && symbol.owner().GetName() && + symbol.owner().GetName() == other.owner().GetName(); +} } // namespace Fortran::semantics diff --git a/flang/test/Semantics/modfile80.F90 b/flang/test/Semantics/modfile80.F90 new file mode 100644 index 0000000000000..425847ebcb229 --- /dev/null +++ b/flang/test/Semantics/modfile80.F90 @@ -0,0 +1,25 @@ +!RUN: %flang_fc1 -DPART1 %s +!RUN: %flang_fc1 -DPART2 -fhermetic-module-files %s +!RUN: %flang_fc1 -DPART3 | FileCheck --allow-empty %s +!CHECK-NOT: error: + +#if defined PART1 +module modfile80a + interface generic + module procedure specific + end interface + contains + subroutine specific + end +end +#elif defined PART2 +module modfile80b + use modfile80a +end +#else +program test + use modfile80a + use modfile80b + call generic +end +#endif