[flang-commits] [flang] 0b8381a - [flang] Fix bogus generic interface error due to hermetic module files (#161607)
via flang-commits
flang-commits at lists.llvm.org
Fri Oct 3 10:48:35 PDT 2025
Author: Peter Klausler
Date: 2025-10-03T10:48:32-07:00
New Revision: 0b8381aba9f90884ddfc69393d6f2bb1bda7facf
URL: https://github.com/llvm/llvm-project/commit/0b8381aba9f90884ddfc69393d6f2bb1bda7facf
DIFF: https://github.com/llvm/llvm-project/commit/0b8381aba9f90884ddfc69393d6f2bb1bda7facf.diff
LOG: [flang] Fix bogus generic interface error due to hermetic module files (#161607)
When the same generic interface is processed via USE association from
its original module file and from a copy in a hermetic module file, we
need to do a better job at detecting and omitting duplicate specific
procedures. They won't have the same symbol addresses, but they will
have the same name, module name, and characteristics. This will avoid a
bogus error about multiple specific procedures matching the actual
arguments later when the merged generic interface is referenced.
Added:
flang/test/Semantics/modfile80.F90
Modified:
flang/include/flang/Semantics/tools.h
flang/lib/Semantics/check-declarations.cpp
flang/lib/Semantics/resolve-names.cpp
flang/lib/Semantics/tools.cpp
Removed:
################################################################################
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 8a80bf045bcbc..75934243b7916 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -3048,14 +3048,6 @@ static std::optional<std::string> 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)}) {
@@ -3073,7 +3065,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<ModuleDetails>()) {
Warn(common::LanguageFeature::BenignNameClash, symbol.name(),
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index aa09d49f1453b..b7c7603d667d8 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -3962,8 +3962,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<SubprogramDetails>()};
+ const auto *subp2{p2.detailsIf<SubprogramDetails>()};
+ 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;
@@ -3971,31 +3989,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<SubprogramDetails>()};
- subp && !subp->isInterface()) {
- return false; // defined in module, not an external
- } else if (const auto *subp{p2.detailsIf<SubprogramDetails>()};
- 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;
}
}};
@@ -4096,13 +4099,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
More information about the flang-commits
mailing list