[flang-commits] [flang] [flang] Detect more misparsed statement functions (same name as funct… (PR #73852)

[Peter Klausler via flang-commits]

https://github.com/klausler updated https://github.com/llvm/llvm-project/pull/73852

>From 75441fa41c5aa50f22e0369424de4a8017c70a06 Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Wed, 29 Nov 2023 12:23:44 -0800
Subject: [PATCH] [flang] Detect more misparsed statement functions (same name
 as function 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.
---
 flang/lib/Semantics/check-declarations.cpp |  3 +++
 flang/lib/Semantics/resolve-names.cpp      |  3 ++-
 flang/test/Semantics/stmt-func01.f90       | 30 ++++++++++++++++++++++
 flang/test/Semantics/stmt-func02.f90       | 19 ++++++++++++++
 4 files changed, 54 insertions(+), 1 deletion(-)

diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index 71292d3211f9b92..777e6a9f23fbf87 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 8f15f2f51da7c89..946ecfc5d60ee8a 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -3508,7 +3508,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 fd9b33a52a57c93..733a7a56dfdb24d 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 90a89e93530c24b..0f4e8c034f659a1 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