[flang] Allow mixed association of procedure pointers and targets

[PeteSteinfeld]

Summary

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.

This change makes us allow this, also.

[jeanPerier]

flang/lib/Evaluate/tools.cpp

977

I agree that nag/gfortran/ifort/nvfortran do not complain if the pointer explicit interface is compatible with an implicit interface (CanBeCalledViaImplicitInterface()), but it seems only nvfortran allows the cases where the explicit interface cannot be called via implicit interface. The following program is refused by nag/ifort/gfortran/xlf (and I think we should too, unless they are programs that really needs it):

module m
    interface
      subroutine requires_explicit_iface(p)
        real, pointer :: p(:)
      end subroutine
    end interface
contains
subroutine test
  procedure(requires_explicit_iface), pointer :: p
    external :: s_external
    p => s_external
end subroutine
end module

So you could still complain here if !lhsProcedure->CanBeCalledViaImplicitInterface() IMHO.

[klausler]

Agree with Jean's comment.

[PeteSteinfeld]

flang/lib/Evaluate/tools.cpp

977

Thanks, Jean. That makes sense.

I'll add some code and a test.

[PeteSteinfeld]

Responding to Jean's comments.

[PeteSteinfeld]

@jeanPerier or @klausler, can you please take another look?

[jeanPerier]

LGTM

flang/lib/Evaluate/tools.cpp

std::optional<parser::MessageFixedText> CheckProcCompatibility(bool isCall,
   } else if (lhsProcedure->IsFunction() && !rhsProcedure->IsFunction()) {
     msg = "Function %s may not be associated with subroutine"
           " designator '%s'"_err_en_US;
   } else if (!lhsProcedure->IsFunction() && rhsProcedure->IsFunction()) {
     msg = "Subroutine %s may not be associated with function"
           " designator '%s'"_err_en_US;
   } else if (lhsProcedure->HasExplicitInterface() &&
       !rhsProcedure->HasExplicitInterface()) {
+    // OK
     // 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.
   } 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 "
             "cannot be called via an implicit interface"_err_en_US;
     }
   } else {
     msg = "Procedure %s associated with incompatible procedure"
           " designator '%s'"_err_en_US;

flang/test/Semantics/assign03.f90

contains
     end subroutine s_elemental2
   end
 
   ! 10.2.2.4(4)
   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
 
   ! 10.2.2.4(5)
   subroutine s7
     procedure(real) :: f_external
     external :: s_external
     procedure(), pointer :: p_s

flang/test/Semantics/associated.f90

subroutine test()
     !ERROR: PURE procedure pointer 'purefuncpointer' may not be associated with non-PURE procedure designator 'intproc'
     pureFuncPointer => intProc
     !ERROR: PURE procedure pointer 'purefuncpointer' may not be associated with non-PURE procedure designator 'intproc'
     lvar = associated(pureFuncPointer, intProc)
     !ERROR: Procedure pointer 'realprocpointer1' associated with incompatible procedure designator 'intproc'
     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'
     lvar = associated(subProcPointer, intProc)
     !ERROR: Function pointer 'intprocpointer1' may not be associated with subroutine designator 'subproc'
     intProcPointer1 => subProc
     !ERROR: Function pointer 'intprocpointer1' may not be associated with subroutine designator 'subproc'
     lvar = associated(intProcPointer1, subProc)
     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