[flang-commits] [flang] [flang] Allow LOCK_TYPE & al. to associate with INTENT(IN OUT) (PR #121413)

[Peter Klausler via flang-commits]

https://github.com/klausler created https://github.com/llvm/llvm-project/pull/121413

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.

>From 164f94fd66490fe3a714c2292c703aa9d74062bf Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
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/check-call.cpp   | 11 ++++++-----
 flang/lib/Semantics/definable.cpp    |  3 ++-
 flang/lib/Semantics/definable.h      |  3 ++-
 flang/test/Semantics/definable01.f90 | 11 +++++++++++
 4 files changed, 21 insertions(+), 7 deletions(-)

diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index 597c280a6df8bc..8631789b9f5263 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<parser::MessageFixedText> 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 88f9463e35c787..6d0155c24c31ab 100644
--- a/flang/lib/Semantics/definable.cpp
+++ b/flang/lib/Semantics/definable.cpp
@@ -204,7 +204,8 @@ static std::optional<parser::Message> 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 709bbba494d10d..902702dbccbf33 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<DefinabilityFlag, DefinabilityFlag_enumSize>;
diff --git a/flang/test/Semantics/definable01.f90 b/flang/test/Semantics/definable01.f90
index ff71b419fa9713..74dc34c3e343bf 100644
--- a/flang/test/Semantics/definable01.f90
+++ b/flang/test/Semantics/definable01.f90
@@ -113,3 +113,14 @@ pure subroutine test7(lp)
     lp%next%next => null()
   end
 end module
+program main
+  use iso_fortran_env, only: lock_type
+  type(lock_type) lock
+  interface
+    subroutine inoutlock(lock)
+      import lock_type
+      type(lock_type), intent(in out) :: lock
+    end
+  end interface
+  call inoutlock(lock) ! ok
+end