[flang-commits] [flang] [flang] Catch function result that is non-pointer procedure (PR #164664)

[Peter Klausler via flang-commits]

https://github.com/klausler created https://github.com/llvm/llvm-project/pull/164664

A function result that is a procedure must be a procedure pointer.

>From bfc1402312f24062e9e0fba76e6eb066d75065bd Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Wed, 22 Oct 2025 10:14:29 -0700
Subject: [PATCH] [flang] Catch function result that is non-pointer procedure

A function result that is a procedure must be a procedure pointer.
---
 flang/lib/Semantics/check-declarations.cpp |  4 ++++
 flang/test/Semantics/func-proc-result.f90  | 18 ++++++++++++++++++
 2 files changed, 22 insertions(+)
 create mode 100644 flang/test/Semantics/func-proc-result.f90

diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index 31e246cf0ab03..7de29fc120851 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -472,6 +472,10 @@ void CheckHelper::Check(const Symbol &symbol) {
       messages_.Say(
           "A function result may not also be a named constant"_err_en_US);
     }
+    if (!IsProcedurePointer(symbol) && IsProcedure(symbol)) {
+      messages_.Say(
+          "A function result may not be a procedure unless it is a procedure pointer"_err_en_US);
+    }
   }
   if (IsAutomatic(symbol)) {
     if (const Symbol * common{FindCommonBlockContaining(symbol)}) {
diff --git a/flang/test/Semantics/func-proc-result.f90 b/flang/test/Semantics/func-proc-result.f90
new file mode 100644
index 0000000000000..5bf8ac9c4ddea
--- /dev/null
+++ b/flang/test/Semantics/func-proc-result.f90
@@ -0,0 +1,18 @@
+!RUN: %python %S/test_errors.py %s %flang_fc1
+
+function good() result(pptr)
+  procedure(), pointer :: pptr
+  external whatever
+  pptr => whatever
+end
+
+function bad1() result(res1)
+  !ERROR: A function result may not be a procedure unless it is a procedure pointer
+  procedure() res1
+end
+
+!ERROR: Procedure 'res2' is referenced before being sufficiently defined in a context where it must be so
+function bad2() result(res2)
+  !ERROR: EXTERNAL attribute not allowed on 'res2'
+  external res2
+end