[flang-commits] [flang] 1341b5a - [flang] Allow mixed association of procedure pointers and targets

[Peter Steinfeld via flang-commits]

Author: Peter Steinfeld
Date: 2022-02-11T10:55:45-08:00
New Revision: 1341b5a0f5c39f05883e0f458d60ee4c6f059886

URL: https://github.com/llvm/llvm-project/commit/1341b5a0f5c39f05883e0f458d60ee4c6f059886
DIFF: https://github.com/llvm/llvm-project/commit/1341b5a0f5c39f05883e0f458d60ee4c6f059886.diff

LOG: [flang] Allow mixed association of procedure pointers and targets

Section 10.2.2.4, paragraph 3 states that a procedure pointer with an explicit
interface must have the same characteristics as its target.  Previously, we
interpreted this as disallowing such pointers to point to procedures with
implicit interfaces.  But several other compilers allow this.

We make an exception for the case where the explicit interface cannot be
called via an implicit interface.

This change makes us allow this, also

Differential Revision: https://reviews.llvm.org/D119404

Added: 
    

Modified: 
    flang/lib/Evaluate/tools.cpp
    flang/test/Semantics/assign03.f90
    flang/test/Semantics/associated.f90

Removed: 
    


################################################################################
diff  --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp
index 726d5308eedf1..00b9769befe85 100644
--- a/flang/lib/Evaluate/tools.cpp
+++ b/flang/lib/Evaluate/tools.cpp
@@ -971,11 +971,18 @@ std::optional<parser::MessageFixedText> CheckProcCompatibility(bool isCall,
   } else if (lhsProcedure->HasExplicitInterface() &&
       !rhsProcedure->HasExplicitInterface()) {
     // Section 10.2.2.4, paragraph 3 prohibits associating a procedure pointer
-    // with an explicit interface with a procedure with an implicit interface
-    msg = "Procedure %s with explicit interface may not be associated with"
-          " procedure designator '%s' with implicit interface"_err_en_US;
+    // with an explicit interface with a procedure whose characteristics don't
+    // match.  That's the case if the target procedure has an implicit
+    // interface.  But this case is allowed by several other compilers as long
+    // as the explicit interface can be called via an implicit interface.
+    if (!lhsProcedure->CanBeCalledViaImplicitInterface()) {
+      msg = "Procedure %s with explicit interface that cannot be called via "
+            "an implicit interface cannot be associated with procedure "
+            "designator with an implicit interface"_err_en_US;
+    }
   } else if (!lhsProcedure->HasExplicitInterface() &&
       rhsProcedure->HasExplicitInterface()) {
+    // OK if the target can be called via an implicit interface
     if (!rhsProcedure->CanBeCalledViaImplicitInterface()) {
       msg = "Procedure %s with implicit interface may not be associated "
             "with procedure designator '%s' with explicit interface that "

diff  --git a/flang/test/Semantics/assign03.f90 b/flang/test/Semantics/assign03.f90
index ce5897d41dc6c..0c385b167c928 100644
--- a/flang/test/Semantics/assign03.f90
+++ b/flang/test/Semantics/assign03.f90
@@ -176,8 +176,7 @@ subroutine s6
     procedure(s), pointer :: p, q
     procedure(), pointer :: r
     external :: s_external
-    !ERROR: Procedure pointer 'p' with explicit interface may not be associated with procedure designator 's_external' with implicit interface
-    p => s_external
+    p => s_external ! OK for a pointer with an explicit interface to be associated with a procedure with an implicit interface
     r => s_module ! OK for a pointer with implicit interface to be associated with a procedure with an explicit interface.  See 10.2.2.4 (3)
   end
 

diff  --git a/flang/test/Semantics/associated.f90 b/flang/test/Semantics/associated.f90
index 3d472bdc06667..34583c477e16f 100644
--- a/flang/test/Semantics/associated.f90
+++ b/flang/test/Semantics/associated.f90
@@ -67,6 +67,7 @@ subroutine test()
     procedure(subrInt) :: subProc
     procedure(subrInt), pointer :: subProcPointer
     procedure(), pointer :: implicitProcPointer
+    procedure(subrCannotBeCalledfromImplicit), pointer :: cannotBeCalledfromImplicitPointer
     logical :: lVar
     type(t1) :: t1x
     type(t1), target :: t1xtarget
@@ -158,10 +159,8 @@ subroutine test()
     realProcPointer1 => intProc
     !ERROR: Procedure pointer 'realprocpointer1' associated with incompatible procedure designator 'intproc'
     lvar = associated(realProcPointer1, intProc)
-    !ERROR: Procedure pointer 'subprocpointer' with explicit interface may not be associated with procedure designator 'externalproc' with implicit interface
-    subProcPointer => externalProc
-    !ERROR: Procedure pointer 'subprocpointer' with explicit interface may not be associated with procedure designator 'externalproc' with implicit interface
-    lvar = associated(subProcPointer, externalProc)
+    subProcPointer => externalProc ! OK to associate a procedure pointer  with an explicit interface to a procedure with an implicit interface
+    lvar = associated(subProcPointer, externalProc) ! OK to associate a procedure pointer with an explicit interface to a procedure with an implicit interface
     !ERROR: Subroutine pointer 'subprocpointer' may not be associated with function designator 'intproc'
     subProcPointer => intProc
     !ERROR: Subroutine pointer 'subprocpointer' may not be associated with function designator 'intproc'
@@ -174,5 +173,9 @@ subroutine test()
     lvar = associated(implicitProcPointer, subr) ! OK
     !ERROR: Procedure pointer 'implicitprocpointer' with implicit interface may not be associated with procedure designator 'subrcannotbecalledfromimplicit' with explicit interface that cannot be called via an implicit interface
     lvar = associated(implicitProcPointer, subrCannotBeCalledFromImplicit)
+    !ERROR: Procedure pointer 'cannotbecalledfromimplicitpointer' with explicit interface that cannot be called via an implicit interface cannot be associated with procedure designator with an implicit interface
+    cannotBeCalledfromImplicitPointer => externalProc
+    !ERROR: Procedure pointer 'cannotbecalledfromimplicitpointer' with explicit interface that cannot be called via an implicit interface cannot be associated with procedure designator with an implicit interface
+    lvar = associated(cannotBeCalledfromImplicitPointer, externalProc)
   end subroutine test
 end subroutine assoc