[flang] More careful handling of PROCEDURE() components

[klausler]

Derived type components declared as PROCEDURE() -- without an explicit interface or result type, and also necessarily a NOPASS POINTER -- should not be allowed to be called as functions, and should elicit an optional warning or error if called as subroutines. This form of declaration is neither a function nor a subroutine, although many compilers interpret it as a subroutine.

The compiler was previously treating such components in the same way as non-component PROCEDURE() entities are handled; in particular, they were implicitly typed.

[llvmbot]

@llvm/pr-subscribers-flang-semantics

Author: Peter Klausler (klausler)

Changes

Derived type components declared as PROCEDURE() -- without an explicit interface or result type, and also necessarily a NOPASS POINTER -- should not be allowed to be called as functions, and should elicit an optional warning or error if called as subroutines. This form of declaration is neither a function nor a subroutine, although many compilers interpret it as a subroutine.

The compiler was previously treating such components in the same way as non-component PROCEDURE() entities are handled; in particular, they were implicitly typed.

---

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

4 Files Affected:

• (modified) flang/docs/Extensions.md (+11)
• (modified) flang/include/flang/Support/Fortran-features.h (+1-1)
• (modified) flang/lib/Semantics/resolve-names.cpp (+29-7)
• (modified) flang/test/Semantics/resolve09.f90 (+22-4)

diff --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md
index 6d872094811e3..8a94004f3d20b 100644
--- a/flang/docs/Extensions.md
+++ b/flang/docs/Extensions.md
@@ -939,6 +939,17 @@ print *, [(j,j=1,10)]
   This design allows format-driven input with `DT` editing to retain
   control over advancement in child input, while otherwise allowing it.
 
+* Many compilers interpret `PROCEDURE()` as meaning a subroutine,
+  but it does not do so; it defines an entity that is not declared
+  to be either a subroutine or a function.
+  If it is referenced, its references must be consistent.
+  If it is never referenced, it may be associated with any
+  procedure.
+
+* A `PROCEDURE()` component (necessarily also a pointer) without an
+  explicit interface or result type cannot be called as a function,
+  and will elicit an optional warning when called as a subroutine.
+
 ## De Facto Standard Features
 
 * `EXTENDS_TYPE_OF()` returns `.TRUE.` if both of its arguments have the
diff --git a/flang/include/flang/Support/Fortran-features.h b/flang/include/flang/Support/Fortran-features.h
index 51364d552be64..5be3cc3674563 100644
--- a/flang/include/flang/Support/Fortran-features.h
+++ b/flang/include/flang/Support/Fortran-features.h
@@ -56,7 +56,7 @@ ENUM_CLASS(LanguageFeature, BackslashEscapes, OldDebugLines,
     IgnoreIrrelevantAttributes, Unsigned, AmbiguousStructureConstructor,
     ContiguousOkForSeqAssociation, ForwardRefExplicitTypeDummy,
     InaccessibleDeferredOverride, CudaWarpMatchFunction, DoConcurrentOffload,
-    TransferBOZ, Coarray)
+    TransferBOZ, Coarray, CallImplicitProcComponent)
 
 // Portability and suspicious usage warnings
 ENUM_CLASS(UsageWarning, Portability, PointerToUndefinable,
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 4af6cf6a91239..91f0f7b608802 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -9456,13 +9456,35 @@ bool ResolveNamesVisitor::SetProcFlag(
     SayWithDecl(name, symbol,
         "Implicit declaration of function '%s' has a different 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 *procDetails{symbol.detailsIf<ProcEntityDetails>()}) {
+    if (symbol.owner().IsDerivedType()) { // procedure pointer component
+      bool isFunction{IsFunction(symbol)};
+      const Symbol *explicitInterface{procDetails->procInterface()};
+      if (flag == Symbol::Flag::Function) {
+        if (!isFunction) {
+          SayWithDecl(name, symbol,
+              "Procedure pointer component '%s' was not declared to be a function"_err_en_US);
+        }
+      } else if (isFunction ||
+          (!explicitInterface &&
+              !context().IsEnabled(
+                  common::LanguageFeature::CallImplicitProcComponent))) {
+        SayWithDecl(name, symbol,
+            "Procedure pointer component '%s' was not declared to be a subroutine"_err_en_US);
+      } else if (!explicitInterface &&
+          context().ShouldWarn(
+              common::LanguageFeature::CallImplicitProcComponent)) {
+        SayWithDecl(name, symbol,
+            "Procedure pointer component '%s' should have been declared to be a subroutine"_warn_en_US);
+      }
+    } 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..59d9a1901c58e 100644
--- a/flang/test/Semantics/resolve09.f90
+++ b/flang/test/Semantics/resolve09.f90
@@ -1,4 +1,4 @@
-! RUN: %python %S/test_errors.py %s %flang_fc1
+! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
 integer :: y
 procedure() :: a
 procedure(real) :: b
@@ -136,16 +136,34 @@ function b8()
 end
 
 subroutine s9
+  abstract interface
+    subroutine subr
+    end
+    real function realfunc()
+    end
+  end interface
   type t
     procedure(), nopass, pointer :: p1, p2
+    procedure(subr), nopass, pointer :: psub
+    procedure(realfunc), nopass, pointer :: pfunc
   end type
   type(t) x
+  !ERROR: Function result characteristics are not known
+  !ERROR: Procedure pointer component 'p1' was not declared to be a function
   print *, x%p1()
-  call x%p2
-  !ERROR: Cannot call function 'p1' like a subroutine
+  !ERROR: Procedure pointer component 'p1' should have been declared to be a subroutine
   call x%p1
-  !ERROR: Cannot call subroutine 'p2' like a function
+  !ERROR: Procedure pointer component 'p2' should have been declared to be a subroutine
+  call x%p2
+  !ERROR: Function result characteristics are not known
+  !ERROR: Procedure pointer component 'p2' was not declared to be a function
   print *, x%p2()
+  !ERROR: Cannot call subroutine 'psub' like a function
+  print *, x%psub()
+  print *, x%pfunc() ! ok
+  call x%psub ! ok
+  !ERROR: Cannot call function 'pfunc' like a subroutine
+  call x%pfunc
 end subroutine
 
 subroutine s10

[akuhlens]

Otherwise, it looks good to me.

[akuhlens]

What is "it" here? Is this Flang or the Standard? I scanned back a few paragraphs and the owner of the pronoun wasn't obvious.

[akuhlens]

Ah, on rereading, this could only mean "the keyword Procedure" or something similar. Might want to make the first occurrence explicit.

[eugeneepshteyn]

I'm confused by this. Here flag is not function, so presumably it's subroutine? Or something else?

So if it's perhaps function with implicit interface, why is the error message "was not declared to be a subroutine"? BTW, this error does not seem to be covered by the LIT test...