diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp --- a/flang/lib/Semantics/check-call.cpp +++ b/flang/lib/Semantics/check-call.cpp @@ -537,9 +537,20 @@ } if (interface.HasExplicitInterface()) { if (interface != argInterface) { - messages.Say( - "Actual argument procedure has interface incompatible with %s"_err_en_US, - dummyName); + // 15.5.2.9(1): Explicit interfaces must match + if (argInterface.HasExplicitInterface()) { + messages.Say( + "Actual procedure argument has interface incompatible with %s"_err_en_US, + dummyName); + return; + } else { + messages.Say( + "Actual procedure argument has an implicit interface " + "which is not known to be compatible with %s which has an " + "explcit interface"_err_en_US, + dummyName); + return; + } } } else { // 15.5.2.9(2,3) if (interface.IsSubroutine() && argInterface.IsFunction()) { diff --git a/flang/test/Semantics/call09.f90 b/flang/test/Semantics/call09.f90 --- a/flang/test/Semantics/call09.f90 +++ b/flang/test/Semantics/call09.f90 @@ -19,6 +19,9 @@ subroutine s02(p) procedure(realfunc), pointer :: p end subroutine + subroutine s03(p) + procedure(realfunc) :: p + end subroutine subroutine selemental1(p) procedure(cos) :: p ! ok @@ -47,28 +50,33 @@ procedure(realfunc), pointer :: p procedure(intfunc), pointer :: ip integer, pointer :: intPtr + external :: extfunc + external :: extfuncPtr + pointer :: extfuncPtr p => realfunc ip => intfunc call s01(realfunc) ! ok - !ERROR: Actual argument procedure has interface incompatible with dummy argument 'p=' + !ERROR: Actual procedure argument has interface incompatible with dummy argument 'p=' call s01(intfunc) call s01(p) ! ok call s01(procptr()) ! ok - !ERROR: Actual argument procedure has interface incompatible with dummy argument 'p=' + !ERROR: Actual procedure argument has interface incompatible with dummy argument 'p=' call s01(intprocptr()) call s01(null()) ! ok call s01(null(p)) ! ok - !ERROR: Actual argument procedure has interface incompatible with dummy argument 'p=' + !ERROR: Actual procedure argument has interface incompatible with dummy argument 'p=' call s01(null(ip)) call s01(sin) ! ok !ERROR: Actual argument associated with procedure dummy argument 'p=' is not a procedure call s01(null(intPtr)) !ERROR: Actual argument associated with procedure dummy argument 'p=' is not a procedure call s01(B"0101") + !ERROR: Actual procedure argument has an implicit interface which is not known to be compatible with dummy argument 'p=' which has an explcit interface + call s01(extfunc) !ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a POINTER unless INTENT(IN) call s02(realfunc) call s02(p) ! ok - !ERROR: Actual argument procedure has interface incompatible with dummy argument 'p=' + !ERROR: Actual procedure argument has interface incompatible with dummy argument 'p=' call s02(ip) !ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a POINTER unless INTENT(IN) call s02(procptr()) @@ -78,6 +86,10 @@ call s02(null(p)) !ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a POINTER unless INTENT(IN) call s02(sin) + !ERROR: Actual procedure argument has an implicit interface which is not known to be compatible with dummy argument 'p=' which has an explcit interface + call s02(extfunc) + !ERROR: Actual procedure argument has an implicit interface which is not known to be compatible with dummy argument 'p=' which has an explcit interface + call s03(extfuncPtr) end subroutine subroutine callsub(s)