diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp --- a/flang/lib/Evaluate/tools.cpp +++ b/flang/lib/Evaluate/tools.cpp @@ -971,11 +971,18 @@ } 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 --- a/flang/test/Semantics/assign03.f90 +++ b/flang/test/Semantics/assign03.f90 @@ -176,8 +176,7 @@ 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 --- a/flang/test/Semantics/associated.f90 +++ b/flang/test/Semantics/associated.f90 @@ -67,6 +67,7 @@ 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 @@ 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 @@ 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