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

[via flang-commits]

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

>From b338ea8c9fdd3e8b4fa93171a35e8f99705d5ff8 Mon Sep 17 00:00:00 2001
From: yixiao <yixiao at hygon.cn>
Date: Fri, 14 Aug 2026 21:02:41 +0800
Subject: [PATCH] [Flang] Fix IsProcedure() for procedure-valued function
 references

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.
---
 flang/lib/Evaluate/tools.cpp              | 12 +++++++++++-
 flang/test/Semantics/func-proc-result.f90 | 15 +++++++++++++++
 2 files changed, 26 insertions(+), 1 deletion(-)

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/func-proc-result.f90 b/flang/test/Semantics/func-proc-result.f90
index 5bf8ac9c4ddea..b7fc33e3e3b83 100644
--- a/flang/test/Semantics/func-proc-result.f90
+++ b/flang/test/Semantics/func-proc-result.f90
@@ -16,3 +16,18 @@ function bad2() result(res2)
   !ERROR: EXTERNAL attribute not allowed on 'res2'
   external res2
 end
+
+
+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
+
+function s(x) result(i)
+  procedure(), pointer :: i
+  ! ERROR: Actual argument for 'array=' may not be a procedure
+  print *, size(S(dd))
+end
+