[flang] Catch function result that is non-pointer procedure

[klausler]

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

[llvmbot]

@llvm/pr-subscribers-flang-semantics

Author: Peter Klausler (klausler)

Changes

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

---

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

2 Files Affected:

• (modified) flang/lib/Semantics/check-declarations.cpp (+4)
• (added) flang/test/Semantics/func-proc-result.f90 (+18)

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

[jeanPerier]

Thanks