[flang-commits] [flang] 4f11944 - [flang] Allow implicit procedure pointers to associate with explicit procedures

[Peter Steinfeld via flang-commits]

Author: Peter Steinfeld
Date: 2021-11-15T09:51:25-08:00
New Revision: 4f11944652dec790c56e029d9a207db284831479

URL: https://github.com/llvm/llvm-project/commit/4f11944652dec790c56e029d9a207db284831479
DIFF: https://github.com/llvm/llvm-project/commit/4f11944652dec790c56e029d9a207db284831479.diff

LOG: [flang] Allow implicit procedure pointers to associate with explicit procedures

Section 10.2.2.4, paragraph 3 states that, for procedure pointer assignment:
  If the pointer object has an explicit interface, its characteristics shall be
  the same as the pointer target ...

Thus, it's illegal for a procedure pointer with an explicit interface to be
associated with a procedure whose interface is implicit.  However, there's no
prohibition that disallows a procedure pointer with an implicit interface from
being associated with a procedure whose interface is explicit.

We were incorrectly emitting an error message for this latter case.

We were also not covering the case of procedures with explicit
interfaces where calling them requires the use of a descriptor.  Such
procedures cannot be associated with procedure pointers with implicit
interfaces.

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

Added: 
    

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

Removed: 
    


################################################################################
diff  --git a/flang/lib/Evaluate/characteristics.cpp b/flang/lib/Evaluate/characteristics.cpp
index 464c9e9bce0d6..037784e0e9ded 100644
--- a/flang/lib/Evaluate/characteristics.cpp
+++ b/flang/lib/Evaluate/characteristics.cpp
@@ -833,6 +833,7 @@ std::optional<Procedure> Procedure::Characterize(
 }
 
 bool Procedure::CanBeCalledViaImplicitInterface() const {
+  // TODO: Pass back information on why we return false
   if (attrs.test(Attr::Elemental) || attrs.test(Attr::BindC)) {
     return false; // 15.4.2.2(5,6)
   } else if (IsFunction() &&

diff  --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp
index 722d0c06b12e7..4b0bedd9c7a80 100644
--- a/flang/lib/Evaluate/tools.cpp
+++ b/flang/lib/Evaluate/tools.cpp
@@ -954,12 +954,17 @@ std::optional<parser::MessageFixedText> CheckProcCompatibility(bool isCall,
           " designator '%s'"_err_en_US;
   } 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;
   } else if (!lhsProcedure->HasExplicitInterface() &&
       rhsProcedure->HasExplicitInterface()) {
-    msg = "Procedure %s with implicit interface may not be associated with"
-          " procedure designator '%s' with explicit interface"_err_en_US;
+    if (!rhsProcedure->CanBeCalledViaImplicitInterface()) {
+      msg = "Procedure %s with implicit interface may not be associated "
+            "with procedure designator '%s' with explicit interface that "
+            "cannot be called via an implicit interface"_err_en_US;
+    }
   } else {
     msg = "Procedure %s associated with incompatible procedure"
           " designator '%s'"_err_en_US;

diff  --git a/flang/test/Semantics/assign03.f90 b/flang/test/Semantics/assign03.f90
index bc0ab035399b4..c8fed50a18f05 100644
--- a/flang/test/Semantics/assign03.f90
+++ b/flang/test/Semantics/assign03.f90
@@ -178,8 +178,7 @@ subroutine s6
     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
-    !ERROR: Procedure pointer 'r' with implicit interface may not be associated with procedure designator 's_module' with explicit interface
-    r => s_module
+    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
 
   ! 10.2.2.4(5)

diff  --git a/flang/test/Semantics/associated.f90 b/flang/test/Semantics/associated.f90
index 4d70a2014edf5..08dfa4530138b 100644
--- a/flang/test/Semantics/associated.f90
+++ b/flang/test/Semantics/associated.f90
@@ -36,6 +36,10 @@ subroutine subr(i)
     integer :: i
   end subroutine subr
 
+  subroutine subrCannotBeCalledfromImplicit(i)
+    integer :: i(:)
+  end subroutine subrCannotBeCalledfromImplicit
+
   subroutine test()
     integer :: intVar
     integer, target :: targetIntVar1
@@ -145,9 +149,9 @@ subroutine test()
     intProcPointer1 => subProc
     !ERROR: Function pointer 'intprocpointer1' may not be associated with subroutine designator 'subproc'
     lvar = associated(intProcPointer1, subProc)
-    !ERROR: Procedure pointer 'implicitprocpointer' with implicit interface may not be associated with procedure designator 'subr' with explicit interface
-    implicitProcPointer => subr
-    !ERROR: Procedure pointer 'implicitprocpointer' with implicit interface may not be associated with procedure designator 'subr' with explicit interface
-    lvar = associated(implicitProcPointer, subr)
+    implicitProcPointer => subr ! OK for an implicit point to point to an explicit proc
+    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)
   end subroutine test
 end subroutine assoc