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 @@ -954,12 +954,18 @@ " 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 --- a/flang/test/Semantics/assign03.f90 +++ b/flang/test/Semantics/assign03.f90 @@ -178,8 +178,7 @@ 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 end ! 10.2.2.4(5) 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 @@ -36,6 +36,10 @@ integer :: i end subroutine subr + subroutine subrCannotBeCalledfromImplicit(i) + integer :: i(:) + end subroutine subrCannotBeCalledfromImplicit + subroutine test() integer :: intVar integer, target :: targetIntVar1 @@ -145,9 +149,9 @@ 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