Index: flang/lib/Semantics/check-call.cpp =================================================================== --- flang/lib/Semantics/check-call.cpp +++ flang/lib/Semantics/check-call.cpp @@ -391,22 +391,25 @@ } // Definability - const char *reason{nullptr}; - 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; - if (isElemental || dummyIsValue) { // 15.5.2.4(21) - flags.set(DefinabilityFlag::VectorSubscriptIsOk); - } - 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, - reason, dummyName)}) { - msg->Attach(std::move(*whyNot)); + if (scope) { + const char *reason{nullptr}; + // Problems with polymorphism are caught in the callee's definition. + DefinabilityFlags flags{DefinabilityFlag::PolymorphicOkInPure}; + if (dummy.intent == common::Intent::Out) { + reason = "INTENT(OUT)"; + } else if (dummy.intent == common::Intent::InOut) { + reason = "INTENT(IN OUT)"; + } + if (reason) { + if (isElemental || dummyIsValue) { // 15.5.2.4(21) + flags.set(DefinabilityFlag::VectorSubscriptIsOk); + } + 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, + reason, dummyName)}) { + msg->Attach(std::move(*whyNot)); + } } } } Index: flang/lib/Semantics/definable.h =================================================================== --- flang/lib/Semantics/definable.h +++ flang/lib/Semantics/definable.h @@ -27,7 +27,8 @@ ENUM_CLASS(DefinabilityFlag, VectorSubscriptIsOk, // a vector subscript may appear (i.e., assignment) - PointerDefinition) // a pointer is being defined, not its target + PointerDefinition, // a pointer is being defined, not its target + PolymorphicOkInPure) // don't check for polymorphic type in pure subprogram using DefinabilityFlags = common::EnumSet; Index: flang/lib/Semantics/definable.cpp =================================================================== --- flang/lib/Semantics/definable.cpp +++ flang/lib/Semantics/definable.cpp @@ -149,7 +149,8 @@ "'%s' is an entity with either an EVENT_TYPE or LOCK_TYPE"_en_US, original); } - if (FindPureProcedureContaining(scope)) { + if (!flags.test(DefinabilityFlag::PolymorphicOkInPure) && + FindPureProcedureContaining(scope)) { if (auto dyType{evaluate::DynamicType::From(ultimate)}) { if (dyType->IsPolymorphic()) { // C1596 return BlameSymbol(at, Index: flang/test/Semantics/call28.f90 =================================================================== --- /dev/null +++ flang/test/Semantics/call28.f90 @@ -0,0 +1,22 @@ +! RUN: %python %S/test_errors.py %s %flang_fc1 + +module m1 + type :: t + end type + contains + pure subroutine s1(x) + class(t), intent(in out) :: x + call s2(x) + call s3(x) + end subroutine + pure subroutine s2(x) + class(t), intent(in out) :: x + !ERROR: Left-hand side of assignment is not definable + !BECAUSE: 'x' is polymorphic in a pure subprogram + x = t() + end subroutine + pure subroutine s3(x) + !ERROR: An INTENT(OUT) dummy argument of a pure subroutine may not be polymorphic + class(t), intent(out) :: x + end subroutine +end module