[flang-commits] [flang] [flang] More careful handling of PROCEDURE() components (PR #165468)

[via flang-commits]

llvmbot wrote:


<!--LLVM PR SUMMARY COMMENT-->

@llvm/pr-subscribers-flang-semantics

Author: Peter Klausler (klausler)

<details>
<summary>Changes</summary>

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
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

``````````

</details>


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