[flang-commits] [flang] bed947f - [flang] Accept ENTRY names in generic interfaces
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Fri Jan 14 15:43:32 PST 2022
Author: Peter Klausler
Date: 2022-01-14T15:43:21-08:00
New Revision: bed947f7081353257b78612cf8dfbd161463966c
URL: https://github.com/llvm/llvm-project/commit/bed947f7081353257b78612cf8dfbd161463966c
DIFF: https://github.com/llvm/llvm-project/commit/bed947f7081353257b78612cf8dfbd161463966c.diff
LOG: [flang] Accept ENTRY names in generic interfaces
ENTRY statement names in module subprograms were not acceptable for
use as a "module procedure" in a generic interface, but should be.
ENTRY statements need to have symbols with place-holding
SubprogramNameDetails created for them in order to be visible in
generic interfaces. Those symbols are created from the "program
tree" data structure. This patch adds ENTRY statement names to the
program tree data structure and uses them to generate SubprogramNameDetails
symbols.
Differential Revision: https://reviews.llvm.org/D117345
Added:
Modified:
flang/include/flang/Semantics/symbol.h
flang/lib/Semantics/program-tree.cpp
flang/lib/Semantics/program-tree.h
flang/lib/Semantics/resolve-names.cpp
flang/test/Semantics/entry01.f90
Removed:
################################################################################
diff --git a/flang/include/flang/Semantics/symbol.h b/flang/include/flang/Semantics/symbol.h
index 361d69e849213..19304d72bb0cb 100644
--- a/flang/include/flang/Semantics/symbol.h
+++ b/flang/include/flang/Semantics/symbol.h
@@ -107,7 +107,7 @@ class SubprogramDetails : public WithBindName {
};
// For SubprogramNameDetails, the kind indicates whether it is the name
-// of a module subprogram or internal subprogram.
+// of a module subprogram or an internal subprogram or ENTRY.
ENUM_CLASS(SubprogramKind, Module, Internal)
// Symbol with SubprogramNameDetails is created when we scan for module and
@@ -121,10 +121,16 @@ class SubprogramNameDetails {
SubprogramNameDetails() = delete;
SubprogramKind kind() const { return kind_; }
ProgramTree &node() const { return *node_; }
+ bool isEntryStmt() const { return isEntryStmt_; }
+ SubprogramNameDetails &set_isEntryStmt(bool yes = true) {
+ isEntryStmt_ = yes;
+ return *this;
+ }
private:
SubprogramKind kind_;
common::Reference<ProgramTree> node_;
+ bool isEntryStmt_{false};
};
// A name from an entity-decl -- could be object or function.
diff --git a/flang/lib/Semantics/program-tree.cpp b/flang/lib/Semantics/program-tree.cpp
index 9466a748567e1..e20299b2fb4c5 100644
--- a/flang/lib/Semantics/program-tree.cpp
+++ b/flang/lib/Semantics/program-tree.cpp
@@ -13,6 +13,37 @@
namespace Fortran::semantics {
+static void GetEntryStmts(
+ ProgramTree &node, const parser::SpecificationPart &spec) {
+ const auto &implicitPart{std::get<parser::ImplicitPart>(spec.t)};
+ for (const parser::ImplicitPartStmt &stmt : implicitPart.v) {
+ if (const auto *entryStmt{std::get_if<
+ parser::Statement<common::Indirection<parser::EntryStmt>>>(
+ &stmt.u)}) {
+ node.AddEntry(entryStmt->statement.value());
+ }
+ }
+ for (const auto &decl :
+ std::get<std::list<parser::DeclarationConstruct>>(spec.t)) {
+ if (const auto *entryStmt{std::get_if<
+ parser::Statement<common::Indirection<parser::EntryStmt>>>(
+ &decl.u)}) {
+ node.AddEntry(entryStmt->statement.value());
+ }
+ }
+}
+
+static void GetEntryStmts(
+ ProgramTree &node, const parser::ExecutionPart &exec) {
+ for (const auto &epConstruct : exec.v) {
+ if (const auto *entryStmt{std::get_if<
+ parser::Statement<common::Indirection<parser::EntryStmt>>>(
+ &epConstruct.u)}) {
+ node.AddEntry(entryStmt->statement.value());
+ }
+ }
+}
+
template <typename T>
static ProgramTree BuildSubprogramTree(const parser::Name &name, const T &x) {
const auto &spec{std::get<parser::SpecificationPart>(x.t)};
@@ -20,6 +51,8 @@ static ProgramTree BuildSubprogramTree(const parser::Name &name, const T &x) {
const auto &subps{
std::get<std::optional<parser::InternalSubprogramPart>>(x.t)};
ProgramTree node{name, spec, &exec};
+ GetEntryStmts(node, spec);
+ GetEntryStmts(node, exec);
if (subps) {
for (const auto &subp :
std::get<std::list<parser::InternalSubprogram>>(subps->t)) {
@@ -34,7 +67,7 @@ static ProgramTree BuildSubprogramTree(const parser::Name &name, const T &x) {
static ProgramTree BuildSubprogramTree(
const parser::Name &name, const parser::BlockData &x) {
const auto &spec{std::get<parser::SpecificationPart>(x.t)};
- return ProgramTree{name, spec, nullptr};
+ return ProgramTree{name, spec};
}
template <typename T>
@@ -193,4 +226,8 @@ void ProgramTree::AddChild(ProgramTree &&child) {
children_.emplace_back(std::move(child));
}
+void ProgramTree::AddEntry(const parser::EntryStmt &entryStmt) {
+ entryStmts_.emplace_back(entryStmt);
+}
+
} // namespace Fortran::semantics
diff --git a/flang/lib/Semantics/program-tree.h b/flang/lib/Semantics/program-tree.h
index 6b07452282017..798abd7ea8d6b 100644
--- a/flang/lib/Semantics/program-tree.h
+++ b/flang/lib/Semantics/program-tree.h
@@ -29,6 +29,8 @@ class Scope;
class ProgramTree {
public:
+ using EntryStmtList = std::list<common::Reference<const parser::EntryStmt>>;
+
// Build the ProgramTree rooted at one of these program units.
static ProgramTree Build(const parser::ProgramUnit &);
static ProgramTree Build(const parser::MainProgram &);
@@ -69,12 +71,17 @@ class ProgramTree {
const parser::ExecutionPart *exec() const { return exec_; }
std::list<ProgramTree> &children() { return children_; }
const std::list<ProgramTree> &children() const { return children_; }
+ const std::list<common::Reference<const parser::EntryStmt>> &
+ entryStmts() const {
+ return entryStmts_;
+ }
Symbol::Flag GetSubpFlag() const;
bool IsModule() const; // Module or Submodule
bool HasModulePrefix() const; // in function or subroutine stmt
Scope *scope() const { return scope_; }
void set_scope(Scope &);
void AddChild(ProgramTree &&);
+ void AddEntry(const parser::EntryStmt &);
template <typename T>
ProgramTree &set_stmt(const parser::Statement<T> &stmt) {
@@ -94,6 +101,7 @@ class ProgramTree {
const parser::SpecificationPart &spec_;
const parser::ExecutionPart *exec_{nullptr};
std::list<ProgramTree> children_;
+ EntryStmtList entryStmts_;
Scope *scope_{nullptr};
const parser::CharBlock *endStmt_{nullptr};
bool isSpecificationPartResolved_{false};
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index b401ef2bf276f..8e22bb5dc4394 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -2796,7 +2796,7 @@ void InterfaceVisitor::ResolveSpecificsInGeneric(Symbol &generic) {
}
auto range{specificProcs_.equal_range(&generic)};
for (auto it{range.first}; it != range.second; ++it) {
- auto *name{it->second.first};
+ const parser::Name *name{it->second.first};
auto kind{it->second.second};
const auto *symbol{FindSymbol(*name)};
if (!symbol) {
@@ -6915,13 +6915,21 @@ void ResolveNamesVisitor::ResolveSpecificationParts(ProgramTree &node) {
}
}
-// Add SubprogramNameDetails symbols for module and internal subprograms
+// Add SubprogramNameDetails symbols for module and internal subprograms and
+// their ENTRY statements.
void ResolveNamesVisitor::AddSubpNames(ProgramTree &node) {
auto kind{
node.IsModule() ? SubprogramKind::Module : SubprogramKind::Internal};
for (auto &child : node.children()) {
auto &symbol{MakeSymbol(child.name(), SubprogramNameDetails{kind, child})};
symbol.set(child.GetSubpFlag());
+ for (const auto &entryStmt : child.entryStmts()) {
+ SubprogramNameDetails details{kind, child};
+ details.set_isEntryStmt();
+ auto &symbol{
+ MakeSymbol(std::get<parser::Name>(entryStmt->t), std::move(details))};
+ symbol.set(child.GetSubpFlag());
+ }
}
}
@@ -7125,7 +7133,8 @@ void ResolveSpecificationParts(
SemanticsContext &context, const Symbol &subprogram) {
auto originalLocation{context.location()};
ResolveNamesVisitor visitor{context, DEREF(sharedImplicitRulesMap)};
- ProgramTree &node{subprogram.get<SubprogramNameDetails>().node()};
+ const auto &details{subprogram.get<SubprogramNameDetails>()};
+ ProgramTree &node{details.node()};
const Scope &moduleScope{subprogram.owner()};
visitor.SetScope(const_cast<Scope &>(moduleScope));
visitor.ResolveSpecificationParts(node);
diff --git a/flang/test/Semantics/entry01.f90 b/flang/test/Semantics/entry01.f90
index c9c48193c72f5..2a95d6cc5906f 100644
--- a/flang/test/Semantics/entry01.f90
+++ b/flang/test/Semantics/entry01.f90
@@ -139,11 +139,12 @@ subroutine externals
end subroutine
module m2
+ !ERROR: EXTERNAL attribute not allowed on 'm2entry2'
external m2entry2
contains
subroutine m2subr1
entry m2entry1 ! ok
- entry m2entry2 ! ok
+ entry m2entry2 ! NOT ok
entry m2entry3 ! ok
end subroutine
end module
@@ -173,6 +174,27 @@ subroutine m3subr1
end subroutine
end module
+module m4
+ interface generic1
+ module procedure m4entry1
+ end interface
+ interface generic2
+ module procedure m4entry2
+ end interface
+ interface generic3
+ module procedure m4entry3
+ end interface
+ contains
+ subroutine m4subr1
+ entry m4entry1 ! in implicit part
+ integer :: n = 0
+ entry m4entry2 ! in specification part
+ n = 123
+ entry m4entry3 ! in executable part
+ print *, n
+ end subroutine
+end module
+
function inone
implicit none
integer :: inone
More information about the flang-commits
mailing list