From 8d74e8846b90a0ab16fa523381974420735a7b59 Mon Sep 17 00:00:00 2001 From: Peter Klausler Date: Tue, 31 Dec 2024 11:52:33 -0800 Subject: [PATCH] [flang] Allow LOCK_TYPE & al. to associate with INTENT(IN OUT) We're emitting a bogus semantic error message about an actual argument being undefinable when associating LOCK_TYPE, EVENT_TYPE, and someday NOTIFY_TYPE with an INTENT(IN OUT) dummy argument. These types indeed make many definition contexts invalid, and the actual argument associated with an INTENT(IN OUT) dummy argument must indeed be definable, but the argument association itself is not a problem. --- flang/lib/Semantics/assignment.cpp | 13 ++++++++----- flang/lib/Semantics/check-call.cpp | 11 ++++++----- flang/lib/Semantics/definable.cpp | 3 ++- flang/lib/Semantics/definable.h | 3 ++- flang/test/Semantics/definable01.f90 | 26 ++++++++++++++++++++++++-- 5 files changed, 42 insertions(+), 14 deletions(-) diff --git a/flang/lib/Semantics/assignment.cpp b/flang/lib/Semantics/assignment.cpp index e69a73c7837ce..0b57197fb8db8 100644 --- a/flang/lib/Semantics/assignment.cpp +++ b/flang/lib/Semantics/assignment.cpp @@ -66,8 +66,13 @@ void AssignmentContext::Analyze(const parser::AssignmentStmt &stmt) { const SomeExpr &rhs{assignment->rhs}; auto lhsLoc{std::get(stmt.t).GetSource()}; const Scope &scope{context_.FindScope(lhsLoc)}; - if (auto whyNot{WhyNotDefinable(lhsLoc, scope, - DefinabilityFlags{DefinabilityFlag::VectorSubscriptIsOk}, lhs)}) { + DefinabilityFlags flags{DefinabilityFlag::VectorSubscriptIsOk}; + bool isDefinedAssignment{ + std::holds_alternative(assignment->u)}; + if (isDefinedAssignment) { + flags.set(DefinabilityFlag::AllowEventLockOrNotifyType); + } + if (auto whyNot{WhyNotDefinable(lhsLoc, scope, flags, lhs)}) { if (whyNot->IsFatal()) { if (auto *msg{Say(lhsLoc, "Left-hand side of assignment is not definable"_err_en_US)}) { @@ -79,9 +84,7 @@ void AssignmentContext::Analyze(const parser::AssignmentStmt &stmt) { } } auto rhsLoc{std::get(stmt.t).source}; - if (std::holds_alternative(assignment->u)) { - // it's a defined ASSIGNMENT(=) - } else { + if (!isDefinedAssignment) { CheckForPureContext(rhs, rhsLoc); } if (whereDepth_ > 0) { diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp index 597c280a6df8b..8631789b9f526 100644 --- a/flang/lib/Semantics/check-call.cpp +++ b/flang/lib/Semantics/check-call.cpp @@ -703,12 +703,14 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy, // Problems with polymorphism are caught in the callee's definition. if (scope) { std::optional undefinableMessage; - if (dummy.intent == common::Intent::Out) { - undefinableMessage = - "Actual argument associated with INTENT(OUT) %s is not definable"_err_en_US; - } else if (dummy.intent == common::Intent::InOut) { + DefinabilityFlags flags{DefinabilityFlag::PolymorphicOkInPure}; + if (dummy.intent == common::Intent::InOut) { + flags.set(DefinabilityFlag::AllowEventLockOrNotifyType); undefinableMessage = "Actual argument associated with INTENT(IN OUT) %s is not definable"_err_en_US; + } else if (dummy.intent == common::Intent::Out) { + undefinableMessage = + "Actual argument associated with INTENT(OUT) %s is not definable"_err_en_US; } else if (context.ShouldWarn(common::LanguageFeature:: UndefinableAsynchronousOrVolatileActual)) { if (dummy.attrs.test( @@ -722,7 +724,6 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy, } } if (undefinableMessage) { - DefinabilityFlags flags{DefinabilityFlag::PolymorphicOkInPure}; if (isElemental) { // 15.5.2.4(21) flags.set(DefinabilityFlag::VectorSubscriptIsOk); } diff --git a/flang/lib/Semantics/definable.cpp b/flang/lib/Semantics/definable.cpp index 88f9463e35c78..6d0155c24c31a 100644 --- a/flang/lib/Semantics/definable.cpp +++ b/flang/lib/Semantics/definable.cpp @@ -204,7 +204,8 @@ static std::optional WhyNotDefinableLast(parser::CharBlock at, } return std::nullopt; // pointer assignment - skip following checks } - if (IsOrContainsEventOrLockComponent(ultimate)) { + if (!flags.test(DefinabilityFlag::AllowEventLockOrNotifyType) && + IsOrContainsEventOrLockComponent(ultimate)) { return BlameSymbol(at, "'%s' is an entity with either an EVENT_TYPE or LOCK_TYPE"_en_US, original); diff --git a/flang/lib/Semantics/definable.h b/flang/lib/Semantics/definable.h index 709bbba494d10..902702dbccbf3 100644 --- a/flang/lib/Semantics/definable.h +++ b/flang/lib/Semantics/definable.h @@ -32,7 +32,8 @@ ENUM_CLASS(DefinabilityFlag, AcceptAllocatable, // treat allocatable as if it were a pointer SourcedAllocation, // ALLOCATE(a,SOURCE=) PolymorphicOkInPure, // don't check for polymorphic type in pure subprogram - DoNotNoteDefinition) // context does not imply definition + DoNotNoteDefinition, // context does not imply definition + AllowEventLockOrNotifyType) using DefinabilityFlags = common::EnumSet; diff --git a/flang/test/Semantics/definable01.f90 b/flang/test/Semantics/definable01.f90 index ff71b419fa971..d3b31ee38b2a3 100644 --- a/flang/test/Semantics/definable01.f90 +++ b/flang/test/Semantics/definable01.f90 @@ -109,7 +109,29 @@ pure function test6(lp) end pure subroutine test7(lp) type(list), pointer :: lp - !CHECK-NOT: error: - lp%next%next => null() + lp%next%next => null() ! ok end end module +program main + use iso_fortran_env, only: lock_type + type(lock_type) lock + interface + subroutine inlock(lock) + import lock_type + type(lock_type), intent(in) :: lock + end + subroutine outlock(lock) + import lock_type + !CHECK: error: An INTENT(OUT) dummy argument may not be, or contain, EVENT_TYPE or LOCK_TYPE + type(lock_type), intent(out) :: lock + end + subroutine inoutlock(lock) + import lock_type + type(lock_type), intent(in out) :: lock + end + end interface + call inlock(lock) ! ok + call inoutlock(lock) ! ok + !CHECK: error: Actual argument associated with INTENT(OUT) dummy argument 'lock=' is not definable + call outlock(lock) +end