[flang-commits] [flang] [flang] Correct definability checking for INTENT(IN) pointers (PR #74158)

[Peter Klausler via flang-commits]

https://github.com/klausler updated https://github.com/llvm/llvm-project/pull/74158

>From 0539350354b5fd8d2d30c1efd8b4c7d544dfa1c9 Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Fri, 1 Dec 2023 15:29:52 -0800
Subject: [PATCH] [flang] Correct definability checking for INTENT(IN) pointers

An INTENT(IN) attribute on a pointer dummy argument prevents
modification of the pointer itself only, not modification of
any component of its target.  Fix this case without breaking
definability checking for pointer components of non-pointer
INTENT(IN) dummy arguments.
---
 flang/lib/Semantics/definable.cpp    | 23 +++++++++++++++++------
 flang/runtime/unit.cpp               |  9 +++++----
 flang/test/Semantics/definable01.f90 | 15 +++++++++++++++
 3 files changed, 37 insertions(+), 10 deletions(-)

diff --git a/flang/lib/Semantics/definable.cpp b/flang/lib/Semantics/definable.cpp
index d5ffcabc7233c..b73290109248a 100644
--- a/flang/lib/Semantics/definable.cpp
+++ b/flang/lib/Semantics/definable.cpp
@@ -89,7 +89,8 @@ static const Symbol &GetRelevantSymbol(const evaluate::DataRef &dataRef,
 
 // Check the leftmost (or only) symbol from a data-ref or expression.
 static std::optional<parser::Message> WhyNotDefinableBase(parser::CharBlock at,
-    const Scope &scope, DefinabilityFlags flags, const Symbol &original) {
+    const Scope &scope, DefinabilityFlags flags, const Symbol &original,
+    bool isWholeSymbol) {
   const Symbol &ultimate{original.GetUltimate()};
   bool isPointerDefinition{flags.test(DefinabilityFlag::PointerDefinition)};
   bool acceptAllocatable{flags.test(DefinabilityFlag::AcceptAllocatable)};
@@ -104,7 +105,8 @@ static std::optional<parser::Message> WhyNotDefinableBase(parser::CharBlock at,
     } else if (auto dataRef{evaluate::ExtractDataRef(
                    *association->expr(), true, true)}) {
       return WhyNotDefinableBase(at, scope, flags,
-          GetRelevantSymbol(*dataRef, isPointerDefinition, acceptAllocatable));
+          GetRelevantSymbol(*dataRef, isPointerDefinition, acceptAllocatable),
+          isWholeSymbol);
     }
   }
   if (isTargetDefinition) {
@@ -112,7 +114,8 @@ static std::optional<parser::Message> WhyNotDefinableBase(parser::CharBlock at,
     return BlameSymbol(at, "'%s' is not a variable"_en_US, original);
   } else if (IsProtected(ultimate) && IsUseAssociated(original, scope)) {
     return BlameSymbol(at, "'%s' is protected in this scope"_en_US, original);
-  } else if (IsIntentIn(ultimate)) {
+  } else if (IsIntentIn(ultimate) &&
+      (!IsPointer(ultimate) || (isWholeSymbol && isPointerDefinition))) {
     return BlameSymbol(
         at, "'%s' is an INTENT(IN) dummy argument"_en_US, original);
   }
@@ -165,6 +168,12 @@ static std::optional<parser::Message> WhyNotDefinableBase(parser::CharBlock at,
 static std::optional<parser::Message> WhyNotDefinableLast(parser::CharBlock at,
     const Scope &scope, DefinabilityFlags flags, const Symbol &original) {
   const Symbol &ultimate{original.GetUltimate()};
+  if (const auto *association{ultimate.detailsIf<AssocEntityDetails>()}) {
+    if (auto dataRef{
+            evaluate::ExtractDataRef(*association->expr(), true, true)}) {
+      return WhyNotDefinableLast(at, scope, flags, dataRef->GetLastSymbol());
+    }
+  }
   if (flags.test(DefinabilityFlag::PointerDefinition)) {
     if (flags.test(DefinabilityFlag::AcceptAllocatable)) {
       if (!IsAllocatableOrObjectPointer(&ultimate)) {
@@ -216,7 +225,8 @@ static std::optional<parser::Message> WhyNotDefinable(parser::CharBlock at,
   const Symbol &base{GetRelevantSymbol(dataRef,
       flags.test(DefinabilityFlag::PointerDefinition),
       flags.test(DefinabilityFlag::AcceptAllocatable))};
-  if (auto whyNot{WhyNotDefinableBase(at, scope, flags, base)}) {
+  if (auto whyNot{WhyNotDefinableBase(at, scope, flags, base,
+          std::holds_alternative<evaluate::SymbolRef>(dataRef.u))}) {
     return whyNot;
   } else {
     return WhyNotDefinableLast(at, scope, flags, dataRef.GetLastSymbol());
@@ -231,12 +241,13 @@ static std::optional<parser::Message> WhyNotDefinable(parser::CharBlock at,
   const Symbol &base{GetRelevantSymbol(dataRef, false, false)};
   DefinabilityFlags baseFlags{flags};
   baseFlags.reset(DefinabilityFlag::PointerDefinition);
-  return WhyNotDefinableBase(at, scope, baseFlags, base);
+  return WhyNotDefinableBase(at, scope, baseFlags, base,
+      std::holds_alternative<evaluate::SymbolRef>(dataRef.u));
 }
 
 std::optional<parser::Message> WhyNotDefinable(parser::CharBlock at,
     const Scope &scope, DefinabilityFlags flags, const Symbol &original) {
-  if (auto base{WhyNotDefinableBase(at, scope, flags, original)}) {
+  if (auto base{WhyNotDefinableBase(at, scope, flags, original, true)}) {
     return base;
   }
   return WhyNotDefinableLast(at, scope, flags, original);
diff --git a/flang/runtime/unit.cpp b/flang/runtime/unit.cpp
index 5fa8565c2f61f..212fc70d5eaad 100644
--- a/flang/runtime/unit.cpp
+++ b/flang/runtime/unit.cpp
@@ -896,10 +896,11 @@ void ExternalFileUnit::BackspaceVariableFormattedRecord(
 }
 
 void ExternalFileUnit::DoImpliedEndfile(IoErrorHandler &handler) {
-  if (!impliedEndfile_ && direction_ == Direction::Output && IsRecordFile() &&
-      access != Access::Direct && leftTabLimit) {
-    // Complete partial record after non-advancing write before
-    // positioning or closing the unit.  Usually sets impliedEndfile_.
+  if (!impliedEndfile_ && direction_ == Direction::Output &&
+      access == Access::Sequential && leftTabLimit) {
+    // Complete partial record on a sequential (not direct or stream) unit
+    // after non-advancing write before positioning or closing the unit.
+    // Usually sets impliedEndfile_.
     AdvanceRecord(handler);
   }
   if (impliedEndfile_) {
diff --git a/flang/test/Semantics/definable01.f90 b/flang/test/Semantics/definable01.f90
index fff493fe7a415..c0f10668fb480 100644
--- a/flang/test/Semantics/definable01.f90
+++ b/flang/test/Semantics/definable01.f90
@@ -82,4 +82,19 @@ subroutine test3a(op)
   subroutine test3b(pp)
     procedure(sin), pointer, intent(in out) :: pp
   end subroutine
+  subroutine test4(p)
+    type(ptype), pointer, intent(in) :: p
+    p%x = 1.
+    p%ptr = 1. ! ok
+    nullify(p%ptr) ! ok
+    !CHECK: error: 'p' may not appear in NULLIFY
+    !CHECK: because: 'p' is an INTENT(IN) dummy argument
+    nullify(p)
+  end
+  subroutine test5(np)
+    type(ptype), intent(in) :: np
+    !CHECK: error: 'ptr' may not appear in NULLIFY
+    !CHECK: because: 'np' is an INTENT(IN) dummy argument
+    nullify(np%ptr)
+  end
 end module