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

[via flang-commits]

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 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 5e2a9be41b90ffd..e1cd34ddf65b6ba 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 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