Author: Peter Klausler Date: 2023-11-30T13:35:07-08:00 New Revision: a4745ff99bec927efdc726fa902e30d589e70761
URL: https://github.com/llvm/llvm-project/commit/a4745ff99bec927efdc726fa902e30d589e70761 DIFF: https://github.com/llvm/llvm-project/commit/a4745ff99bec927efdc726fa902e30d589e70761.diff LOG: [flang] Detect more misparsed statement functions (same name as funct… (#73852) …ion result) A function can't return a statement function, so an apparent attempt to define a statement function with the same name as the function's result must be a misparsed assignment statement. Added: Modified: flang/lib/Semantics/check-declarations.cpp flang/lib/Semantics/resolve-names.cpp flang/test/Semantics/stmt-func01.f90 flang/test/Semantics/stmt-func02.f90 Removed: ################################################################################ diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp index 71292d3211f9b..777e6a9f23fbf 100644 --- a/flang/lib/Semantics/check-declarations.cpp +++ b/flang/lib/Semantics/check-declarations.cpp @@ -1357,6 +1357,9 @@ void CheckHelper::CheckSubprogram( if (auto msg{evaluate::CheckStatementFunction( symbol, *stmtFunction, context_.foldingContext())}) { SayWithDeclaration(symbol, std::move(*msg)); + } else if (IsPointer(symbol)) { + SayWithDeclaration(symbol, + "A statement function must not have the POINTER attribute"_err_en_US); } else if (details.result().flags().test(Symbol::Flag::Implicit)) { // 15.6.4 p2 weird requirement if (const Symbol * diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp index 5e2a9be41b90f..e1cd34ddf65b6 100644 --- a/flang/lib/Semantics/resolve-names.cpp +++ b/flang/lib/Semantics/resolve-names.cpp @@ -3531,7 +3531,8 @@ bool SubprogramVisitor::HandleStmtFunction(const parser::StmtFunctionStmt &x) { Symbol &ultimate{symbol->GetUltimate()}; if (ultimate.has<ObjectEntityDetails>() || ultimate.has<AssocEntityDetails>() || - CouldBeDataPointerValuedFunction(&ultimate)) { + CouldBeDataPointerValuedFunction(&ultimate) || + (&symbol->owner() == &currScope() && IsFunctionResult(*symbol))) { misparsedStmtFuncFound_ = true; return false; } diff --git a/flang/test/Semantics/stmt-func01.f90 b/flang/test/Semantics/stmt-func01.f90 index fd9b33a52a57c..733a7a56dfdb2 100644 --- a/flang/test/Semantics/stmt-func01.f90 +++ b/flang/test/Semantics/stmt-func01.f90 @@ -53,3 +53,33 @@ subroutine foo sf13(x) = 2.*x end subroutine end + +subroutine s0 + allocatable :: sf + !ERROR: 'sf' is not a callable procedure + sf(x) = 1. +end + +subroutine s1 + asynchronous :: sf + !ERROR: An entity may not have the ASYNCHRONOUS attribute unless it is a variable + sf(x) = 1. +end + +subroutine s2 + pointer :: sf + !ERROR: A statement function must not have the POINTER attribute + sf(x) = 1. +end + +subroutine s3 + save :: sf + !ERROR: The entity 'sf' with an explicit SAVE attribute must be a variable, procedure pointer, or COMMON block + sf(x) = 1. +end + +subroutine s4 + volatile :: sf + !ERROR: VOLATILE attribute may apply only to a variable + sf(x) = 1. +end diff --git a/flang/test/Semantics/stmt-func02.f90 b/flang/test/Semantics/stmt-func02.f90 index 90a89e93530c2..0f4e8c034f659 100644 --- a/flang/test/Semantics/stmt-func02.f90 +++ b/flang/test/Semantics/stmt-func02.f90 @@ -25,4 +25,23 @@ subroutine test3 !ERROR: 'sf' has not been declared as an array or pointer-valued function sf(x) = 4. end + function f() + !ERROR: Recursive call to 'f' requires a distinct RESULT in its declaration + !ERROR: Left-hand side of assignment is not definable + !BECAUSE: 'f()' is not a variable or pointer + f() = 1. ! statement function of same name as function + end + function g() result(r) + !WARNING: Name 'g' from host scope should have a type declaration before its local statement function definition + !ERROR: 'g' is already declared in this scoping unit + g() = 1. ! statement function of same name as function + end + function h1() result(r) + !ERROR: 'r' is not a callable procedure + r() = 1. ! statement function of same name as function result + end + function h2() result(r) + procedure(real), pointer :: r + r() = 1. ! not a statement function + end end _______________________________________________ llvm-branch-commits mailing list llvm-branch-commits@lists.llvm.org https://lists.llvm.org/cgi-bin/mailman/listinfo/llvm-branch-commits
