[flang-commits] [flang] 2abcb19 - [flang] Don't allow function calls to PROCEDURE() (#165786)

[via flang-commits]

Author: Peter Klausler
Date: 2025-10-31T10:27:30-07:00
New Revision: 2abcb19af22518643c9ebeddb353c008257099b3

URL: https://github.com/llvm/llvm-project/commit/2abcb19af22518643c9ebeddb353c008257099b3
DIFF: https://github.com/llvm/llvm-project/commit/2abcb19af22518643c9ebeddb353c008257099b3.diff

LOG: [flang] Don't allow function calls to PROCEDURE() (#165786)

PROCEDURE() declares a procedure with no interface or result type. (When
used to declare a derived type component, it must also be a NOPASS
POINTER.) Document that we allow such procedures to be called as
subroutines with implicit interfaces, despite the ISO standard -- this
is a universal extension to the language.

However, no longer allow such procedure entities to be referenced as
implicitly-typed functions -- this usage is neither portable nor
well-defined, as the compilers that do allow it do not respect the
implicit typing rules established at the point of declaration.

Added: 
    

Modified: 
    flang/docs/Extensions.md
    flang/lib/Semantics/resolve-names.cpp
    flang/test/Semantics/resolve09.f90

Removed: 
    


################################################################################
diff  --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md
index 6d872094811e3..c9cc02703fbc8 100644
--- a/flang/docs/Extensions.md
+++ b/flang/docs/Extensions.md
@@ -182,6 +182,13 @@ end
   Note that internally the main program symbol name is all uppercase, unlike
   the names of all other symbols, which are usually all lowercase. This
   may make a 
diff erence in testing/debugging.
+* A `PROCEDURE()` with no interface name or type may be called as an
+  subroutine with an implicit interface, F'2023 15.4.3.6 paragraph 4 and
+  C1525 notwithstanding.
+  This is a universally portable feature, and it also applies to
+  `PROCEDURE(), POINTER, NOPASS` derived type components.
+  Such procedures may *not* be referenced as implicitly typed functions
+  without first being associated with a function pointer.
 
 ## Extensions, deletions, and legacy features supported by default
 
@@ -954,4 +961,3 @@ print *, [(j,j=1,10)]
   "&GRP A(1:)=1. 2. 3./".
   This extension is necessarily disabled when the type of the array
   has an accessible defined formatted READ subroutine.
-

diff  --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index f88af5fac0bbd..220f1c96b9823 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -9435,13 +9435,18 @@ bool ResolveNamesVisitor::SetProcFlag(
     SayWithDecl(name, symbol,
         "Implicit declaration of function '%s' has a 
diff erent result type than in previous declaration"_err_en_US);
     return false;
-  } else if (symbol.has<ProcEntityDetails>()) {
-    symbol.set(flag); // in case it hasn't been set yet
-    if (flag == Symbol::Flag::Function) {
-      ApplyImplicitRules(symbol);
-    }
-    if (symbol.attrs().test(Attr::INTRINSIC)) {
-      AcquireIntrinsicProcedureFlags(symbol);
+  } else if (const auto *proc{symbol.detailsIf<ProcEntityDetails>()}) {
+    if (IsPointer(symbol) && !proc->type() && !proc->procInterface()) {
+      // PROCEDURE(), POINTER -- errors will be emitted later about a lack
+      // of known characteristics if used as a function
+    } else {
+      symbol.set(flag); // in case it hasn't been set yet
+      if (flag == Symbol::Flag::Function) {
+        ApplyImplicitRules(symbol);
+      }
+      if (symbol.attrs().test(Attr::INTRINSIC)) {
+        AcquireIntrinsicProcedureFlags(symbol);
+      }
     }
   } else if (symbol.GetType() && flag == Symbol::Flag::Subroutine) {
     SayWithDecl(

diff  --git a/flang/test/Semantics/resolve09.f90 b/flang/test/Semantics/resolve09.f90
index 2fe21aebf66bd..3384b05bf8f27 100644
--- a/flang/test/Semantics/resolve09.f90
+++ b/flang/test/Semantics/resolve09.f90
@@ -140,11 +140,11 @@ subroutine s9
     procedure(), nopass, pointer :: p1, p2
   end type
   type(t) x
+  !ERROR: Function result characteristics are not known
   print *, x%p1()
-  call x%p2
-  !ERROR: Cannot call function 'p1' like a subroutine
-  call x%p1
-  !ERROR: Cannot call subroutine 'p2' like a function
+  call x%p2 ! ok
+  call x%p1 ! ok
+  !ERROR: Function result characteristics are not known
   print *, x%p2()
 end subroutine