[flang-commits] [flang] b05486d - [flang] Accept unambiguous USE name clashes
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Thu Aug 25 15:05:11 PDT 2022
Author: Peter Klausler
Date: 2022-08-25T15:00:30-07:00
New Revision: b05486dbf98821100bf56b9037790280a7a31642
URL: https://github.com/llvm/llvm-project/commit/b05486dbf98821100bf56b9037790280a7a31642
DIFF: https://github.com/llvm/llvm-project/commit/b05486dbf98821100bf56b9037790280a7a31642.diff
LOG: [flang] Accept unambiguous USE name clashes
When, due to one or more USE associations, possibly with renaming,
a symbol conflicts with another of the same name in the same scope,
don't raise an error if both symbols resolve to the same intrinsic
procedure or to the same non-generic external procedure interface --
the usage is unambiguous and safe, and (14.2.2 p8) standard.
(Generic interfaces already work by way of combining their sets of
specific procedures.)
Differential Revision: https://reviews.llvm.org/D132682
Added:
flang/test/Semantics/resolve114.f90
Modified:
flang/lib/Semantics/check-declarations.cpp
flang/lib/Semantics/resolve-names.cpp
Removed:
################################################################################
diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index c0c0eea3e6c5..935c99401b3b 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -813,16 +813,17 @@ void CheckHelper::CheckProcEntity(
if (symbol.attrs().test(Attr::POINTER)) {
CheckPointerInitialization(symbol);
if (const Symbol * interface{details.interface().symbol()}) {
- if (interface->attrs().test(Attr::INTRINSIC)) {
+ const Symbol &ultimate{interface->GetUltimate()};
+ if (ultimate.attrs().test(Attr::INTRINSIC)) {
if (const auto intrinsic{
context_.intrinsics().IsSpecificIntrinsicFunction(
- interface->name().ToString())};
+ ultimate.name().ToString())};
!intrinsic || intrinsic->isRestrictedSpecific) { // C1515
messages_.Say(
"Intrinsic procedure '%s' is not an unrestricted specific "
"intrinsic permitted for use as the definition of the interface "
"to procedure pointer '%s'"_err_en_US,
- interface->name(), symbol.name());
+ ultimate.name(), symbol.name());
}
} else if (IsElementalProcedure(*interface)) {
messages_.Say("Procedure pointer '%s' may not be ELEMENTAL"_err_en_US,
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 56a8b7f3d6ed..b2bc5b4635cd 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -2834,6 +2834,25 @@ void ModuleVisitor::DoAddUse(SourceName location, SourceName localName,
newSymbol.flags() = useSymbol.flags();
return;
}
+ } else {
+ auto localClass{ClassifyProcedure(localUltimate)};
+ auto useClass{ClassifyProcedure(useUltimate)};
+ if (localClass == useClass &&
+ (localClass == ProcedureDefinitionClass::Intrinsic ||
+ localClass == ProcedureDefinitionClass::External) &&
+ localUltimate.name() == useUltimate.name()) {
+ auto localChars{evaluate::characteristics::Procedure::Characterize(
+ localUltimate, GetFoldingContext())};
+ auto useChars{evaluate::characteristics::Procedure::Characterize(
+ useUltimate, GetFoldingContext())};
+ if (localChars && useChars) {
+ if (*localChars == *useChars) {
+ // Same intrinsic or external procedure defined identically in two
+ // modules
+ return;
+ }
+ }
+ }
}
if (!combine) {
if (!ConvertToUseError(localSymbol, location, *useModuleScope_)) {
@@ -4775,7 +4794,7 @@ void DeclarationVisitor::Post(const parser::ProcComponentDefStmt &) {
}
bool DeclarationVisitor::Pre(const parser::ProcPointerInit &x) {
if (auto *name{std::get_if<parser::Name>(&x.u)}) {
- return !NameIsKnownOrIntrinsic(*name);
+ return !NameIsKnownOrIntrinsic(*name) && !CheckUseError(*name);
}
return true;
}
@@ -5762,7 +5781,9 @@ Symbol *DeclarationVisitor::NoteInterfaceName(const parser::Name &name) {
void DeclarationVisitor::CheckExplicitInterface(const parser::Name &name) {
if (const Symbol * symbol{name.symbol}) {
- if (!context().HasError(*symbol) && !symbol->HasExplicitInterface()) {
+ const Symbol &ultimate{symbol->GetUltimate()};
+ if (!context().HasError(*symbol) && !context().HasError(ultimate) &&
+ !ultimate.HasExplicitInterface()) {
Say(name,
"'%s' must be an abstract interface or a procedure with "
"an explicit interface"_err_en_US,
@@ -6790,7 +6811,7 @@ void DeclarationVisitor::PointerInitialization(
CHECK(!details.init());
Walk(target);
if (const auto *targetName{std::get_if<parser::Name>(&target.u)}) {
- if (targetName->symbol) {
+ if (!CheckUseError(*targetName) && targetName->symbol) {
// Validation is done in declaration checking.
details.set_init(*targetName->symbol);
}
diff --git a/flang/test/Semantics/resolve114.f90 b/flang/test/Semantics/resolve114.f90
new file mode 100644
index 000000000000..d7022e697e11
--- /dev/null
+++ b/flang/test/Semantics/resolve114.f90
@@ -0,0 +1,90 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+! Allow the same external or intrinsic procedure to be use-associated
+! by multiple paths when they are unambiguous.
+module m1
+ intrinsic :: sin
+ intrinsic :: iabs
+ interface
+ subroutine ext1(a, b)
+ integer, intent(in) :: a(:)
+ real, intent(in) :: b(:)
+ end subroutine
+ subroutine ext2(a, b)
+ real, intent(in) :: a(:)
+ integer, intent(in) :: b(:)
+ end subroutine
+ end interface
+end module m1
+
+module m2
+ intrinsic :: sin, tan
+ intrinsic :: iabs, idim
+ interface
+ subroutine ext1(a, b)
+ integer, intent(in) :: a(:)
+ real, intent(in) :: b(:)
+ end subroutine
+ subroutine ext2(a, b)
+ real, intent(in) :: a(:)
+ integer, intent(in) :: b(:)
+ end subroutine
+ end interface
+end module m2
+
+subroutine s2a
+ use m1
+ use m2
+ procedure(sin), pointer :: p1 => sin
+ procedure(iabs), pointer :: p2 => iabs
+ procedure(ext1), pointer :: p3 => ext1
+ procedure(ext2), pointer :: p4 => ext2
+end subroutine
+
+subroutine s2b
+ use m1, only: x1 => sin, x2 => iabs, x3 => ext1, x4 => ext2
+ use m2, only: x1 => sin, x2 => iabs, x3 => ext1, x4 => ext2
+ use m1, only: iface1 => sin, iface2 => iabs, iface3 => ext1, iface4 => ext2
+ procedure(iface1), pointer :: p1 => x1
+ procedure(iface2), pointer :: p2 => x2
+ procedure(iface3), pointer :: p3 => x3
+ procedure(iface4), pointer :: p4 => x4
+end subroutine
+
+module m3
+ use m1
+ use m2
+end module
+subroutine s3
+ use m3
+ procedure(sin), pointer :: p1 => sin
+ procedure(iabs), pointer :: p2 => iabs
+ procedure(ext1), pointer :: p3 => ext1
+ procedure(ext2), pointer :: p4 => ext2
+end subroutine
+
+module m4
+ use m1, only: x1 => sin, x2 => iabs, x3 => ext1, x4 => ext2
+ use m2, only: x1 => sin, x2 => iabs, x3 => ext1, x4 => ext2
+end module
+subroutine s4
+ use m4
+ use m1, only: iface1 => sin, iface2 => iabs, iface3 => ext1, iface4 => ext2
+ procedure(iface1), pointer :: p1 => x1
+ procedure(iface2), pointer :: p2 => x2
+ procedure(iface3), pointer :: p3 => x3
+ procedure(iface4), pointer :: p4 => x4
+end subroutine
+
+subroutine s5
+ use m1, only: x1 => sin, x2 => iabs, x3 => ext1, x4 => ext2
+ use m2, only: x1 => tan, x2 => idim, x3 => ext2, x4 => ext1
+ use m1, only: iface1 => sin, iface2 => iabs, iface3 => ext1, iface4 => ext2
+ !ERROR: Reference to 'x1' is ambiguous
+ procedure(iface1), pointer :: p1 => x1
+ !ERROR: Reference to 'x2' is ambiguous
+ procedure(iface2), pointer :: p2 => x2
+ !ERROR: Reference to 'x3' is ambiguous
+ procedure(iface3), pointer :: p3 => x3
+ !ERROR: Reference to 'x4' is ambiguous
+ procedure(iface4), pointer :: p4 => x4
+end subroutine
More information about the flang-commits
mailing list