[flang-commits] [flang] 8b29048 - [flang] Correct disambiguation of possible statement function definitions
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Mon Jul 17 12:34:29 PDT 2023
Author: Peter Klausler
Date: 2023-07-17T12:25:27-07:00
New Revision: 8b2904826782b29187a757bfe2d1b97bbc4fabb8
URL: https://github.com/llvm/llvm-project/commit/8b2904826782b29187a757bfe2d1b97bbc4fabb8
DIFF: https://github.com/llvm/llvm-project/commit/8b2904826782b29187a757bfe2d1b97bbc4fabb8.diff
LOG: [flang] Correct disambiguation of possible statement function definitions
The statement "A(J) = expr" could be an assignment to an element of an
array A, an assignment to the target of a pointer-valued function A, or
the definition of a new statement function in the local scope named A,
depending on whether it appears in (what might still be) the specification
part of a program or subprogram and what other declarations and definitions
for A might exist in the local scope or have been imported into it.
The standard requires that the name of a statement function appear in
an earlier type declaration statement if it is also the name of an
entity in the enclosing scope. Some other Fortran compilers mistakenly
enforce that rule in the case of an assignment to the target of a
pointer-valued function in the containing scope, after misinterpreting
the assignment as a new local statement function definition.
This patch cleans up the handling of the various possibilities and
resolves what was a crash in the case of a statement function definition
whose name was the same as that of a procedure in the outer scope whose
result is *not* a pointer.
Differential Revision: https://reviews.llvm.org/D155493
Added:
flang/test/Semantics/stmt-func02.f90
Modified:
flang/include/flang/Semantics/tools.h
flang/lib/Semantics/resolve-names.cpp
flang/lib/Semantics/tools.cpp
flang/test/Semantics/resolve08.f90
Removed:
################################################################################
diff --git a/flang/include/flang/Semantics/tools.h b/flang/include/flang/Semantics/tools.h
index 8ce797041dcdc7..acd34e9781ee51 100644
--- a/flang/include/flang/Semantics/tools.h
+++ b/flang/include/flang/Semantics/tools.h
@@ -662,5 +662,7 @@ inline const parser::Name *getDesignatorNameIfDataRef(
return dataRef ? std::get_if<parser::Name>(&dataRef->u) : nullptr;
}
+bool CouldBeDataPointerValuedFunction(const Symbol *);
+
} // namespace Fortran::semantics
#endif // FORTRAN_SEMANTICS_TOOLS_H_
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index f6b17598e4af3f..dfff0458fec456 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -879,7 +879,7 @@ class SubprogramVisitor : public virtual ScopeHandler, public InterfaceVisitor {
protected:
// Set when we see a stmt function that is really an array element assignment
- bool badStmtFuncFound_{false};
+ bool misparsedStmtFuncFound_{false};
private:
// Edits an existing symbol created for earlier calls to a subprogram or ENTRY
@@ -2313,6 +2313,7 @@ void ScopeHandler::PushScope(Scope &scope) {
}
}
void ScopeHandler::PopScope() {
+ CHECK(currScope_ && !currScope_->IsGlobal());
// Entities that are not yet classified as objects or procedures are now
// assumed to be objects.
// TODO: Statement functions
@@ -3439,18 +3440,27 @@ bool SubprogramVisitor::HandleStmtFunction(const parser::StmtFunctionStmt &x) {
const DeclTypeSpec *resultType{nullptr};
// Look up name: provides return type or tells us if it's an array
if (auto *symbol{FindSymbol(name)}) {
- auto *details{symbol->detailsIf<EntityDetails>()};
- if (!details || symbol->has<ObjectEntityDetails>() ||
- symbol->has<ProcEntityDetails>()) {
- badStmtFuncFound_ = true;
+ Symbol &ultimate{symbol->GetUltimate()};
+ if (ultimate.has<ObjectEntityDetails>() ||
+ CouldBeDataPointerValuedFunction(&ultimate)) {
+ misparsedStmtFuncFound_ = true;
return false;
}
- // TODO: check that attrs are compatible with stmt func
- resultType = details->type();
- symbol->details() = UnknownDetails{}; // will be replaced below
+ if (DoesScopeContain(&ultimate.owner(), currScope())) {
+ Say(name,
+ "Name '%s' from host scope should have a type declaration before its local statement function definition"_port_en_US);
+ MakeSymbol(name, Attrs{}, UnknownDetails{});
+ } else if (auto *entity{ultimate.detailsIf<EntityDetails>()};
+ entity && !ultimate.has<ProcEntityDetails>()) {
+ resultType = entity->type();
+ ultimate.details() = UnknownDetails{}; // will be replaced below
+ } else {
+ misparsedStmtFuncFound_ = true;
+ }
}
- if (badStmtFuncFound_) {
- Say(name, "'%s' has not been declared as an array"_err_en_US);
+ if (misparsedStmtFuncFound_) {
+ Say(name,
+ "'%s' has not been declared as an array or pointer-valued function"_err_en_US);
return false;
}
auto &symbol{PushSubprogramScope(name, Symbol::Flag::Function)};
@@ -7847,7 +7857,7 @@ void ResolveNamesVisitor::CreateGeneric(const parser::GenericSpec &x) {
void ResolveNamesVisitor::FinishSpecificationPart(
const std::list<parser::DeclarationConstruct> &decls) {
- badStmtFuncFound_ = false;
+ misparsedStmtFuncFound_ = false;
funcResultStack().CompleteFunctionResultType();
CheckImports();
bool inModule{currScope().kind() == Scope::Kind::Module};
@@ -7903,8 +7913,9 @@ void ResolveNamesVisitor::AnalyzeStmtFunctionStmt(
const auto &name{std::get<parser::Name>(stmtFunc.t)};
Symbol *symbol{name.symbol};
auto *details{symbol ? symbol->detailsIf<SubprogramDetails>() : nullptr};
- if (!details || !symbol->scope()) {
- return;
+ if (!details || !symbol->scope() ||
+ &symbol->scope()->parent() != &currScope()) {
+ return; // error recovery
}
// Resolve the symbols on the RHS of the statement function.
PushScope(*symbol->scope());
@@ -8031,7 +8042,8 @@ bool ResolveNamesVisitor::Pre(const parser::StmtFunctionStmt &x) {
if (HandleStmtFunction(x)) {
return false;
} else {
- // This is an array element assignment: resolve names of indices
+ // This is an array element or pointer-valued function assignment:
+ // resolve the names of indices/arguments
const auto &names{std::get<std::list<parser::Name>>(x.t)};
for (auto &name : names) {
ResolveName(name);
diff --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp
index 891d23d773a1c4..e569e7e418b42d 100644
--- a/flang/lib/Semantics/tools.cpp
+++ b/flang/lib/Semantics/tools.cpp
@@ -1629,4 +1629,21 @@ void WarnOnDeferredLengthCharacterScalar(SemanticsContext &context,
}
}
+bool CouldBeDataPointerValuedFunction(const Symbol *original) {
+ if (original) {
+ const Symbol &ultimate{original->GetUltimate()};
+ if (const Symbol * result{FindFunctionResult(ultimate)}) {
+ return IsPointer(*result) && !IsProcedure(*result);
+ }
+ if (const auto *generic{ultimate.detailsIf<GenericDetails>()}) {
+ for (const SymbolRef &ref : generic->specificProcs()) {
+ if (CouldBeDataPointerValuedFunction(&*ref)) {
+ return true;
+ }
+ }
+ }
+ }
+ return false;
+}
+
} // namespace Fortran::semantics
diff --git a/flang/test/Semantics/resolve08.f90 b/flang/test/Semantics/resolve08.f90
index b485f4c11bdf98..e9ada063a6d4c7 100644
--- a/flang/test/Semantics/resolve08.f90
+++ b/flang/test/Semantics/resolve08.f90
@@ -1,7 +1,7 @@
! RUN: %python %S/test_errors.py %s %flang_fc1
integer :: g(10)
f(i) = i + 1 ! statement function
-g(i) = i + 2 ! mis-parsed array assignment
-!ERROR: 'h' has not been declared as an array
+g(i) = i + 2 ! mis-parsed assignment
+!ERROR: 'h' has not been declared as an array or pointer-valued function
h(i) = i + 3
end
diff --git a/flang/test/Semantics/stmt-func02.f90 b/flang/test/Semantics/stmt-func02.f90
new file mode 100644
index 00000000000000..5d768903e2cb95
--- /dev/null
+++ b/flang/test/Semantics/stmt-func02.f90
@@ -0,0 +1,28 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+module m
+ real, target :: x = 1.
+ contains
+ function rpf(x)
+ real, intent(in out), target :: x
+ real, pointer :: rpf
+ rpf => x
+ end
+ real function rf(x)
+ rf = x
+ end
+ subroutine test1
+ ! This is a valid assignment, not a statement function.
+ ! Every other Fortran compiler misinterprets it!
+ rpf(x) = 2. ! statement function or indirect assignment?
+ print *, x
+ end
+ subroutine test2
+ !PORTABILITY: Name 'rf' from host scope should have a type declaration before its local statement function definition
+ rf(x) = 3.
+ end
+ subroutine test3
+ external sf
+ !ERROR: 'sf' has not been declared as an array or pointer-valued function
+ sf(x) = 4.
+ end
+end
More information about the flang-commits
mailing list