[flang-commits] [flang] [Flang] Fix IsProcedure() for procedure-valued function references (PR #216322)

[via flang-commits]

llvmorg-github-actions[bot] wrote:


<!--LLVM PR SUMMARY COMMENT-->

@llvm/pr-subscribers-flang-semantics

Author: nudt_yixiao (keepyixiao)

<details>
<summary>Changes</summary>

IsProcedure() does not recognize function references whose results are procedures. This can cause an assertion failure in intrinsic argument checking when such an expression is passed as an actual argument.

Update IsProcedure() to inspect the result symbol of a ProcedureRef and determine whether the function result is a procedure.

Add a regression test for procedure-valued function references.

---
Full diff: https://github.com/llvm/llvm-project/pull/216322.diff


3 Files Affected:

- (modified) flang/lib/Evaluate/tools.cpp (+11-1) 
- (added) flang/test/Semantics/procedure-function-result01.f90 (+8) 
- (added) flang/test/Semantics/procedure-function-result02.f90 (+7) 


``````````diff
diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp
index 589aab5132a65..b1d6a6bf82f32 100644
--- a/flang/lib/Evaluate/tools.cpp
+++ b/flang/lib/Evaluate/tools.cpp
@@ -1003,7 +1003,17 @@ bool IsProcedurePointer(const Expr<SomeType> &expr) {
 }
 
 bool IsProcedure(const Expr<SomeType> &expr) {
-  return IsProcedureDesignator(expr) || IsProcedurePointer(expr);
+  if (IsProcedureDesignator(expr) || IsProcedurePointer(expr)) {
+    return true;
+  }
+  if (const auto *funcRef{UnwrapProcedureRef(expr)}) {
+    if (const Symbol *proc{funcRef->proc().GetSymbol()}) {
+      if (const Symbol *result{FindFunctionResult(*proc)}) {
+        return IsProcedure(*result);
+      }
+    }
+  }
+  return false;
 }
 
 bool IsProcedurePointerTarget(const Expr<SomeType> &expr) {
diff --git a/flang/test/Semantics/procedure-function-result01.f90 b/flang/test/Semantics/procedure-function-result01.f90
new file mode 100644
index 0000000000000..f6743d76faad2
--- /dev/null
+++ b/flang/test/Semantics/procedure-function-result01.f90
@@ -0,0 +1,8 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+
+function s(x) result(i)
+  ! ERROR: A function result may not be a procedure unless it is a procedure pointer
+  procedure() :: i
+  ! ERROR: Actual argument for 'array=' may not be a procedure
+  print *, size(S(dd))
+end
diff --git a/flang/test/Semantics/procedure-function-result02.f90 b/flang/test/Semantics/procedure-function-result02.f90
new file mode 100644
index 0000000000000..ed49b8b8847c6
--- /dev/null
+++ b/flang/test/Semantics/procedure-function-result02.f90
@@ -0,0 +1,7 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+
+function s(x) result(i)
+  procedure(), pointer :: i
+  ! ERROR: Actual argument for 'array=' may not be a procedure
+  print *, size(S(dd))
+end

``````````

</details>


https://github.com/llvm/llvm-project/pull/216322