[flang] More careful handling of PROCEDURE() components

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

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,

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(

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