Index: flang/lib/Semantics/check-call.cpp =================================================================== --- flang/lib/Semantics/check-call.cpp +++ flang/lib/Semantics/check-call.cpp @@ -392,16 +392,22 @@ // Definability const char *reason{nullptr}; + bool dummyIsPointer{ + dummy.attrs.test(characteristics::DummyDataObject::Attr::Pointer)}; if (dummy.intent == common::Intent::Out) { reason = "INTENT(OUT)"; } else if (dummy.intent == common::Intent::InOut) { reason = "INTENT(IN OUT)"; } if (reason && scope) { - DefinabilityFlags flags; + // Problems with polymorphism are caught in the callee's definition. + DefinabilityFlags flags{DefinabilityFlag::PolymorphicOkInPure}; if (isElemental || dummyIsValue) { // 15.5.2.4(21) flags.set(DefinabilityFlag::VectorSubscriptIsOk); } + if (actualIsPointer && dummyIsPointer) { // 19.6.8 + flags.set(DefinabilityFlag::PointerDefinition); + } if (auto whyNot{WhyNotDefinable(messages.at(), *scope, flags, actual)}) { if (auto *msg{messages.Say( "Actual argument associated with %s %s is not definable"_err_en_US, @@ -415,8 +421,6 @@ bool actualIsContiguous{IsSimplyContiguous(actual, context)}; bool dummyIsAssumedShape{dummy.type.attrs().test( characteristics::TypeAndShape::Attr::AssumedShape)}; - bool dummyIsPointer{ - dummy.attrs.test(characteristics::DummyDataObject::Attr::Pointer)}; bool dummyIsContiguous{ dummy.attrs.test(characteristics::DummyDataObject::Attr::Contiguous)}; if ((actualIsAsynchronous || actualIsVolatile) && @@ -684,9 +688,15 @@ } if (dummyIsPointer && dummy.intent != common::Intent::In) { const Symbol *last{GetLastSymbol(*expr)}; - if (!(last && IsProcedurePointer(*last)) && - !(dummy.intent == common::Intent::Default && - IsNullProcedurePointer(*expr))) { + if (last && IsProcedurePointer(*last)) { + if (dummy.intent != common::Intent::Default && + IsIntentIn(last->GetUltimate())) { // 19.6.8 + messages.Say( + "Actual argument associated with procedure pointer %s may not be INTENT(IN)"_err_en_US, + dummyName); + } + } else if (!(dummy.intent == common::Intent::Default && + IsNullProcedurePointer(*expr))) { // 15.5.2.9(5) -- dummy procedure POINTER // Interface compatibility has already been checked above messages.Say( Index: flang/test/Semantics/definable01.f90 =================================================================== --- flang/test/Semantics/definable01.f90 +++ flang/test/Semantics/definable01.f90 @@ -1,5 +1,5 @@ ! RUN: not %flang_fc1 -fsyntax-only %s 2>&1 | FileCheck %s -! Test WhyNotModifiable() explanations +! Test WhyNotDefinable() explanations module prot real, protected :: prot @@ -67,4 +67,19 @@ !CHECK: because: 'ptr' is externally visible via 'ptr' and not definable in a pure subprogram read(internal,*) ptr end subroutine + subroutine test3(objp, procp) + real, intent(in), pointer :: objp + procedure(sin), pointer, intent(in) :: procp + !CHECK: error: Actual argument associated with INTENT(IN OUT) dummy argument 'op=' is not definable + !CHECK: because: 'objp' is an INTENT(IN) dummy argument + call test3a(objp) + !CHECK: error: Actual argument associated with procedure pointer dummy argument 'pp=' may not be INTENT(IN) + call test3b(procp) + end subroutine + subroutine test3a(op) + real, intent(in out), pointer :: op + end subroutine + subroutine test3b(pp) + procedure(sin), pointer, intent(in out) :: pp + end subroutine end module