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

[via flang-commits]

Author: Peter Klausler
Date: 2025-10-24T14:14:35-05:00
New Revision: 1e237b1785e77b472279f85455decc6ebe3eaf90

URL: https://github.com/llvm/llvm-project/commit/1e237b1785e77b472279f85455decc6ebe3eaf90
DIFF: https://github.com/llvm/llvm-project/commit/1e237b1785e77b472279f85455decc6ebe3eaf90.diff

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

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

Added: 
    flang/test/Semantics/func-proc-result.f90

Modified: 
    flang/lib/Semantics/check-declarations.cpp

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index 3e21bc6f218a7..549ee83b70fce 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