[llvm-branch-commits] [flang] d6acf3c - [flang] Fix use-associated procedure in generic
Tim Keith via llvm-branch-commits
llvm-branch-commits at lists.llvm.org
Thu Jan 14 16:37:00 PST 2021
Author: Tim Keith
Date: 2021-01-14T16:31:52-08:00
New Revision: d6acf3c2012b00f06a422e8704609676be7729b2
URL: https://github.com/llvm/llvm-project/commit/d6acf3c2012b00f06a422e8704609676be7729b2
DIFF: https://github.com/llvm/llvm-project/commit/d6acf3c2012b00f06a422e8704609676be7729b2.diff
LOG: [flang] Fix use-associated procedure in generic
When a use-associated procedure was included in a generic, we weren't
correctly recording that fact. The ultimate symbol was added rather than
the local symbol.
Also, improve the message emitted for the specific procedure by
mentioning the module it came from.
This fixes one of the problems in https://bugs.llvm.org/show_bug.cgi?id=48648.
Differential Revision: https://reviews.llvm.org/D94696
Added:
Modified:
flang/lib/Semantics/resolve-names.cpp
flang/test/Semantics/modfile07.f90
flang/test/Semantics/resolve53.f90
Removed:
################################################################################
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index d66f561fc3c5..cef4f0010302 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -2603,36 +2603,43 @@ void InterfaceVisitor::ResolveSpecificsInGeneric(Symbol &generic) {
Say(*name, "Procedure '%s' not found"_err_en_US);
continue;
}
- symbol = &symbol->GetUltimate();
if (symbol == &generic) {
if (auto *specific{generic.get<GenericDetails>().specific()}) {
symbol = specific;
}
}
- if (!symbol->has<SubprogramDetails>() &&
- !symbol->has<SubprogramNameDetails>()) {
+ const Symbol &ultimate{symbol->GetUltimate()};
+ if (!ultimate.has<SubprogramDetails>() &&
+ !ultimate.has<SubprogramNameDetails>()) {
Say(*name, "'%s' is not a subprogram"_err_en_US);
continue;
}
if (kind == ProcedureKind::ModuleProcedure) {
- if (const auto *nd{symbol->detailsIf<SubprogramNameDetails>()}) {
+ if (const auto *nd{ultimate.detailsIf<SubprogramNameDetails>()}) {
if (nd->kind() != SubprogramKind::Module) {
Say(*name, "'%s' is not a module procedure"_err_en_US);
}
} else {
// USE-associated procedure
- const auto *sd{symbol->detailsIf<SubprogramDetails>()};
+ const auto *sd{ultimate.detailsIf<SubprogramDetails>()};
CHECK(sd);
- if (symbol->owner().kind() != Scope::Kind::Module ||
+ if (ultimate.owner().kind() != Scope::Kind::Module ||
sd->isInterface()) {
Say(*name, "'%s' is not a module procedure"_err_en_US);
}
}
}
- if (!symbolsSeen.insert(*symbol).second) {
- Say(name->source,
- "Procedure '%s' is already specified in generic '%s'"_err_en_US,
- name->source, MakeOpName(generic.name()));
+ if (!symbolsSeen.insert(ultimate).second) {
+ if (symbol == &ultimate) {
+ Say(name->source,
+ "Procedure '%s' is already specified in generic '%s'"_err_en_US,
+ name->source, MakeOpName(generic.name()));
+ } else {
+ Say(name->source,
+ "Procedure '%s' from module '%s' is already specified in generic '%s'"_err_en_US,
+ ultimate.name(), ultimate.owner().GetName().value(),
+ MakeOpName(generic.name()));
+ }
continue;
}
details.AddSpecificProc(*symbol, name->source);
diff --git a/flang/test/Semantics/modfile07.f90 b/flang/test/Semantics/modfile07.f90
index f3e98bf195f9..878e342ff16a 100644
--- a/flang/test/Semantics/modfile07.f90
+++ b/flang/test/Semantics/modfile07.f90
@@ -598,3 +598,29 @@ module m10d
! end interface
! private::operator(.ne.)
!end
+
+module m11a
+contains
+ subroutine s1()
+ end
+end
+!Expect: m11a.mod
+!module m11a
+!contains
+! subroutine s1()
+! end
+!end
+
+module m11b
+ use m11a
+ interface g
+ module procedure s1
+ end interface
+end
+!Expect: m11b.mod
+!module m11b
+! use m11a,only:s1
+! interface g
+! procedure::s1
+! end interface
+!end
diff --git a/flang/test/Semantics/resolve53.f90 b/flang/test/Semantics/resolve53.f90
index 1487873bd86b..64b0d536fa17 100644
--- a/flang/test/Semantics/resolve53.f90
+++ b/flang/test/Semantics/resolve53.f90
@@ -471,11 +471,11 @@ real function f(x)
subroutine s1()
use m20
interface operator(.not.)
- !ERROR: Procedure 'f' is already specified in generic 'OPERATOR(.NOT.)'
+ !ERROR: Procedure 'f' from module 'm20' is already specified in generic 'OPERATOR(.NOT.)'
procedure f
end interface
interface operator(+)
- !ERROR: Procedure 'f' is already specified in generic 'OPERATOR(+)'
+ !ERROR: Procedure 'f' from module 'm20' is already specified in generic 'OPERATOR(+)'
procedure f
end interface
end subroutine s1
More information about the llvm-branch-commits
mailing list