[flang-commits] [flang] bfc3907 - [flang] Fix spurious errors from MODULE subprograms
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Fri Sep 23 13:12:40 PDT 2022
Author: Peter Klausler
Date: 2022-09-23T13:12:23-07:00
New Revision: bfc39073692550132f49c22f848ad145f7350fbf
URL: https://github.com/llvm/llvm-project/commit/bfc39073692550132f49c22f848ad145f7350fbf
DIFF: https://github.com/llvm/llvm-project/commit/bfc39073692550132f49c22f848ad145f7350fbf.diff
LOG: [flang] Fix spurious errors from MODULE subprograms
When an explicit MODULE procedure is defined in the same (sub)module
as its interface, and the interface was defined in a generic
interface of the same name, bogus errors about symbols already
having been defined will ensue. Cleaning up this aspect of name
resolution and symbol table management requires marking the
place-holding SubprogramNameDetails symbols of explicit MODULE
subprograms as such, ensuring that that attribute is not inherited
if the SubprogramNameDetails symbol is recycled as a SubprogramDetails,
and gathering some code that should have been common between
BeginSubprogram() and BeginMpSubprogram() together in one
new routine.
Differential Revision: https://reviews.llvm.org/D134446
Added:
Modified:
flang/include/flang/Semantics/symbol.h
flang/lib/Semantics/program-tree.cpp
flang/lib/Semantics/resolve-names.cpp
flang/lib/Semantics/symbol.cpp
flang/test/Semantics/nullify02.f90
Removed:
################################################################################
diff --git a/flang/include/flang/Semantics/symbol.h b/flang/include/flang/Semantics/symbol.h
index 0b03bf06eb737..0f89f96564d20 100644
--- a/flang/include/flang/Semantics/symbol.h
+++ b/flang/include/flang/Semantics/symbol.h
@@ -472,6 +472,7 @@ class GenericDetails {
Symbol *specific() { return specific_; }
const Symbol *specific() const { return specific_; }
void set_specific(Symbol &specific);
+ void clear_specific();
Symbol *derivedType() { return derivedType_; }
const Symbol *derivedType() const { return derivedType_; }
void set_derivedType(Symbol &derivedType);
diff --git a/flang/lib/Semantics/program-tree.cpp b/flang/lib/Semantics/program-tree.cpp
index 79b47384a6772..cd631da93d698 100644
--- a/flang/lib/Semantics/program-tree.cpp
+++ b/flang/lib/Semantics/program-tree.cpp
@@ -217,6 +217,10 @@ Symbol::Flag ProgramTree::GetSubpFlag() const {
}
bool ProgramTree::HasModulePrefix() const {
+ if (std::holds_alternative<
+ const parser::Statement<parser::MpSubprogramStmt> *>(stmt_)) {
+ return true; // MODULE PROCEDURE foo
+ }
using ListType = std::list<parser::PrefixSpec>;
const auto *prefixes{common::visit(
common::visitors{
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index ddf188ff46e24..f3d829fc4a9b2 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -550,6 +550,7 @@ class ScopeHandler : public ImplicitRulesVisitor {
// Search for name in a derived type scope and its parents.
Symbol *FindInTypeOrParents(const Scope &, const parser::Name &);
Symbol *FindInTypeOrParents(const parser::Name &);
+ Symbol *FindSeparateModuleProcedureInterface(const parser::Name &);
void EraseSymbol(const parser::Name &);
void EraseSymbol(const Symbol &symbol) { currScope().erase(symbol.name()); }
// Make a new symbol with the name and attrs of an existing one
@@ -608,7 +609,7 @@ class ScopeHandler : public ImplicitRulesVisitor {
// update the existing symbol
symbol->attrs() |= attrs;
if constexpr (std::is_same_v<SubprogramDetails, D>) {
- // Dummy argument defined by explicit interface
+ // Dummy argument defined by explicit interface?
details.set_isDummy(IsDummy(*symbol));
}
symbol->set_details(std::move(details));
@@ -3631,14 +3632,28 @@ void SubprogramVisitor::PostEntryStmt(const parser::EntryStmt &stmt) {
}
}
-// A subprogram declared with MODULE PROCEDURE
-bool SubprogramVisitor::BeginMpSubprogram(const parser::Name &name) {
+Symbol *ScopeHandler::FindSeparateModuleProcedureInterface(
+ const parser::Name &name) {
auto *symbol{FindSymbol(name)};
if (symbol && symbol->has<SubprogramNameDetails>()) {
symbol = FindSymbol(currScope().parent(), name);
}
+ if (symbol) {
+ if (auto *generic{symbol->detailsIf<GenericDetails>()}) {
+ symbol = generic->specific();
+ }
+ }
if (!IsSeparateModuleProcedureInterface(symbol)) {
Say(name, "'%s' was not declared a separate module procedure"_err_en_US);
+ symbol = nullptr;
+ }
+ return symbol;
+}
+
+// A subprogram declared with MODULE PROCEDURE
+bool SubprogramVisitor::BeginMpSubprogram(const parser::Name &name) {
+ Symbol *symbol{FindSeparateModuleProcedureInterface(name)};
+ if (!symbol) {
return false;
}
if (symbol->owner() == currScope() && symbol->scope()) {
@@ -3682,21 +3697,11 @@ bool SubprogramVisitor::BeginSubprogram(const parser::Name &name,
}
Symbol *moduleInterface{nullptr};
if (hasModulePrefix && !inInterfaceBlock()) {
- moduleInterface = FindSymbol(currScope(), name);
- if (IsSeparateModuleProcedureInterface(moduleInterface)) {
+ moduleInterface = FindSeparateModuleProcedureInterface(name);
+ if (moduleInterface && &moduleInterface->owner() == &currScope()) {
// Subprogram is MODULE FUNCTION or MODULE SUBROUTINE with an interface
// previously defined in the same scope.
currScope().erase(moduleInterface->name());
- } else {
- moduleInterface = nullptr;
- }
- if (!moduleInterface) {
- moduleInterface = FindSymbol(currScope().parent(), name);
- if (!IsSeparateModuleProcedureInterface(moduleInterface)) {
- Say(name,
- "'%s' was not declared a separate module procedure"_err_en_US);
- return false;
- }
}
}
Symbol &newSymbol{PushSubprogramScope(name, subpFlag, bindingSpec)};
@@ -3865,9 +3870,24 @@ void SubprogramVisitor::PushBlockDataScope(const parser::Name &name) {
Symbol *SubprogramVisitor::GetSpecificFromGeneric(const parser::Name &name) {
// Search for the name but don't resolve it
if (auto *symbol{currScope().FindSymbol(name.source)}) {
- if (auto *details{symbol->detailsIf<GenericDetails>()}) {
- // found generic, want subprogram
+ if (symbol->has<SubprogramNameDetails>()) {
+ if (inInterfaceBlock()) {
+ // Subtle: clear any MODULE flag so that the new interface
+ // symbol doesn't inherit it and ruin the ability to check it.
+ symbol->attrs().reset(Attr::MODULE);
+ }
+ } else if (auto *details{symbol->detailsIf<GenericDetails>()}) {
+ // found generic, want specific procedure
auto *specific{details->specific()};
+ if (specific && inInterfaceBlock() &&
+ specific->has<SubprogramNameDetails>() &&
+ specific->attrs().test(Attr::MODULE)) {
+ // 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.
+ details->clear_specific();
+ specific = nullptr;
+ }
if (!specific) {
specific =
&currScope().MakeSymbol(name.source, Attrs{}, SubprogramDetails{});
@@ -3880,8 +3900,8 @@ Symbol *SubprogramVisitor::GetSpecificFromGeneric(const parser::Name &name) {
} else if (isGeneric()) {
SayAlreadyDeclared(name, *specific);
}
- if (!specific->has<SubprogramDetails>()) {
- specific->set_details(SubprogramDetails{});
+ if (specific->has<SubprogramNameDetails>()) {
+ specific->set_details(Details{SubprogramDetails{}});
}
return specific;
}
@@ -7565,6 +7585,9 @@ void ResolveNamesVisitor::AddSubpNames(ProgramTree &node) {
node.IsModule() ? SubprogramKind::Module : SubprogramKind::Internal};
for (auto &child : node.children()) {
auto &symbol{MakeSymbol(child.name(), SubprogramNameDetails{kind, child})};
+ if (child.HasModulePrefix()) {
+ symbol.attrs().set(Attr::MODULE);
+ }
auto childKind{child.GetKind()};
if (childKind == ProgramTree::Kind::Function) {
symbol.set(Symbol::Flag::Function);
@@ -7578,6 +7601,9 @@ void ResolveNamesVisitor::AddSubpNames(ProgramTree &node) {
auto &symbol{
MakeSymbol(std::get<parser::Name>(entryStmt->t), std::move(details))};
symbol.set(child.GetSubpFlag());
+ if (child.HasModulePrefix()) {
+ symbol.attrs().set(Attr::MODULE);
+ }
}
}
for (const auto &generic : node.genericSpecs()) {
diff --git a/flang/lib/Semantics/symbol.cpp b/flang/lib/Semantics/symbol.cpp
index 904057e8a9c44..f85422960290e 100644
--- a/flang/lib/Semantics/symbol.cpp
+++ b/flang/lib/Semantics/symbol.cpp
@@ -174,6 +174,7 @@ void GenericDetails::set_specific(Symbol &specific) {
CHECK(!derivedType_);
specific_ = &specific;
}
+void GenericDetails::clear_specific() { specific_ = nullptr; }
void GenericDetails::set_derivedType(Symbol &derivedType) {
CHECK(!specific_);
CHECK(!derivedType_);
diff --git a/flang/test/Semantics/nullify02.f90 b/flang/test/Semantics/nullify02.f90
index e7332af78a6de..09eab7902a553 100644
--- a/flang/test/Semantics/nullify02.f90
+++ b/flang/test/Semantics/nullify02.f90
@@ -40,10 +40,12 @@ function ptrFun()
end interface
contains
!ERROR: 'ptrfun' was not declared a separate module procedure
+ !ERROR: 'ptrfun' is already declared in this scoping unit
module function ptrFun()
integer, pointer :: ptrFun
real :: realVar
nullify(ptrFun)
+ !ERROR: name in NULLIFY statement must have the POINTER attribute
nullify(realVar)
end function
end module
More information about the flang-commits
mailing list