[flang-commits] [flang] 7f680b2 - [flang] Allow more forward references to ENTRY names
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Mon May 23 21:48:49 PDT 2022
Author: Peter Klausler
Date: 2022-05-23T21:48:35-07:00
New Revision: 7f680b260ffe34c648cbd3fd16615d8f5cdab39f
URL: https://github.com/llvm/llvm-project/commit/7f680b260ffe34c648cbd3fd16615d8f5cdab39f
DIFF: https://github.com/llvm/llvm-project/commit/7f680b260ffe34c648cbd3fd16615d8f5cdab39f.diff
LOG: [flang] Allow more forward references to ENTRY names
Forward references to ENTRY names to pass them as actual procedure arguments
don't work in all cases, exposing some basic ordering problems in
name resolution for these symbols. Refactor; create all the
necessary procedure symbols, and either function result or host association
symbols (for subroutines), at the time that the subprogrma scope is
created, so that the names exist in the scope as text "before"
the ENTRY is processed in name resolution. Some processing
remains in PostEntryStmt() so that we can check that an ENTRY with
an explicit distinct RESULT doesn't also have declarations for the
ENTRY name.
Differential Revision: https://reviews.llvm.org/D126142
Added:
flang/test/Semantics/symbol20.f90
Modified:
flang/include/flang/Semantics/symbol.h
flang/lib/Evaluate/tools.cpp
flang/lib/Semantics/check-declarations.cpp
flang/lib/Semantics/resolve-names.cpp
flang/lib/Semantics/tools.cpp
flang/test/Semantics/entry01.f90
Removed:
################################################################################
diff --git a/flang/include/flang/Semantics/symbol.h b/flang/include/flang/Semantics/symbol.h
index 874c9d89a23e..e79f8ab6503e 100644
--- a/flang/include/flang/Semantics/symbol.h
+++ b/flang/include/flang/Semantics/symbol.h
@@ -137,16 +137,10 @@ 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/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp
index 394d1027a198..bc8b7087164b 100644
--- a/flang/lib/Evaluate/tools.cpp
+++ b/flang/lib/Evaluate/tools.cpp
@@ -1230,20 +1230,21 @@ bool IsPureProcedure(const Scope &scope) {
bool IsFunction(const Symbol &symbol) {
const Symbol &ultimate{symbol.GetUltimate()};
return ultimate.test(Symbol::Flag::Function) ||
- common::visit(
- common::visitors{
- [](const SubprogramDetails &x) { return x.isFunction(); },
- [](const ProcEntityDetails &x) {
- const auto &ifc{x.interface()};
- return ifc.type() ||
- (ifc.symbol() && IsFunction(*ifc.symbol()));
+ (!ultimate.test(Symbol::Flag::Subroutine) &&
+ common::visit(
+ common::visitors{
+ [](const SubprogramDetails &x) { return x.isFunction(); },
+ [](const ProcEntityDetails &x) {
+ const auto &ifc{x.interface()};
+ return ifc.type() ||
+ (ifc.symbol() && IsFunction(*ifc.symbol()));
+ },
+ [](const ProcBindingDetails &x) {
+ return IsFunction(x.symbol());
+ },
+ [](const auto &) { return false; },
},
- [](const ProcBindingDetails &x) {
- return IsFunction(x.symbol());
- },
- [](const auto &) { return false; },
- },
- ultimate.details());
+ ultimate.details()));
}
bool IsFunction(const Scope &scope) {
@@ -1399,10 +1400,14 @@ bool IsDeferredShape(const Symbol &symbol) {
bool IsFunctionResult(const Symbol &original) {
const Symbol &symbol{GetAssociationRoot(original)};
- return (symbol.has<ObjectEntityDetails>() &&
- symbol.get<ObjectEntityDetails>().isFuncResult()) ||
- (symbol.has<ProcEntityDetails>() &&
- symbol.get<ProcEntityDetails>().isFuncResult());
+ return common::visit(
+ common::visitors{
+ [](const EntityDetails &x) { return x.isFuncResult(); },
+ [](const ObjectEntityDetails &x) { return x.isFuncResult(); },
+ [](const ProcEntityDetails &x) { return x.isFuncResult(); },
+ [](const auto &) { return false; },
+ },
+ symbol.details());
}
bool IsKindTypeParameter(const Symbol &symbol) {
diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index 72816b6d33c1..99c6e27e714a 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -897,14 +897,9 @@ void CheckHelper::CheckSubprogram(
if (subprogram) {
subprogramDetails = subprogram->detailsIf<SubprogramDetails>();
}
- if (entryScope->kind() != Scope::Kind::Subprogram) {
- error = "ENTRY may appear only in a subroutine or function"_err_en_US;
- } else if (!(entryScope->parent().IsGlobal() ||
- entryScope->parent().IsModule() ||
- entryScope->parent().IsSubmodule())) {
+ if (!(entryScope->parent().IsGlobal() || entryScope->parent().IsModule() ||
+ entryScope->parent().IsSubmodule())) {
error = "ENTRY may not appear in an internal subprogram"_err_en_US;
- } else if (FindSeparateModuleSubprogramInterface(subprogram)) {
- error = "ENTRY may not appear in a separate module procedure"_err_en_US;
} else if (subprogramDetails && details.isFunction() &&
subprogramDetails->isFunction() &&
!context_.HasError(details.result()) &&
@@ -1812,8 +1807,13 @@ void CheckHelper::CheckGenericOps(const Scope &scope) {
auto addSpecifics{[&](const Symbol &generic) {
const auto *details{generic.GetUltimate().detailsIf<GenericDetails>()};
if (!details) {
- if (generic.test(Symbol::Flag::Function)) {
- Characterize(generic);
+ // Not a generic; ensure characteristics are defined if a function.
+ auto restorer{messages_.SetLocation(generic.name())};
+ if (IsFunction(generic) && !context_.HasError(generic)) {
+ if (const Symbol * result{FindFunctionResult(generic)};
+ result && !context_.HasError(*result)) {
+ Characterize(generic);
+ }
}
return;
}
@@ -1825,8 +1825,8 @@ void CheckHelper::CheckGenericOps(const Scope &scope) {
const std::vector<SourceName> &bindingNames{details->bindingNames()};
for (std::size_t i{0}; i < specifics.size(); ++i) {
const Symbol &specific{*specifics[i]};
+ auto restorer{messages_.SetLocation(bindingNames[i])};
if (const Procedure * proc{Characterize(specific)}) {
- auto restorer{messages_.SetLocation(bindingNames[i])};
if (kind.IsAssignment()) {
if (!CheckDefinedAssignment(specific, *proc)) {
continue;
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index a31831301bd1..cbb657040783 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -464,6 +464,8 @@ class FuncResultStack {
~FuncResultStack();
struct FuncInfo {
+ explicit FuncInfo(const Scope &s) : scope{s} {}
+ const Scope &scope;
// Parse tree of the type specification in the FUNCTION prefix
const parser::DeclarationTypeSpec *parsedType{nullptr};
// Name of the function RESULT in the FUNCTION suffix, if any
@@ -480,8 +482,8 @@ class FuncResultStack {
void CompleteTypeIfFunctionResult(Symbol &);
FuncInfo *Top() { return stack_.empty() ? nullptr : &stack_.back(); }
- FuncInfo &Push() { return stack_.emplace_back(); }
- void Pop() { stack_.pop_back(); }
+ FuncInfo &Push(const Scope &scope) { return stack_.emplace_back(scope); }
+ void Pop();
private:
ScopeHandler &scopeHandler_;
@@ -841,6 +843,7 @@ class SubprogramVisitor : public virtual ScopeHandler, public InterfaceVisitor {
const parser::LanguageBindingSpec * = nullptr);
Symbol *GetSpecificFromGeneric(const parser::Name &);
SubprogramDetails &PostSubprogramStmt(const parser::Name &);
+ void CreateEntry(const parser::EntryStmt &stmt, Symbol &subprogram);
void PostEntryStmt(const parser::EntryStmt &stmt);
};
@@ -2024,17 +2027,17 @@ FuncResultStack::~FuncResultStack() { CHECK(stack_.empty()); }
void FuncResultStack::CompleteFunctionResultType() {
// If the function has a type in the prefix, process it now.
- if (IsFunction(scopeHandler_.currScope())) {
- FuncInfo &info{DEREF(Top())};
- if (info.parsedType) {
- scopeHandler_.messageHandler().set_currStmtSource(info.source);
+ FuncInfo *info{Top()};
+ if (info && &info->scope == &scopeHandler_.currScope()) {
+ if (info->parsedType) {
+ scopeHandler_.messageHandler().set_currStmtSource(info->source);
if (const auto *type{
- scopeHandler_.ProcessTypeSpec(*info.parsedType, true)}) {
- if (!scopeHandler_.context().HasError(info.resultSymbol)) {
- info.resultSymbol->SetType(*type);
+ scopeHandler_.ProcessTypeSpec(*info->parsedType, true)}) {
+ if (!scopeHandler_.context().HasError(info->resultSymbol)) {
+ info->resultSymbol->SetType(*type);
}
}
- info.parsedType = nullptr;
+ info->parsedType = nullptr;
}
}
}
@@ -2049,6 +2052,12 @@ void FuncResultStack::CompleteTypeIfFunctionResult(Symbol &symbol) {
}
}
+void FuncResultStack::Pop() {
+ if (!stack_.empty() && &stack_.back().scope == &scopeHandler_.currScope()) {
+ stack_.pop_back();
+ }
+}
+
// ScopeHandler implementation
void ScopeHandler::SayAlreadyDeclared(const parser::Name &name, Symbol &prev) {
@@ -2203,6 +2212,7 @@ void ScopeHandler::PopScope() {
for (auto &pair : currScope()) {
ConvertToObjectEntity(*pair.second);
}
+ funcResultStack_.Pop();
// If popping back into a global scope, pop back to the main global scope.
SetScope(currScope_->parent().IsGlobal() ? context().globalScope()
: currScope_->parent());
@@ -2440,6 +2450,12 @@ bool ScopeHandler::ConvertToProcEntity(Symbol &symbol) {
} else if (symbol.has<UnknownDetails>()) {
symbol.set_details(ProcEntityDetails{});
} else if (auto *details{symbol.detailsIf<EntityDetails>()}) {
+ if (IsFunctionResult(symbol) &&
+ !(IsPointer(symbol) && symbol.attrs().test(Attr::EXTERNAL))) {
+ // Don't turn function result into a procedure pointer unless both
+ // POUNTER and EXTERNAL
+ return false;
+ }
funcResultStack_.CompleteTypeIfFunctionResult(symbol);
symbol.set_details(ProcEntityDetails{std::move(*details)});
if (symbol.GetType() && !symbol.test(Symbol::Flag::Implicit)) {
@@ -3265,26 +3281,45 @@ void SubprogramVisitor::Post(const parser::FunctionStmt &stmt) {
FuncResultStack::FuncInfo &info{DEREF(funcResultStack().Top())};
CHECK(info.inFunctionStmt);
info.inFunctionStmt = false;
- if (info.resultName && info.resultName->source != name.source) {
+ bool distinctResultName{
+ info.resultName && info.resultName->source != name.source};
+ if (distinctResultName) {
// Note that RESULT is ignored if it has the same name as the function.
+ // The symbol created by PushScope() is retained as a place-holder
+ // for error detection.
funcResultName = info.resultName;
} else {
- EraseSymbol(name); // was added by PushSubprogramScope
+ EraseSymbol(name); // was added by PushScope()
funcResultName = &name;
}
- // add function result to function scope
if (details.isFunction()) {
CHECK(context().HasError(currScope().symbol()));
} else {
- // add function result to function scope
- EntityDetails funcResultDetails;
- funcResultDetails.set_funcResult(true);
- Symbol &result{MakeSymbol(*funcResultName, std::move(funcResultDetails))};
- info.resultSymbol = &result;
- details.set_result(result);
+ // RESULT(x) can be the same explicitly-named RESULT(x) as an ENTRY
+ // statement.
+ Symbol *result{nullptr};
+ if (distinctResultName) {
+ if (auto iter{currScope().find(funcResultName->source)};
+ iter != currScope().end()) {
+ Symbol &entryResult{*iter->second};
+ if (IsFunctionResult(entryResult)) {
+ result = &entryResult;
+ }
+ }
+ }
+ if (result) {
+ Resolve(*funcResultName, *result);
+ } else {
+ // add function result to function scope
+ EntityDetails funcResultDetails;
+ funcResultDetails.set_funcResult(true);
+ result = &MakeSymbol(*funcResultName, std::move(funcResultDetails));
+ }
+ info.resultSymbol = result;
+ details.set_result(*result);
}
// C1560.
- if (info.resultName && info.resultName->source == name.source) {
+ if (info.resultName && !distinctResultName) {
Say(info.resultName->source,
"The function name should not appear in RESULT, references to '%s' "
"inside the function will be considered as references to the "
@@ -3322,94 +3357,124 @@ void SubprogramVisitor::Post(const parser::EntryStmt &stmt) {
EndAttrs();
}
-void SubprogramVisitor::PostEntryStmt(const parser::EntryStmt &stmt) {
- Scope &inclusiveScope{InclusiveScope()};
- const Symbol *subprogram{inclusiveScope.symbol()};
- if (!subprogram) {
- CHECK(context().AnyFatalError());
- return;
- }
- const auto &name{std::get<parser::Name>(stmt.t)};
- const parser::Name *resultName{nullptr};
- if (const auto &maybeSuffix{
- std::get<std::optional<parser::Suffix>>(stmt.t)}) {
- resultName = common::GetPtrFromOptional(maybeSuffix->resultName);
- }
- bool inFunction{IsFunction(currScope())};
- if (resultName) { // RESULT(result) is present
- if (!inFunction) {
- // error was already emitted for the suffix
- } else if (resultName->source == subprogram->name()) { // C1574
- Say2(resultName->source,
+void SubprogramVisitor::CreateEntry(
+ const parser::EntryStmt &stmt, Symbol &subprogram) {
+ const auto &entryName{std::get<parser::Name>(stmt.t)};
+ Scope &outer{currScope().parent()};
+ Symbol::Flag subpFlag{subprogram.test(Symbol::Flag::Function)
+ ? Symbol::Flag::Function
+ : Symbol::Flag::Subroutine};
+ Attrs attrs;
+ if (Symbol * extant{FindSymbol(outer, entryName)}) {
+ if (!HandlePreviousCalls(entryName, *extant, subpFlag)) {
+ if (outer.IsTopLevel()) {
+ Say2(entryName,
+ "'%s' is already defined as a global identifier"_err_en_US, *extant,
+ "Previous definition of '%s'"_en_US);
+ } else {
+ SayAlreadyDeclared(entryName, *extant);
+ }
+ return;
+ }
+ attrs = extant->attrs();
+ }
+ const auto &suffix{std::get<std::optional<parser::Suffix>>(stmt.t)};
+ bool badResultName{false};
+ std::optional<SourceName> distinctResultName;
+ if (suffix && suffix->resultName &&
+ suffix->resultName->source != entryName.source) {
+ distinctResultName = suffix->resultName->source;
+ const parser::Name &resultName{*suffix->resultName};
+ if (resultName.source == subprogram.name()) { // C1574
+ Say2(resultName.source,
"RESULT(%s) may not have the same name as the function"_err_en_US,
- subprogram->name(), "Containing function"_en_US);
- } else if (const Symbol *
- symbol{FindSymbol(inclusiveScope.parent(), *resultName)}) { // C1574
- if (const auto *details{symbol->detailsIf<SubprogramDetails>()}) {
- if (details->entryScope() == &inclusiveScope) {
- Say2(resultName->source,
+ subprogram, "Containing function"_en_US);
+ badResultName = true;
+ } else if (const Symbol * extant{FindSymbol(outer, resultName)}) { // C1574
+ if (const auto *details{extant->detailsIf<SubprogramDetails>()}) {
+ if (details->entryScope() == &currScope()) {
+ Say2(resultName.source,
"RESULT(%s) may not have the same name as an ENTRY in the function"_err_en_US,
- symbol->name(), "Conflicting ENTRY"_en_US);
+ extant->name(), "Conflicting ENTRY"_en_US);
+ badResultName = true;
}
}
}
- if (Symbol * symbol{FindSymbol(name)}) { // C1570
- // When RESULT() appears, ENTRY name can't have been already declared
- if (inclusiveScope.Contains(symbol->owner())) {
- Say2(name,
- "ENTRY name '%s' may not be declared when RESULT() is present"_err_en_US,
- *symbol, "Previous declaration of '%s'"_en_US);
- }
- }
- if (resultName->source == name.source) {
- // ignore RESULT() hereafter when it's the same name as the ENTRY
- resultName = nullptr;
- }
}
+ if (outer.IsModule() && !attrs.test(Attr::PRIVATE)) {
+ attrs.set(Attr::PUBLIC);
+ }
+ Symbol &entrySymbol{MakeSymbol(outer, entryName.source, attrs)};
SubprogramDetails entryDetails;
- entryDetails.set_entryScope(inclusiveScope);
- if (inFunction) {
- // Create the entity to hold the function result, if necessary.
- auto &effectiveResultName{*(resultName ? resultName : &name)};
- Symbol *resultSymbol{FindInScope(currScope(), effectiveResultName)};
- if (resultSymbol) { // C1574
- common::visit(
- common::visitors{[resultSymbol](UnknownDetails &) {
- EntityDetails entity;
- entity.set_funcResult(true);
- resultSymbol->set_details(std::move(entity));
- },
- [](EntityDetails &x) { x.set_funcResult(true); },
- [](ObjectEntityDetails &x) { x.set_funcResult(true); },
- [](ProcEntityDetails &x) { x.set_funcResult(true); },
- [&](const auto &) {
- Say2(effectiveResultName.source,
- "'%s' was previously declared as an item that may not be used as a function result"_err_en_US,
- resultSymbol->name(), "Previous declaration of '%s'"_en_US);
- context().SetError(*resultSymbol);
- }},
- resultSymbol->details());
- // The Function flag will have been set if the ENTRY's symbol was created
- // as a placeholder in BeginSubprogram. This prevents misuse of the ENTRY
- // as a subroutine. Clear it now because it's inappropriate for a
- // function result.
- resultSymbol->set(Symbol::Flag::Function, false);
- } else if (!inSpecificationPart_) {
- ObjectEntityDetails entity;
- entity.set_funcResult(true);
- resultSymbol = &MakeSymbol(effectiveResultName, std::move(entity));
- ApplyImplicitRules(*resultSymbol);
+ entryDetails.set_entryScope(currScope());
+ entrySymbol.set(subpFlag);
+ if (subpFlag == Symbol::Flag::Function) {
+ Symbol *result{nullptr};
+ EntityDetails resultDetails;
+ resultDetails.set_funcResult(true);
+ if (distinctResultName) {
+ if (!badResultName) {
+ // RESULT(x) can be the same explicitly-named RESULT(x) as
+ // the enclosing function or another ENTRY.
+ if (auto iter{currScope().find(suffix->resultName->source)};
+ iter != currScope().end()) {
+ result = &*iter->second;
+ }
+ if (!result) {
+ result = &MakeSymbol(
+ *distinctResultName, Attrs{}, std::move(resultDetails));
+ }
+ Resolve(*suffix->resultName, *result);
+ }
} else {
- EntityDetails entity;
- entity.set_funcResult(true);
- resultSymbol = &MakeSymbol(effectiveResultName, std::move(entity));
+ result = &MakeSymbol(entryName.source, Attrs{}, std::move(resultDetails));
}
- if (!resultName) {
- name.symbol = nullptr; // symbol will be used for entry point below
+ if (result) {
+ entryDetails.set_result(*result);
}
- entryDetails.set_result(*resultSymbol);
}
+ if (subpFlag == Symbol::Flag::Subroutine ||
+ (distinctResultName && !badResultName)) {
+ Symbol &assoc{MakeSymbol(entryName.source)};
+ assoc.set_details(HostAssocDetails{entrySymbol});
+ assoc.set(Symbol::Flag::Subroutine);
+ }
+ Resolve(entryName, entrySymbol);
+ entrySymbol.set_details(std::move(entryDetails));
+}
+void SubprogramVisitor::PostEntryStmt(const parser::EntryStmt &stmt) {
+ // The entry symbol should have already been created and resolved
+ // in CreateEntry(), called by BeginSubprogram(), with one exception (below).
+ const auto &name{std::get<parser::Name>(stmt.t)};
+ Scope &inclusiveScope{InclusiveScope()};
+ if (!name.symbol) {
+ if (inclusiveScope.kind() != Scope::Kind::Subprogram) {
+ Say(name.source,
+ "ENTRY '%s' may appear only in a subroutine or function"_err_en_US,
+ name.source);
+ } else if (FindSeparateModuleSubprogramInterface(inclusiveScope.symbol())) {
+ Say(name.source,
+ "ENTRY '%s' may not appear in a separate module procedure"_err_en_US,
+ name.source);
+ } else {
+ // C1571 - entry is nested, so was not put into the program tree; error
+ // is emitted from MiscChecker in semantics.cpp.
+ }
+ return;
+ }
+ Symbol &entrySymbol{*name.symbol};
+ if (context().HasError(entrySymbol)) {
+ return;
+ }
+ if (!entrySymbol.has<SubprogramDetails>()) {
+ SayAlreadyDeclared(name, entrySymbol);
+ return;
+ }
+ SubprogramDetails &entryDetails{entrySymbol.get<SubprogramDetails>()};
+ CHECK(entryDetails.entryScope() == &inclusiveScope);
+ entrySymbol.attrs() |= GetAttrs();
+ SetBindNameOn(entrySymbol);
for (const auto &dummyArg : std::get<std::list<parser::DummyArg>>(stmt.t)) {
if (const auto *dummyName{std::get_if<parser::Name>(&dummyArg.u)}) {
Symbol *dummy{FindSymbol(*dummyName)};
@@ -3433,7 +3498,7 @@ void SubprogramVisitor::PostEntryStmt(const parser::EntryStmt &stmt) {
}
entryDetails.add_dummyArg(*dummy);
} else {
- if (inFunction) { // C1573
+ if (entrySymbol.test(Symbol::Flag::Function)) { // C1573
Say(name,
"ENTRY in a function may not have an alternate return dummy argument"_err_en_US);
break;
@@ -3441,34 +3506,6 @@ void SubprogramVisitor::PostEntryStmt(const parser::EntryStmt &stmt) {
entryDetails.add_alternateReturn();
}
}
-
- Symbol::Flag subpFlag{
- inFunction ? Symbol::Flag::Function : Symbol::Flag::Subroutine};
- Scope &outer{inclusiveScope.parent()}; // global or module scope
- if (outer.IsModule() && attrs_ && !attrs_->test(Attr::PRIVATE)) {
- attrs_->set(Attr::PUBLIC);
- }
- if (Symbol * extant{FindSymbol(outer, name)}) {
- if (!HandlePreviousCalls(name, *extant, subpFlag)) {
- if (outer.IsGlobal()) {
- Say2(name, "'%s' is already defined as a global identifier"_err_en_US,
- *extant, "Previous definition of '%s'"_en_US);
- } else {
- SayAlreadyDeclared(name, *extant);
- }
- return;
- }
- }
-
- Symbol *entrySymbol{&MakeSymbol(outer, name.source, GetAttrs())};
- if (auto *generic{entrySymbol->detailsIf<GenericDetails>()}) {
- CHECK(generic->specific());
- entrySymbol = generic->specific();
- }
- entrySymbol->set_details(std::move(entryDetails));
- SetBindNameOn(*entrySymbol);
- entrySymbol->set(subpFlag);
- Resolve(name, *entrySymbol);
}
// A subprogram declared with MODULE PROCEDURE
@@ -3486,9 +3523,6 @@ bool SubprogramVisitor::BeginMpSubprogram(const parser::Name &name) {
// Convert the module procedure's interface into a subprogram.
SetScope(DEREF(symbol->scope()));
symbol->get<SubprogramDetails>().set_isInterface(false);
- if (IsFunction(*symbol)) {
- funcResultStack().Push(); // just to be popped later
- }
} else {
// Copy the interface into a new subprogram scope.
Symbol &newSymbol{MakeSymbol(name, SubprogramDetails{})};
@@ -3506,7 +3540,6 @@ bool SubprogramVisitor::BeginMpSubprogram(const parser::Name &name) {
if (details.isFunction()) {
currScope().erase(symbol->name());
newDetails.set_result(*currScope().CopySymbol(details.result()));
- funcResultStack().Push(); // just to be popped later
}
}
return true;
@@ -3551,33 +3584,15 @@ bool SubprogramVisitor::BeginSubprogram(const parser::Name &name,
newSymbol.attrs().set(Attr::PUBLIC);
}
}
- if (IsFunction(currScope())) {
- funcResultStack().Push();
- if (entryStmts) {
- // It's possible to refer to the function result variable of an ENTRY
- // statement that lacks an explicit RESULT in code that appears before the
- // ENTRY. Create a placeholder symbol now for that case so that the name
- // doesn't resolve instead to the ENTRY's symbol in the scope around the
- // function.
- for (const auto &ref : *entryStmts) {
- const auto &suffix{std::get<std::optional<parser::Suffix>>(ref->t)};
- if (!(suffix && suffix->resultName)) {
- Symbol &symbol{MakeSymbol(std::get<parser::Name>(ref->t).source,
- Attrs{}, UnknownDetails{})};
- symbol.set(Symbol::Flag::Function);
- }
- }
+ if (entryStmts) {
+ for (const auto &ref : *entryStmts) {
+ CreateEntry(*ref, newSymbol);
}
}
return true;
}
-void SubprogramVisitor::EndSubprogram() {
- if (IsFunction(currScope())) {
- funcResultStack().Pop();
- }
- PopScope();
-}
+void SubprogramVisitor::EndSubprogram() { PopScope(); }
bool SubprogramVisitor::HandlePreviousCalls(
const parser::Name &name, Symbol &symbol, Symbol::Flag subpFlag) {
@@ -3644,6 +3659,9 @@ Symbol &SubprogramVisitor::PushSubprogramScope(const parser::Name &name,
symbol->ReplaceName(name.source);
symbol->set(subpFlag);
PushScope(Scope::Kind::Subprogram, symbol);
+ if (subpFlag == Symbol::Flag::Function) {
+ funcResultStack().Push(currScope());
+ }
if (inInterfaceBlock()) {
auto &details{symbol->get<SubprogramDetails>()};
details.set_isInterface();
@@ -6718,7 +6736,7 @@ void ResolveNamesVisitor::HandleProcedureName(
} else if (CheckUseError(name)) {
// error was reported
} else {
- auto &nonUltimateSymbol = *symbol;
+ auto &nonUltimateSymbol{*symbol};
symbol = &Resolve(name, symbol)->GetUltimate();
bool convertedToProcEntity{ConvertToProcEntity(*symbol)};
if (convertedToProcEntity && !symbol->attrs().test(Attr::EXTERNAL) &&
@@ -7352,10 +7370,11 @@ void ResolveNamesVisitor::AddSubpNames(ProgramTree &node) {
symbol.set(Symbol::Flag::Function);
} else if (childKind == ProgramTree::Kind::Subroutine) {
symbol.set(Symbol::Flag::Subroutine);
+ } else {
+ continue; // make ENTRY symbols only where valid
}
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());
diff --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp
index cb485bc11cdb..7e6d1d0aecb3 100644
--- a/flang/lib/Semantics/tools.cpp
+++ b/flang/lib/Semantics/tools.cpp
@@ -1363,6 +1363,18 @@ const Symbol *IsFunctionResultWithSameNameAsFunction(const Symbol &symbol) {
return function;
}
}
+ // Check ENTRY result symbols too
+ const Scope &outer{symbol.owner().parent()};
+ auto iter{outer.find(symbol.name())};
+ if (iter != outer.end()) {
+ const Symbol &outerSym{*iter->second};
+ if (const auto *subp{outerSym.detailsIf<SubprogramDetails>()}) {
+ if (subp->entryScope() == &symbol.owner() &&
+ symbol.name() == outerSym.name()) {
+ return &outerSym;
+ }
+ }
+ }
}
return nullptr;
}
diff --git a/flang/test/Semantics/entry01.f90 b/flang/test/Semantics/entry01.f90
index 44065e36100d..696f65411018 100644
--- a/flang/test/Semantics/entry01.f90
+++ b/flang/test/Semantics/entry01.f90
@@ -2,7 +2,7 @@
! Tests valid and invalid ENTRY statements
module m1
- !ERROR: ENTRY may appear only in a subroutine or function
+ !ERROR: ENTRY 'badentryinmodule' may appear only in a subroutine or function
entry badentryinmodule
interface
module subroutine separate
@@ -30,18 +30,18 @@ subroutine internal
submodule(m1) m1s1
contains
module procedure separate
- !ERROR: ENTRY may not appear in a separate module procedure
+ !ERROR: ENTRY 'badentryinsmp' may not appear in a separate module procedure
entry badentryinsmp ! 1571
end procedure
end submodule
program main
- !ERROR: ENTRY may appear only in a subroutine or function
+ !ERROR: ENTRY 'badentryinprogram' may appear only in a subroutine or function
entry badentryinprogram ! C1571
end program
block data bd1
- !ERROR: ENTRY may appear only in a subroutine or function
+ !ERROR: ENTRY 'badentryinbd' may appear only in a subroutine or function
entry badentryinbd ! C1571
end block data
@@ -80,9 +80,9 @@ function ifunc()
integer, allocatable :: alloc
integer, pointer :: ptr
entry iok1()
- !ERROR: ENTRY name 'ibad1' may not be declared when RESULT() is present
+ !ERROR: 'ibad1' is already declared in this scoping unit
entry ibad1() result(ibad1res) ! C1570
- !ERROR: 'ibad2' was previously declared as an item that may not be used as a function result
+ !ERROR: 'ibad2' is already declared in this scoping unit
entry ibad2()
!ERROR: ENTRY in a function may not have an alternate return dummy argument
entry ibadalt(*) ! C1573
@@ -92,6 +92,7 @@ function ifunc()
!ERROR: RESULT(iok) may not have the same name as an ENTRY in the function
entry isameres2() result(iok) ! C1574
entry isameres3() result(iok2) ! C1574
+ !ERROR: 'iok2' is already declared in this scoping unit
entry iok2()
!These cases are all acceptably incompatible
entry iok3() result(weird1)
@@ -114,6 +115,8 @@ function ifunc()
continue ! force transition to execution part
entry implicit()
implicit = 666 ! ok, just ensure that it works
+ !ERROR: Cannot call function 'implicit' like a subroutine
+ call implicit
end function
function chfunc() result(chr)
@@ -133,8 +136,9 @@ subroutine externals
!ERROR: 'iok1' is already defined as a global identifier
entry iok1
integer :: ix
+ !ERROR: Cannot call subroutine 'iproc' like a function
+ !ERROR: Function result characteristics are not known
ix = iproc()
- !ERROR: 'iproc' was previously called as a function
entry iproc
end subroutine
@@ -212,3 +216,31 @@ real function setBefore
entry ent
end function
end module
+
+module m6
+ contains
+ recursive subroutine passSubr
+ call foo(passSubr)
+ call foo(ent1)
+ entry ent1
+ call foo(ent1)
+ end subroutine
+ recursive function passFunc1
+ !ERROR: Actual argument associated with procedure dummy argument 'e=' is not a procedure
+ call foo(passFunc1)
+ !ERROR: Actual argument associated with procedure dummy argument 'e=' is not a procedure
+ call foo(ent2)
+ entry ent2
+ !ERROR: Actual argument associated with procedure dummy argument 'e=' is not a procedure
+ call foo(ent2)
+ end function
+ recursive function passFunc2() result(res)
+ call foo(passFunc2)
+ call foo(ent3)
+ entry ent3() result(res)
+ call foo(ent3)
+ end function
+ subroutine foo(e)
+ external e
+ end subroutine
+end module
diff --git a/flang/test/Semantics/symbol20.f90 b/flang/test/Semantics/symbol20.f90
new file mode 100644
index 000000000000..8c8277693332
--- /dev/null
+++ b/flang/test/Semantics/symbol20.f90
@@ -0,0 +1,47 @@
+! RUN: %python %S/test_symbols.py %s %flang_fc1
+! Test handling of pernicious case in which it is conformant Fortran
+! to use the name of a function in a CALL statement. Almost all
+! other compilers produce bogus errors for this case and/or crash.
+
+!DEF: /m Module
+module m
+contains
+ !DEF: /m/foo PUBLIC (Function) Subprogram
+ function foo()
+ !DEF: /m/bar PUBLIC (Subroutine) Subprogram
+ !DEF: /m/foo/foo EXTERNAL, POINTER (Subroutine) ProcEntity
+ procedure(bar), pointer :: foo
+ !REF: /m/bar
+ !DEF: /m/foo/baz EXTERNAL, POINTER (Subroutine) ProcEntity
+ procedure(bar), pointer :: baz
+ !REF: /m/foo/foo
+ !REF: /m/bar
+ foo => bar
+ !REF: /m/foo/foo
+ call foo
+ !DEF: /m/baz PUBLIC (Function) Subprogram
+ entry baz()
+ !REF: /m/foo/baz
+ !REF: /m/bar
+ baz => bar
+ !REF: /m/foo/baz
+ call baz
+ end function
+ !REF: /m/bar
+ subroutine bar
+ print *, "in bar"
+ end subroutine
+end module
+!DEF: /demo MainProgram
+program demo
+ !REF: /m
+ use :: m
+ !DEF: /demo/bar (Subroutine) Use
+ !DEF: /demo/p EXTERNAL, POINTER (Subroutine) ProcEntity
+ procedure(bar), pointer :: p
+ !REF: /demo/p
+ !DEF: /demo/foo (Function) Use
+ p => foo()
+ !REF: /demo/p
+ call p
+end program
More information about the flang-commits
mailing list