[flang-commits] [flang] 918a6bb - [flang] Fix bug with generic and homonymous specific module procedure
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Thu Jun 22 07:46:39 PDT 2023
Author: Peter Klausler
Date: 2023-06-22T07:46:33-07:00
New Revision: 918a6bb88acf14ea0eaafd8d787f3bef0b386c6c
URL: https://github.com/llvm/llvm-project/commit/918a6bb88acf14ea0eaafd8d787f3bef0b386c6c
DIFF: https://github.com/llvm/llvm-project/commit/918a6bb88acf14ea0eaafd8d787f3bef0b386c6c.diff
LOG: [flang] Fix bug with generic and homonymous specific module procedure
An unconditional EraseSymbol() call was deleting a generic interface symbol
when the generic had a module procedure of the same name as a specific
procedure, and the module procedure's definition appeared in the same
module. Also clean up some applications of the MODULE attribute to
symbols created along the way.
Differential Revision: https://reviews.llvm.org/D153478
Added:
flang/test/Semantics/symbol28.f90
Modified:
flang/lib/Semantics/resolve-names.cpp
Removed:
################################################################################
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index f7e6fb6fab40f..a3fba9b9ff23f 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -888,7 +888,8 @@ class SubprogramVisitor : public virtual ScopeHandler, public InterfaceVisitor {
void CheckExtantProc(const parser::Name &, Symbol::Flag);
// Create a subprogram symbol in the current scope and push a new scope.
Symbol &PushSubprogramScope(const parser::Name &, Symbol::Flag,
- const parser::LanguageBindingSpec * = nullptr);
+ const parser::LanguageBindingSpec * = nullptr,
+ bool hasModulePrefix = false);
Symbol *GetSpecificFromGeneric(const parser::Name &);
Symbol &PostSubprogramStmt();
void CreateDummyArgument(SubprogramDetails &, const parser::Name &);
@@ -3601,10 +3602,21 @@ void SubprogramVisitor::Post(const parser::PrefixSpec::Cluster_Dims &x) {
}
}
+static bool HasModulePrefix(const std::list<parser::PrefixSpec> &prefixes) {
+ for (const auto &prefix : prefixes) {
+ if (std::holds_alternative<parser::PrefixSpec::Module>(prefix.u)) {
+ return true;
+ }
+ }
+ return false;
+}
+
bool SubprogramVisitor::Pre(const parser::InterfaceBody::Subroutine &x) {
- const auto &name{std::get<parser::Name>(
- std::get<parser::Statement<parser::SubroutineStmt>>(x.t).statement.t)};
- return BeginSubprogram(name, Symbol::Flag::Subroutine);
+ const auto &stmtTuple{
+ std::get<parser::Statement<parser::SubroutineStmt>>(x.t).statement.t};
+ return BeginSubprogram(std::get<parser::Name>(stmtTuple),
+ Symbol::Flag::Subroutine,
+ HasModulePrefix(std::get<std::list<parser::PrefixSpec>>(stmtTuple)));
}
void SubprogramVisitor::Post(const parser::InterfaceBody::Subroutine &x) {
const auto &stmt{std::get<parser::Statement<parser::SubroutineStmt>>(x.t)};
@@ -3612,9 +3624,11 @@ void SubprogramVisitor::Post(const parser::InterfaceBody::Subroutine &x) {
&std::get<std::optional<parser::LanguageBindingSpec>>(stmt.statement.t));
}
bool SubprogramVisitor::Pre(const parser::InterfaceBody::Function &x) {
- const auto &name{std::get<parser::Name>(
- std::get<parser::Statement<parser::FunctionStmt>>(x.t).statement.t)};
- return BeginSubprogram(name, Symbol::Flag::Function);
+ const auto &stmtTuple{
+ std::get<parser::Statement<parser::FunctionStmt>>(x.t).statement.t};
+ return BeginSubprogram(std::get<parser::Name>(stmtTuple),
+ Symbol::Flag::Function,
+ HasModulePrefix(std::get<std::list<parser::PrefixSpec>>(stmtTuple)));
}
void SubprogramVisitor::Post(const parser::InterfaceBody::Function &x) {
const auto &stmt{std::get<parser::Statement<parser::FunctionStmt>>(x.t)};
@@ -4023,10 +4037,16 @@ bool SubprogramVisitor::BeginSubprogram(const parser::Name &name,
if (moduleInterface && &moduleInterface->owner() == &currScope()) {
// Subprogram is MODULE FUNCTION or MODULE SUBROUTINE with an interface
// previously defined in the same scope.
- EraseSymbol(name);
+ if (GenericDetails *
+ generic{DEREF(FindSymbol(name)).detailsIf<GenericDetails>()}) {
+ generic->clear_specific();
+ } else {
+ EraseSymbol(name);
+ }
}
}
- Symbol &newSymbol{PushSubprogramScope(name, subpFlag, bindingSpec)};
+ Symbol &newSymbol{
+ PushSubprogramScope(name, subpFlag, bindingSpec, hasModulePrefix)};
if (moduleInterface) {
newSymbol.get<SubprogramDetails>().set_moduleInterface(*moduleInterface);
if (moduleInterface->attrs().test(Attr::PRIVATE)) {
@@ -4134,7 +4154,8 @@ void SubprogramVisitor::CheckExtantProc(
}
Symbol &SubprogramVisitor::PushSubprogramScope(const parser::Name &name,
- Symbol::Flag subpFlag, const parser::LanguageBindingSpec *bindingSpec) {
+ Symbol::Flag subpFlag, const parser::LanguageBindingSpec *bindingSpec,
+ bool hasModulePrefix) {
Symbol *symbol{GetSpecificFromGeneric(name)};
if (!symbol) {
if (bindingSpec && currScope().IsGlobal() && bindingSpec->v) {
@@ -4159,6 +4180,8 @@ Symbol &SubprogramVisitor::PushSubprogramScope(const parser::Name &name,
details.set_isInterface();
if (isAbstract()) {
SetExplicitAttr(*symbol, Attr::ABSTRACT);
+ } else if (hasModulePrefix) {
+ SetExplicitAttr(*symbol, Attr::MODULE);
} else {
MakeExternal(*symbol);
}
@@ -4172,7 +4195,10 @@ Symbol &SubprogramVisitor::PushSubprogramScope(const parser::Name &name,
}
set_inheritFromParent(false);
}
- FindSymbol(name)->set(subpFlag); // PushScope() created symbol
+ if (Symbol * found{FindSymbol(name)};
+ found && found->has<HostAssocDetails>()) {
+ found->set(subpFlag); // PushScope() created symbol
+ }
return *symbol;
}
@@ -4208,6 +4234,7 @@ Symbol *SubprogramVisitor::GetSpecificFromGeneric(const parser::Name &name) {
} else if (auto *details{symbol->detailsIf<GenericDetails>()}) {
// found generic, want specific procedure
auto *specific{details->specific()};
+ Attrs moduleAttr;
if (inInterfaceBlock()) {
if (specific) {
// Defining an interface in a generic of the same name which is
@@ -4218,6 +4245,7 @@ Symbol *SubprogramVisitor::GetSpecificFromGeneric(const parser::Name &name) {
// The shadowed procedure is a separate module procedure that is
// actually defined later in this (sub)module.
// Define its interface now as a new symbol.
+ moduleAttr.set(Attr::MODULE);
specific = nullptr;
} else if (&specific->owner() != &symbol->owner()) {
// The shadowed procedure was from an enclosing scope and will be
@@ -4236,8 +4264,8 @@ Symbol *SubprogramVisitor::GetSpecificFromGeneric(const parser::Name &name) {
}
}
if (!specific) {
- specific =
- &currScope().MakeSymbol(name.source, Attrs{}, SubprogramDetails{});
+ specific = &currScope().MakeSymbol(
+ name.source, std::move(moduleAttr), SubprogramDetails{});
if (details->derivedType()) {
// A specific procedure with the same name as a derived type
SayAlreadyDeclared(name, *details->derivedType());
diff --git a/flang/test/Semantics/symbol28.f90 b/flang/test/Semantics/symbol28.f90
new file mode 100644
index 0000000000000..83fb370664bb0
--- /dev/null
+++ b/flang/test/Semantics/symbol28.f90
@@ -0,0 +1,62 @@
+! RUN: %python %S/test_symbols.py %s %flang_fc1
+!DEF: /m1 Module
+module m1
+ !DEF: /m1/s PUBLIC (Subroutine) Generic
+ interface s
+ !DEF: /m1/s MODULE (Subroutine) Subprogram
+ module subroutine s
+ end subroutine
+ !DEF: /m1/s2 MODULE, PUBLIC (Subroutine) Subprogram
+ !DEF: /m1/s2/j INTENT(IN) ObjectEntity INTEGER(4)
+ module subroutine s2 (j)
+ !REF: /m1/s2/j
+ integer, intent(in) :: j
+ end subroutine
+ end interface
+contains
+ !DEF: /m1/s MODULE (Subroutine) SubprogramName
+ module subroutine s
+ end subroutine
+ !REF: /m1/s2
+ module procedure s2
+ end procedure
+ !DEF: /m1/test PUBLIC (Subroutine) Subprogram
+ subroutine test
+ !REF: /m1/s
+ call s
+ !REF: /m1/s2
+ call s(1)
+ end subroutine
+end module
+!DEF: /m2 Module
+module m2
+ !DEF: /m2/s PUBLIC (Subroutine) Generic
+ interface s
+ !DEF: /m2/s MODULE (Subroutine) Subprogram
+ module subroutine s
+ end subroutine
+ !DEF: /m2/s2 MODULE, PUBLIC (Subroutine) Subprogram
+ !DEF: /m2/s2/j INTENT(IN) ObjectEntity INTEGER(4)
+ module subroutine s2 (j)
+ !REF: /m2/s2/j
+ integer, intent(in) :: j
+ end subroutine
+ end interface
+contains
+ !DEF: /m2/s MODULE SubprogramName
+ module procedure s
+ end procedure
+ !DEF: /m2/s2 MODULE, PUBLIC (Subroutine) Subprogram
+ !DEF: /m2/s2/j INTENT(IN) ObjectEntity INTEGER(4)
+ module subroutine s2 (j)
+ !REF: /m2/s2/j
+ integer, intent(in) :: j
+ end subroutine
+ !DEF: /m2/test PUBLIC (Subroutine) Subprogram
+ subroutine test
+ !REF: /m2/s
+ call s
+ !REF: /m2/s2
+ call s(1)
+ end subroutine
+end module
More information about the flang-commits
mailing list