[flang-commits] [flang] [Flang] add support for collapsed io calls for implicit do loops (PR #212646)

Jason Van Beusekom via flang-commits flang-commits at lists.llvm.org
Tue Sep 15 09:49:36 PDT 2026


https://github.com/Jason-Van-Beusekom updated https://github.com/llvm/llvm-project/pull/212646

>From 20be5663f88bf9648a7bd106c70e4fbbc3a2afa1 Mon Sep 17 00:00:00 2001
From: Jason-Van-Beusekom <jason.van-beusekom at hpe.com>
Date: Tue, 28 Jul 2026 17:18:07 -0500
Subject: [PATCH 1/6] [Flang] add support for collapsed io calls for implicit
 do loops

---
 flang/lib/Lower/IO.cpp                      | 287 ++++++++++++++++++++
 flang/test/Lower/io-implied-do-collapse.f90 | 236 ++++++++++++++++
 2 files changed, 523 insertions(+)
 create mode 100644 flang/test/Lower/io-implied-do-collapse.f90

diff --git a/flang/lib/Lower/IO.cpp b/flang/lib/Lower/IO.cpp
index 490db8cc1d1ba..9782968553544 100644
--- a/flang/lib/Lower/IO.cpp
+++ b/flang/lib/Lower/IO.cpp
@@ -701,6 +701,244 @@ static mlir::func::FuncOp getOutputFunc(mlir::Location loc,
                                                                    builder);
 }
 
+/// Return the evaluate expression of a non-implied-do io item, or nullptr if
+/// the item is itself an io-implied-do.
+static const Fortran::lower::SomeExpr *
+getIoItemLeafExpr(const Fortran::parser::OutputItem &item) {
+  if (const auto *parserExpr = std::get_if<Fortran::parser::Expr>(&item.u))
+    return Fortran::semantics::GetExpr(*parserExpr);
+  return nullptr;
+}
+static const Fortran::lower::SomeExpr *
+getIoItemLeafExpr(const Fortran::parser::InputItem &item) {
+  if (const auto *var = std::get_if<Fortran::parser::Variable>(&item.u))
+    return Fortran::semantics::GetExpr(*var);
+  return nullptr;
+}
+
+template <typename A>
+static bool ioExprReferencesSymbol(const A &expr,
+                                   const Fortran::semantics::Symbol &sym) {
+  const Fortran::semantics::Symbol &ultimate = sym.GetUltimate();
+  for (const Fortran::semantics::SymbolRef &ref :
+       Fortran::evaluate::CollectSymbols(expr)) {
+    if (&ref->GetUltimate() == &ultimate)
+      return true;
+  }
+  return false;
+}
+
+template <typename A>
+static bool ioExprReferencesVolatile(const A &expr) {
+  for (const Fortran::semantics::SymbolRef &ref :
+       Fortran::evaluate::CollectSymbols(expr))
+    if (ref->GetUltimate().attrs().test(Fortran::semantics::Attr::VOLATILE))
+      return true;
+  return false;
+}
+
+namespace {
+struct CollapsedImpliedDo {
+  Fortran::lower::SomeExpr section;
+  const Fortran::semantics::Symbol *loopSym;
+  Fortran::lower::SomeExpr loopLowerValue;
+  Fortran::lower::SomeExpr loopStepValue;
+};
+} // namespace
+
+/// Try to recognize a (single-level) io-implied-do as an equivalent contiguous
+/// array section. Returns the section expression on success, std::nullopt
+/// otherwise
+template <typename ImpliedDo>
+static std::optional<CollapsedImpliedDo>
+matchContiguousImpliedDo(Fortran::lower::AbstractConverter &converter,
+                         const ImpliedDo &impliedDo, bool isInput) {
+
+  // Only collapse a single body item
+  const auto &items = std::get<0>(impliedDo.t);
+  if (items.size() != 1)
+    return std::nullopt;
+
+  const Fortran::lower::SomeExpr *leaf = getIoItemLeafExpr(items.front());
+  if (!leaf)
+    return std::nullopt;
+
+  const Fortran::parser::IoImpliedDoControl &control = std::get<1>(impliedDo.t);
+  const Fortran::semantics::Symbol *loopSym =
+      Fortran::parser::UnwrapRef<Fortran::parser::Name>(control.Name()).symbol;
+  if (!loopSym)
+    return std::nullopt;
+
+  std::optional<Fortran::evaluate::DataRef> dataRef =
+      Fortran::evaluate::ExtractDataRef(*leaf);
+  if (!dataRef)
+    return std::nullopt;
+
+  const auto *arrayRef = std::get_if<Fortran::evaluate::ArrayRef>(&dataRef->u);
+  if (!arrayRef || !arrayRef->base().IsSymbol())
+    return std::nullopt;
+
+  const Fortran::lower::SomeExpr *lowerExpr =
+      Fortran::semantics::GetExpr(control.Lower());
+  const Fortran::lower::SomeExpr *upperExpr =
+      Fortran::semantics::GetExpr(control.Upper());
+  const Fortran::lower::SomeExpr *stepExpr =
+      control.Step() ? Fortran::semantics::GetExpr(*control.Step()) : nullptr;
+  if (!lowerExpr || !upperExpr || (control.Step() && !stepExpr))
+    return std::nullopt;
+
+  if (ioExprReferencesSymbol(*lowerExpr, *loopSym) ||
+      ioExprReferencesSymbol(*upperExpr, *loopSym) ||
+      (stepExpr && ioExprReferencesSymbol(*stepExpr, *loopSym)))
+    return std::nullopt;
+
+  Fortran::evaluate::FoldingContext &foldingContext =
+      converter.getFoldingContext();
+  if (Fortran::evaluate::FindImpureCall(foldingContext, *lowerExpr) ||
+      Fortran::evaluate::FindImpureCall(foldingContext, *upperExpr) ||
+      (stepExpr &&
+       Fortran::evaluate::FindImpureCall(foldingContext, *stepExpr)))
+    return std::nullopt;
+
+  if (ioExprReferencesVolatile(*lowerExpr) ||
+      ioExprReferencesVolatile(*upperExpr) ||
+      (stepExpr && ioExprReferencesVolatile(*stepExpr)))
+    return std::nullopt;
+
+  // The io-implied-do bounds and index are scalar integer expressions
+  // (enforced by semantics), so each narrows to Expr<SomeInteger>
+  auto toSubscript = [](const Fortran::lower::SomeExpr &expr) {
+    return Fortran::evaluate::ConvertToType<
+        Fortran::evaluate::SubscriptInteger>(
+        Fortran::evaluate::Expr<Fortran::evaluate::SomeInteger>{
+            DEREF(Fortran::evaluate::UnwrapExpr<
+                  Fortran::evaluate::Expr<Fortran::evaluate::SomeInteger>>(
+                expr))});
+  };
+  Fortran::evaluate::Expr<Fortran::evaluate::SubscriptInteger> lowerSub =
+      toSubscript(*lowerExpr);
+  Fortran::evaluate::Expr<Fortran::evaluate::SubscriptInteger> upperSub =
+      toSubscript(*upperExpr);
+  std::optional<Fortran::evaluate::Expr<Fortran::evaluate::SubscriptInteger>>
+      stepSub;
+  if (stepExpr)
+    stepSub = toSubscript(*stepExpr);
+  // Retain the lower bound and step so the loop variable's final value can be
+  // rebuilt later as `lower + tripCount * step`.
+  Fortran::lower::SomeExpr loopLowerValue =
+      Fortran::evaluate::AsGenericExpr(Fortran::evaluate::ExtentExpr{lowerSub});
+  Fortran::lower::SomeExpr loopStepValue = Fortran::evaluate::AsGenericExpr(
+      stepSub ? Fortran::evaluate::ExtentExpr{*stepSub}
+              : Fortran::evaluate::ExtentExpr{1});
+
+  Fortran::evaluate::Expr<Fortran::evaluate::SubscriptInteger> loopSubExpr =
+      toSubscript(Fortran::evaluate::AsGenericExpr(*loopSym).value());
+
+  std::vector<Fortran::evaluate::Subscript> newSubscripts;
+  newSubscripts.reserve(arrayRef->subscript().size());
+  bool foundLoopSubscript = false;
+  for (const Fortran::evaluate::Subscript &sub : arrayRef->subscript()) {
+    const auto *scalar =
+        std::get_if<Fortran::evaluate::IndirectSubscriptIntegerExpr>(&sub.u);
+    if (!scalar)
+      return std::nullopt; // already a triplet/vector subscript
+
+    const Fortran::evaluate::Expr<Fortran::evaluate::SubscriptInteger>
+        &subExpr = scalar->value();
+    if (subExpr == loopSubExpr) {
+      if (foundLoopSubscript)
+        return std::nullopt; // loop variable used in more than one subscript
+      foundLoopSubscript = true;
+      newSubscripts.emplace_back(
+          Fortran::evaluate::Subscript{Fortran::evaluate::Triplet{
+              std::optional<
+                  Fortran::evaluate::Expr<Fortran::evaluate::SubscriptInteger>>{
+                  lowerSub},
+              std::optional<
+                  Fortran::evaluate::Expr<Fortran::evaluate::SubscriptInteger>>{
+                  upperSub},
+              std::move(stepSub)}});
+    } else {
+      // Every other subscript must be a loop-invariant scalar. It is evaluated
+      // once for the collapsed section instead of once per iteration, so it
+      // must not reference the loop variable and must be safe to evaluate a
+      // different number of times (i.e. free of impure function references).
+      if (subExpr.Rank() != 0 || ioExprReferencesSymbol(subExpr, *loopSym))
+        return std::nullopt;
+
+      if (Fortran::evaluate::FindImpureCall(
+              foldingContext,
+              Fortran::evaluate::AsGenericExpr(
+                  Fortran::evaluate::Expr<Fortran::evaluate::SubscriptInteger>{
+                      subExpr})))
+        return std::nullopt;
+
+      if (ioExprReferencesVolatile(subExpr))
+        return std::nullopt;
+
+      // For input, a retained subscript is re-evaluated on every iteration of
+      // the equivalent loop
+      if (isInput &&
+          ioExprReferencesSymbol(subExpr, arrayRef->base().GetLastSymbol()))
+        return std::nullopt;
+
+      newSubscripts.push_back(sub);
+    }
+  }
+  if (!foundLoopSubscript)
+    return std::nullopt;
+
+  Fortran::evaluate::ArrayRef sectionRef{arrayRef->base().GetLastSymbol(),
+                                         std::move(newSubscripts)};
+  Fortran::lower::SomeExpr section =
+      Fortran::evaluate::AsGenericExpr(
+          Fortran::evaluate::DataRef{std::move(sectionRef)})
+          .value();
+
+  return CollapsedImpliedDo{std::move(section), loopSym,
+                            std::move(loopLowerValue),
+                            std::move(loopStepValue)};
+}
+
+/// Store into the io-implied-do variable the value it would hold after a normal
+/// loop
+static void
+genImpliedDoLoopVarFinalValue(Fortran::lower::AbstractConverter &converter,
+                              const CollapsedImpliedDo &collapsed,
+                              mlir::Value sectionBox,
+                              Fortran::lower::StatementContext &stmtCtx) {
+  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+  mlir::Location loc = converter.getCurrentLocation();
+  mlir::Type idxTy = builder.getIndexType();
+  // The collapsed section is rank one and its extent is exactly the loop trip
+  // count, so reuse it rather than recomputing the count from the bounds.
+  mlir::Value zero = builder.createIntegerConstant(loc, idxTy, 0);
+  auto dims = fir::BoxDimsOp::create(builder, loc, idxTy, idxTy, idxTy,
+                                     sectionBox, zero);
+  mlir::Value tripCount = dims.getResult(1);
+  mlir::Value lower = builder.createConvert(
+      loc, idxTy,
+      fir::getBase(converter.genExprValue(collapsed.loopLowerValue, stmtCtx)));
+  mlir::Value step = builder.createConvert(
+      loc, idxTy,
+      fir::getBase(converter.genExprValue(collapsed.loopStepValue, stmtCtx)));
+  mlir::Value finalValue = mlir::arith::AddIOp::create(
+      builder, loc, lower,
+      mlir::arith::MulIOp::create(builder, loc, tripCount, step));
+  mlir::Value loopVar = fir::getBase(converter.genExprAddr(
+      Fortran::evaluate::AsGenericExpr(*collapsed.loopSym).value(), stmtCtx));
+  mlir::Value stored = builder.createConvert(
+      loc, fir::unwrapRefType(loopVar.getType()), finalValue);
+  fir::StoreOp::create(builder, loc, stored, loopVar);
+}
+
+template <bool isInput, typename ImpliedDo>
+static bool
+tryCollapseContiguousImpliedDo(Fortran::lower::AbstractConverter &converter,
+                               mlir::Value cookie, const ImpliedDo &impliedDo,
+                               bool isFormatted, bool checkResult,
+                               mlir::Value &ok);
+
 /// Generate a sequence of output data transfer calls.
 static void genOutputItemList(
     Fortran::lower::AbstractConverter &converter, mlir::Value cookie,
@@ -709,6 +947,10 @@ static void genOutputItemList(
   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
   for (const Fortran::parser::OutputItem &item : items) {
     if (const auto &impliedDo = std::get_if<1>(&item.u)) {
+      if (tryCollapseContiguousImpliedDo</*isInput=*/false>(
+              converter, cookie, impliedDo->value(), isFormatted, checkResult,
+              ok))
+        continue;
       genIoLoop(converter, cookie, impliedDo->value(), isFormatted, checkResult,
                 ok, inLoop);
       continue;
@@ -872,6 +1114,46 @@ createIoRuntimeCallForItem(Fortran::lower::AbstractConverter &converter,
   return call.getResult(0);
 }
 
+template <bool isInput, typename ImpliedDo>
+static bool
+tryCollapseContiguousImpliedDo(Fortran::lower::AbstractConverter &converter,
+                               mlir::Value cookie, const ImpliedDo &impliedDo,
+                               bool isFormatted, bool checkResult,
+                               mlir::Value &ok) {
+  if (isFormatted || checkResult)
+    return false;
+  std::optional<CollapsedImpliedDo> collapsed =
+      matchContiguousImpliedDo(converter, impliedDo, isInput);
+  if (!collapsed)
+    return false;
+  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+  mlir::Location loc = converter.getCurrentLocation();
+  Fortran::lower::StatementContext stmtCtx;
+  mlir::Type itemTy = converter.genType(collapsed->section);
+  if constexpr (isInput) {
+    mlir::func::FuncOp inputFunc =
+        getInputFunc(loc, builder, itemTy, /*isFormatted=*/false);
+    fir::ExtendedValue itemExv =
+        converter.genExprBox(loc, collapsed->section, stmtCtx);
+    genImpliedDoLoopVarFinalValue(converter, *collapsed, fir::getBase(itemExv),
+                                  stmtCtx);
+    ok = createIoRuntimeCallForItem(converter, loc, inputFunc, cookie, itemExv);
+  } else {
+    mlir::func::FuncOp outputFunc =
+        getOutputFunc(loc, builder, itemTy, /*isFormatted=*/false);
+    mlir::Type argType = outputFunc.getFunctionType().getInput(1);
+    mlir::Value box =
+        fir::getBase(converter.genExprBox(loc, collapsed->section, stmtCtx));
+    llvm::SmallVector<mlir::Value> args = {
+        cookie, builder.createConvertWithVolatileCast(loc, argType, box)};
+    if (containsDerivedType(itemTy))
+      args.push_back(getNonTbpDefinedIoTableAddr(converter));
+    ok = fir::CallOp::create(builder, loc, outputFunc, args).getResult(0);
+    genImpliedDoLoopVarFinalValue(converter, *collapsed, box, stmtCtx);
+  }
+  return true;
+}
+
 /// Generate a sequence of input data transfer calls.
 static void genInputItemList(Fortran::lower::AbstractConverter &converter,
                              mlir::Value cookie,
@@ -881,6 +1163,11 @@ static void genInputItemList(Fortran::lower::AbstractConverter &converter,
   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
   for (const Fortran::parser::InputItem &item : items) {
     if (const auto &impliedDo = std::get_if<1>(&item.u)) {
+      // Try to collapse into a single array-section descriptor call.
+      if (tryCollapseContiguousImpliedDo</*isInput=*/true>(
+              converter, cookie, impliedDo->value(), isFormatted, checkResult,
+              ok))
+        continue;
       genIoLoop(converter, cookie, impliedDo->value(), isFormatted, checkResult,
                 ok, inLoop);
       continue;
diff --git a/flang/test/Lower/io-implied-do-collapse.f90 b/flang/test/Lower/io-implied-do-collapse.f90
new file mode 100644
index 0000000000000..28cb00714e441
--- /dev/null
+++ b/flang/test/Lower/io-implied-do-collapse.f90
@@ -0,0 +1,236 @@
+! RUN: %flang_fc1 -emit-hlfir %s -o - | FileCheck %s
+
+module impure_mod
+contains
+  pure integer function pure_bound(k)
+    integer, intent(in) :: k
+    pure_bound = k
+  end function
+  integer function impure_bound(k)
+    integer, intent(in) :: k
+    impure_bound = k
+  end function
+end module
+
+! CHECK-LABEL: func @_QPwrite_whole(
+subroutine write_whole(a, n)
+  integer :: n
+  real :: a(n)
+  ! CHECK: %[[SEC:.*]] = hlfir.designate %{{.*}} (%{{.*}}:%{{.*}}:%{{.*}})  shape %{{.*}} : (!fir.box<!fir.array<?xf32>>, index, index, index, !fir.shape<1>) -> !fir.box<!fir.array<?xf32>>
+  ! CHECK: %[[BOX:.*]] = fir.convert %[[SEC]] : (!fir.box<!fir.array<?xf32>>) -> !fir.box<none>
+  ! CHECK: fir.call @_FortranAioOutputDescriptor(%{{.*}}, %[[BOX]])
+  ! CHECK-NOT: fir.call @_FortranAioOutputReal
+  ! CHECK-NOT: fir.do_loop
+  write(10) (a(i), i=1,n)
+end subroutine
+
+! CHECK-LABEL: func @_QPread_whole(
+subroutine read_whole(a, n)
+  integer :: n
+  real :: a(n)
+  ! CHECK: %[[SEC:.*]] = hlfir.designate %{{.*}} (%{{.*}}:%{{.*}}:%{{.*}})  shape %{{.*}} : (!fir.box<!fir.array<?xf32>>, index, index, index, !fir.shape<1>) -> !fir.box<!fir.array<?xf32>>
+  ! CHECK: %[[BOX:.*]] = fir.convert %[[SEC]] : (!fir.box<!fir.array<?xf32>>) -> !fir.box<none>
+  ! CHECK: fir.call @_FortranAioInputDescriptor(%{{.*}}, %[[BOX]])
+  ! CHECK-NOT: fir.call @_FortranAioInputReal
+  ! CHECK-NOT: fir.do_loop
+  read(10) (a(i), i=1,n)
+end subroutine
+
+! CHECK-LABEL: func @_QPwrite_finalval(
+subroutine write_finalval(a, n, k)
+  integer :: n, k
+  real :: a(n)
+  ! CHECK: %[[SEC:.*]] = hlfir.designate %{{.*}} (%{{.*}}:%{{.*}}:%{{.*}})  shape %{{.*}} : (!fir.box<!fir.array<?xf32>>, index, index, index, !fir.shape<1>) -> !fir.box<!fir.array<?xf32>>
+  ! CHECK: fir.call @_FortranAioOutputDescriptor
+  ! CHECK: %[[DIMS:.*]]:3 = fir.box_dims %[[SEC]], %{{.*}} : (!fir.box<!fir.array<?xf32>>, index) -> (index, index, index)
+  ! CHECK: %[[TS:.*]] = arith.muli %[[DIMS]]#1, %{{.*}} : index
+  ! CHECK: %[[FV:.*]] = arith.addi %{{.*}}, %[[TS]] : index
+  ! CHECK: %[[FVC:.*]] = fir.convert %[[FV]] : (index) -> i32
+  ! CHECK: fir.store %[[FVC]] to %{{.*}} : !fir.ref<i32>
+  write(10) (a(i), i=1,n)
+  k = i
+end subroutine
+
+! CHECK-LABEL: func @_QPwrite_fixed(
+subroutine write_fixed(b, n)
+  integer :: n
+  real :: b(5,n)
+  ! CHECK: hlfir.designate %{{.*}} (%{{.*}}, %{{.*}}:%{{.*}}:%{{.*}})  shape %{{.*}} : (!fir.box<!fir.array<5x?xf32>>, index, index, index, index, !fir.shape<1>) -> !fir.box<!fir.array<?xf32>>
+  ! CHECK: fir.call @_FortranAioOutputDescriptor
+  ! CHECK-NOT: fir.call @_FortranAioOutputReal
+  write(10) (b(3,i), i=1,n)
+end subroutine
+
+! CHECK-LABEL: func @_QPwrite_step_valid(
+subroutine write_step_valid(a, n)
+  integer :: n
+  real :: a(n)
+  ! CHECK: fir.call @_FortranAioOutputDescriptor
+  ! CHECK-NOT: fir.call @_FortranAioOutputReal
+  ! CHECK-NOT: fir.do_loop
+  write(10) (a(i), i=1,n,2)
+end subroutine
+
+! CHECK-LABEL: func @_QPwrite_pure_bound(
+subroutine write_pure_bound(a, n)
+  use impure_mod
+  integer :: n
+  real :: a(n)
+  ! CHECK: fir.call @_FortranAioOutputDescriptor
+  ! CHECK-NOT: fir.call @_FortranAioOutputReal
+  ! CHECK-NOT: fir.do_loop
+  write(10) (a(i), i=1,pure_bound(n))
+end subroutine
+
+! CHECK-LABEL: func @_QPwrite_alias_subscript(
+subroutine write_alias_subscript(b, n)
+  integer :: n
+  integer :: b(10, n)
+  ! CHECK: hlfir.designate %{{.*}} (%{{.*}}, %{{.*}}:%{{.*}}:%{{.*}})  shape %{{.*}} : (!fir.box<!fir.array<10x?xi32>>, i64, index, index, index, !fir.shape<1>) -> !fir.box<!fir.array<?xi32>>
+  ! CHECK: fir.call @_FortranAioOutputDescriptor
+  ! CHECK-NOT: fir.do_loop
+  write(10) (b(b(1,1), i), i=1,n)
+end subroutine
+
+! ===========================================================================
+! The cases below are NOT collapsed and fall back to a per-element loop.
+! ===========================================================================
+
+! Formatted transfer needs per-element edit  descriptors.
+! CHECK-LABEL: func @_QPwrite_formatted(
+subroutine write_formatted(a, n)
+  integer :: n
+  real :: a(n)
+  ! CHECK: fir.do_loop
+  ! CHECK: fir.call @_FortranAioOutputReal
+  write(10,*) (a(i), i=1,n)
+end subroutine
+
+! Condition specifier (IOSTAT=) needs per-iteration error handling.
+! CHECK-LABEL: func @_QPwrite_iostat(
+subroutine write_iostat(a, n, ios)
+  integer :: n, ios
+  real :: a(n)
+  ! CHECK: fir.iterate_while
+  ! A per-element scalar embox inside the loop confirms this was not collapsed;
+  ! a collapsed transfer would designate a whole array section instead.
+  ! CHECK: fir.embox %{{.*}} : (!fir.ref<f32>) -> !fir.box<f32>
+  ! CHECK: fir.call @_FortranAioOutputDescriptor
+  write(10, iostat=ios) (a(i), i=1,n)
+end subroutine
+
+! Non-identity subscript a(2*i) is not a simple section.
+! CHECK-LABEL: func @_QPwrite_nonidentity(
+subroutine write_nonidentity(a, n)
+  integer :: n
+  real :: a(2*n)
+  ! CHECK: fir.do_loop
+  ! CHECK: fir.call @_FortranAioOutputDescriptor
+  write(10) (a(2*i), i=1,n)
+end subroutine
+
+! Step references the loop variable: no static triplet stride.
+! CHECK-LABEL: func @_QPwrite_step_invalid(
+subroutine write_step_invalid(a, n)
+  integer :: n
+  real :: a(n)
+  ! CHECK: fir.do_loop
+  ! CHECK: fir.call @_FortranAioOutputDescriptor
+  write(10) (a(i), i=1,n,i)
+end subroutine
+
+! Impure bound may not be evaluated a different number of times.
+! CHECK-LABEL: func @_QPwrite_impure_bound(
+subroutine write_impure_bound(a, n)
+  use impure_mod
+  integer :: n
+  real :: a(n)
+  ! CHECK: fir.do_loop
+  ! CHECK: fir.call @_FortranAioOutputDescriptor
+  write(10) (a(i), i=1,impure_bound(n))
+end subroutine
+
+! Loop variable used in more than one subscript, b(i,i).
+! CHECK-LABEL: func @_QPwrite_loopvar_twice(
+subroutine write_loopvar_twice(b, n)
+  integer :: n
+  real :: b(n,n)
+  ! CHECK: fir.do_loop
+  ! CHECK: fir.call @_FortranAioOutputDescriptor
+  write(10) (b(i,i), i=1,n)
+end subroutine
+
+! Loop variable not used in any subscript, b(3,4).
+! CHECK-LABEL: func @_QPwrite_no_loopvar(
+subroutine write_no_loopvar(b, n)
+  integer :: n
+  real :: b(5,5)
+  ! CHECK: fir.do_loop
+  ! CHECK: fir.call @_FortranAioOutputDescriptor
+  write(10) (b(3,4), i=1,n)
+end subroutine
+
+! Item is an array section (whole-dimension ':' subscript), not an element.
+! CHECK-LABEL: func @_QPwrite_section_whole_dim(
+subroutine write_section_whole_dim(a, n)
+  integer :: n
+  real :: a(3,n)
+  ! CHECK: fir.do_loop
+  ! CHECK: fir.call @_FortranAioOutputDescriptor
+  write(10) (a(:, i), i=1,n)
+end subroutine
+
+! Item is an array section (explicit triplet subscript).
+! CHECK-LABEL: func @_QPwrite_section_triplet(
+subroutine write_section_triplet(a, n)
+  integer :: n
+  real :: a(3,n)
+  ! CHECK: fir.do_loop
+  ! CHECK: fir.call @_FortranAioOutputDescriptor
+  write(10) (a(1:3, i), i=1,n)
+end subroutine
+
+! Triplet in another dimension still makes the item a section.
+! CHECK-LABEL: func @_QPwrite_section_trailing(
+subroutine write_section_trailing(a, n)
+  integer :: n
+  real :: a(n,5)
+  ! CHECK: fir.do_loop
+  ! CHECK: fir.call @_FortranAioOutputDescriptor
+  write(10) (a(i, 2:4), i=1,n)
+end subroutine
+
+! Volatile bound could be read a different number of times.
+! CHECK-LABEL: func @_QPwrite_volatile_bound(
+subroutine write_volatile_bound(a, lo)
+  integer, volatile :: lo
+  real :: a(100)
+  ! CHECK: fir.do_loop
+  ! CHECK: fir.call @_FortranAioOutputDescriptor
+  write(10) (a(i), i=lo,50)
+end subroutine
+
+! Volatile retained subscript could be read a different number of times.
+! CHECK-LABEL: func @_QPwrite_volatile_subscript(
+subroutine write_volatile_subscript(b, n, j)
+  integer :: n
+  integer, volatile :: j
+  real :: b(10,100)
+  ! CHECK: fir.do_loop
+  ! CHECK: fir.call @_FortranAioOutputDescriptor
+  write(10) (b(j,i), i=1,n)
+end subroutine
+
+! Input with a retained subscript that references the array being read into:
+! a real per-element loop re-evaluates b(1,1) each iteration and so observes
+! values stored by earlier iterations, while a collapsed section would evaluate
+! it once. This must NOT be collapsed.
+! CHECK-LABEL: func @_QPread_alias_subscript(
+subroutine read_alias_subscript(b, n)
+  integer :: n
+  integer :: b(10, n)
+  ! CHECK: fir.do_loop
+  ! CHECK: fir.embox %{{.*}} : (!fir.ref<i32>) -> !fir.box<i32>
+  ! CHECK: fir.call @_FortranAioInputDescriptor
+  read(10) (b(b(1,1), i), i=1,n)
+end subroutine

>From 7d7669f1398a9d2eb4ae5afa7ae784895fc2bbde Mon Sep 17 00:00:00 2001
From: Jason-Van-Beusekom <jason.van-beusekom at hpe.com>
Date: Wed, 29 Jul 2026 15:29:06 -0500
Subject: [PATCH 2/6] feedback

---
 flang/lib/Lower/IO.cpp                      | 40 ++++++++++++++--
 flang/test/Lower/io-implied-do-collapse.f90 | 53 +++++++++++++++++++++
 2 files changed, 90 insertions(+), 3 deletions(-)

diff --git a/flang/lib/Lower/IO.cpp b/flang/lib/Lower/IO.cpp
index 9782968553544..4a06a3488b66d 100644
--- a/flang/lib/Lower/IO.cpp
+++ b/flang/lib/Lower/IO.cpp
@@ -737,6 +737,28 @@ static bool ioExprReferencesVolatile(const A &expr) {
   return false;
 }
 
+/// Return true if \p symbol may share storage with another symbol via
+/// EQUIVALENCE, COMMON, POINTER/TARGET, ASSOCIATE, or dummy-argument aliasing.
+static bool
+ioSymbolMayBeStorageAssociated(const Fortran::semantics::Symbol &symbol) {
+  const Fortran::semantics::Symbol &ultimate = symbol.GetUltimate();
+  return Fortran::semantics::IsPointer(ultimate) ||
+         Fortran::semantics::IsDummy(ultimate) ||
+         ultimate.attrs().test(Fortran::semantics::Attr::TARGET) ||
+         Fortran::semantics::FindEquivalenceSet(ultimate) ||
+         Fortran::semantics::FindCommonBlockContaining(ultimate) ||
+         ultimate.detailsIf<Fortran::semantics::AssocEntityDetails>();
+}
+
+template <typename A>
+static bool ioExprReferencesStorageAssociatedSymbol(const A &expr) {
+  for (const Fortran::semantics::SymbolRef &ref :
+       Fortran::evaluate::CollectSymbols(expr))
+    if (ioSymbolMayBeStorageAssociated(*ref))
+      return true;
+  return false;
+}
+
 namespace {
 struct CollapsedImpliedDo {
   Fortran::lower::SomeExpr section;
@@ -769,6 +791,12 @@ matchContiguousImpliedDo(Fortran::lower::AbstractConverter &converter,
   if (!loopSym)
     return std::nullopt;
 
+  // The transform updates the loop variable once rather than per iteration, so
+  // it is invalid when the loop variable can alias an io item through storage
+  // or argument association, which the symbol comparisons below cannot detect.
+  if (ioSymbolMayBeStorageAssociated(*loopSym))
+    return std::nullopt;
+
   std::optional<Fortran::evaluate::DataRef> dataRef =
       Fortran::evaluate::ExtractDataRef(*leaf);
   if (!dataRef)
@@ -792,6 +820,9 @@ matchContiguousImpliedDo(Fortran::lower::AbstractConverter &converter,
       (stepExpr && ioExprReferencesSymbol(*stepExpr, *loopSym)))
     return std::nullopt;
 
+  // lower and step are re-evaluated when rebuilding the loop variable's final
+  // value, so an impure or volatile call in a bound could run a different 
+  // number of times than in the source loop.
   Fortran::evaluate::FoldingContext &foldingContext =
       converter.getFoldingContext();
   if (Fortran::evaluate::FindImpureCall(foldingContext, *lowerExpr) ||
@@ -876,10 +907,13 @@ matchContiguousImpliedDo(Fortran::lower::AbstractConverter &converter,
       if (ioExprReferencesVolatile(subExpr))
         return std::nullopt;
 
-      // For input, a retained subscript is re-evaluated on every iteration of
-      // the equivalent loop
+      // For input, a retained subscript is re-evaluated each iteration and sees
+      // earlier stores, but the collapsed section evaluates it once; bail if it
+      // may reference the array being read, directly or via an associated
+      // symbol.
       if (isInput &&
-          ioExprReferencesSymbol(subExpr, arrayRef->base().GetLastSymbol()))
+          (ioExprReferencesSymbol(subExpr, arrayRef->base().GetLastSymbol()) ||
+           ioExprReferencesStorageAssociatedSymbol(subExpr)))
         return std::nullopt;
 
       newSubscripts.push_back(sub);
diff --git a/flang/test/Lower/io-implied-do-collapse.f90 b/flang/test/Lower/io-implied-do-collapse.f90
index 28cb00714e441..d2e416864c0ca 100644
--- a/flang/test/Lower/io-implied-do-collapse.f90
+++ b/flang/test/Lower/io-implied-do-collapse.f90
@@ -234,3 +234,56 @@ subroutine read_alias_subscript(b, n)
   ! CHECK: fir.call @_FortranAioInputDescriptor
   read(10) (b(b(1,1), i), i=1,n)
 end subroutine
+
+! Loop variable is EQUIVALENCEd to an element of the array being written.
+! CHECK-LABEL: func @_QPwrite_equiv_loopvar(
+subroutine write_equiv_loopvar()
+  integer :: a(8), i
+  equivalence (i, a(4))
+  ! CHECK: fir.do_loop
+  ! CHECK: fir.call @_FortranAioOutputDescriptor
+  write(10) (a(i), i=1,8)
+end subroutine
+
+! Loop variable is a POINTER associated to an element of the array.
+! CHECK-LABEL: func @_QPwrite_pointer_loopvar(
+subroutine write_pointer_loopvar()
+  integer, target :: a(8)
+  integer, pointer :: i
+  i => a(4)
+  ! CHECK: fir.do_loop
+  ! CHECK: fir.call @_FortranAioOutputDescriptor
+  write(10) (a(i), i=1,8)
+end subroutine
+
+! Loop variable is an ASSOCIATE construct entity aliasing an element.
+! CHECK-LABEL: func @_QPwrite_associate_loopvar(
+subroutine write_associate_loopvar(a)
+  integer :: a(8)
+  associate (i => a(4))
+    ! CHECK: fir.do_loop
+    ! CHECK: fir.call @_FortranAioOutputDescriptor
+    write(10) (a(i), i=1,8)
+  end associate
+end subroutine
+
+! Loop variable is a dummy argument that may be argument associated with the
+! array (e.g. call sub(b, b(4))).
+! CHECK-LABEL: func @_QPwrite_dummy_loopvar(
+subroutine write_dummy_loopvar(a, i)
+  integer :: a(8), i
+  ! CHECK: fir.do_loop
+  ! CHECK: fir.call @_FortranAioOutputDescriptor
+  write(10) (a(i), i=1,8)
+end subroutine
+
+! Input: a retained subscript that is a dummy argument may be argument
+! associated with an element being read, so it must not be collapsed.
+! CHECK-LABEL: func @_QPread_dummy_subscript(
+subroutine read_dummy_subscript(a, k, n)
+  integer :: n
+  integer :: a(10, n), k
+  ! CHECK: fir.do_loop
+  ! CHECK: fir.call @_FortranAioInputDescriptor
+  read(10) (a(k, i), i=1,n)
+end subroutine

>From 33ad0b5ed5b4263f6dc869e9bc7be76b63c37d45 Mon Sep 17 00:00:00 2001
From: Jason-Van-Beusekom <jason.van-beusekom at hpe.com>
Date: Wed, 29 Jul 2026 15:32:12 -0500
Subject: [PATCH 3/6] remove trailing white space

---
 flang/lib/Lower/IO.cpp | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/flang/lib/Lower/IO.cpp b/flang/lib/Lower/IO.cpp
index 4a06a3488b66d..d0476258bfa09 100644
--- a/flang/lib/Lower/IO.cpp
+++ b/flang/lib/Lower/IO.cpp
@@ -821,7 +821,7 @@ matchContiguousImpliedDo(Fortran::lower::AbstractConverter &converter,
     return std::nullopt;
 
   // lower and step are re-evaluated when rebuilding the loop variable's final
-  // value, so an impure or volatile call in a bound could run a different 
+  // value, so an impure or volatile call in a bound could run a different
   // number of times than in the source loop.
   Fortran::evaluate::FoldingContext &foldingContext =
       converter.getFoldingContext();

>From 4cf6d153f2db66b71d5395d4191c2601a40d805f Mon Sep 17 00:00:00 2001
From: Jason Van Beusekom <jason.van-beusekom at hpe.com>
Date: Wed, 26 Aug 2026 13:39:26 -0500
Subject: [PATCH 4/6] feedback from Eugene

---
 flang/lib/Lower/IO.cpp                      | 139 +++++++++++++-------
 flang/test/Lower/io-implied-do-collapse.f90 |  97 ++++++++++++++
 2 files changed, 190 insertions(+), 46 deletions(-)

diff --git a/flang/lib/Lower/IO.cpp b/flang/lib/Lower/IO.cpp
index d0476258bfa09..7686a1eba93af 100644
--- a/flang/lib/Lower/IO.cpp
+++ b/flang/lib/Lower/IO.cpp
@@ -13,6 +13,7 @@
 #include "flang/Lower/IO.h"
 #include "flang/Common/uint128.h"
 #include "flang/Evaluate/tools.h"
+#include "flang/Evaluate/traverse.h"
 #include "flang/Lower/Allocatable.h"
 #include "flang/Lower/Bridge.h"
 #include "flang/Lower/CallInterface.h"
@@ -716,35 +717,66 @@ getIoItemLeafExpr(const Fortran::parser::InputItem &item) {
   return nullptr;
 }
 
+// CollectSymbols does not look through callee bodies, so this only
+// sees symbols the expression names directly (see ioExprContainsProcedureRef
+// for the call case).
+template <typename A, typename Pred>
+static bool ioAnyReferencedSymbol(const A &expr, Pred pred) {
+  for (const Fortran::semantics::SymbolRef &ref :
+       Fortran::evaluate::CollectSymbols(expr))
+    if (pred(ref->GetUltimate()))
+      return true;
+  return false;
+}
+
 template <typename A>
 static bool ioExprReferencesSymbol(const A &expr,
                                    const Fortran::semantics::Symbol &sym) {
   const Fortran::semantics::Symbol &ultimate = sym.GetUltimate();
-  for (const Fortran::semantics::SymbolRef &ref :
-       Fortran::evaluate::CollectSymbols(expr)) {
-    if (&ref->GetUltimate() == &ultimate)
-      return true;
-  }
-  return false;
+  return ioAnyReferencedSymbol(expr, [&](const Fortran::semantics::Symbol &s) {
+    return &s == &ultimate;
+  });
 }
 
 template <typename A>
 static bool ioExprReferencesVolatile(const A &expr) {
-  for (const Fortran::semantics::SymbolRef &ref :
-       Fortran::evaluate::CollectSymbols(expr))
-    if (ref->GetUltimate().attrs().test(Fortran::semantics::Attr::VOLATILE))
-      return true;
-  return false;
+  return ioAnyReferencedSymbol(expr, [](const Fortran::semantics::Symbol &s) {
+    return s.attrs().test(Fortran::semantics::Attr::VOLATILE);
+  });
+}
+
+namespace {
+// Finds any procedure reference in an expression. CollectSymbols and
+// FindImpureCall do not look through callee bodies, so a (possibly PURE)
+// function hidden in a retained subscript could read the io-implied-do variable
+// or the array being transferred without being visible to the symbol and
+// aliasing checks below.
+struct ProcedureRefFinder
+    : public Fortran::evaluate::AnyTraverse<ProcedureRefFinder, bool> {
+  using Base = Fortran::evaluate::AnyTraverse<ProcedureRefFinder, bool>;
+  ProcedureRefFinder() : Base{*this} {}
+  using Base::operator();
+  bool operator()(const Fortran::evaluate::ProcedureRef &) const {
+    return true;
+  }
+};
+} // namespace
+
+template <typename A>
+static bool ioExprContainsProcedureRef(const A &expr) {
+  return ProcedureRefFinder{}(expr);
 }
 
 /// Return true if \p symbol may share storage with another symbol via
-/// EQUIVALENCE, COMMON, POINTER/TARGET, ASSOCIATE, or dummy-argument aliasing.
+/// EQUIVALENCE, COMMON, POINTER/TARGET, ASSOCIATE, Cray pointee, or
+/// dummy-argument aliasing.
 static bool
 ioSymbolMayBeStorageAssociated(const Fortran::semantics::Symbol &symbol) {
   const Fortran::semantics::Symbol &ultimate = symbol.GetUltimate();
   return Fortran::semantics::IsPointer(ultimate) ||
          Fortran::semantics::IsDummy(ultimate) ||
          ultimate.attrs().test(Fortran::semantics::Attr::TARGET) ||
+         ultimate.test(Fortran::semantics::Symbol::Flag::CrayPointee) ||
          Fortran::semantics::FindEquivalenceSet(ultimate) ||
          Fortran::semantics::FindCommonBlockContaining(ultimate) ||
          ultimate.detailsIf<Fortran::semantics::AssocEntityDetails>();
@@ -752,11 +784,7 @@ ioSymbolMayBeStorageAssociated(const Fortran::semantics::Symbol &symbol) {
 
 template <typename A>
 static bool ioExprReferencesStorageAssociatedSymbol(const A &expr) {
-  for (const Fortran::semantics::SymbolRef &ref :
-       Fortran::evaluate::CollectSymbols(expr))
-    if (ioSymbolMayBeStorageAssociated(*ref))
-      return true;
-  return false;
+  return ioAnyReferencedSymbol(expr, ioSymbolMayBeStorageAssociated);
 }
 
 namespace {
@@ -785,12 +813,21 @@ matchContiguousImpliedDo(Fortran::lower::AbstractConverter &converter,
   if (!leaf)
     return std::nullopt;
 
+  if (Fortran::semantics::ExprHasTypeCategory(
+          *leaf, Fortran::common::TypeCategory::Derived))
+    return std::nullopt;
+
   const Fortran::parser::IoImpliedDoControl &control = std::get<1>(impliedDo.t);
   const Fortran::semantics::Symbol *loopSym =
       Fortran::parser::UnwrapRef<Fortran::parser::Name>(control.Name()).symbol;
   if (!loopSym)
     return std::nullopt;
 
+  // A VOLATILE do-variable is stored once per iteration by the per-element loop
+  // but only once by the collapsed form, changing observable behavior.
+  if (loopSym->GetUltimate().attrs().test(Fortran::semantics::Attr::VOLATILE))
+    return std::nullopt;
+
   // The transform updates the loop variable once rather than per iteration, so
   // it is invalid when the loop variable can alias an io item through storage
   // or argument association, which the symbol comparisons below cannot detect.
@@ -815,26 +852,17 @@ matchContiguousImpliedDo(Fortran::lower::AbstractConverter &converter,
   if (!lowerExpr || !upperExpr || (control.Step() && !stepExpr))
     return std::nullopt;
 
-  if (ioExprReferencesSymbol(*lowerExpr, *loopSym) ||
-      ioExprReferencesSymbol(*upperExpr, *loopSym) ||
-      (stepExpr && ioExprReferencesSymbol(*stepExpr, *loopSym)))
-    return std::nullopt;
-
-  // lower and step are re-evaluated when rebuilding the loop variable's final
-  // value, so an impure or volatile call in a bound could run a different
-  // number of times than in the source loop.
+  // A bound must not reference the loop variable, and lower/step are
+  // re-evaluated when rebuilding the loop variable's final value, so an impure
+  // or volatile call in a bound could run a different number of times than in
+  // the source loop.
   Fortran::evaluate::FoldingContext &foldingContext =
       converter.getFoldingContext();
-  if (Fortran::evaluate::FindImpureCall(foldingContext, *lowerExpr) ||
-      Fortran::evaluate::FindImpureCall(foldingContext, *upperExpr) ||
-      (stepExpr &&
-       Fortran::evaluate::FindImpureCall(foldingContext, *stepExpr)))
-    return std::nullopt;
-
-  if (ioExprReferencesVolatile(*lowerExpr) ||
-      ioExprReferencesVolatile(*upperExpr) ||
-      (stepExpr && ioExprReferencesVolatile(*stepExpr)))
-    return std::nullopt;
+  for (const Fortran::lower::SomeExpr *bound : {lowerExpr, upperExpr, stepExpr})
+    if (bound && (ioExprReferencesSymbol(*bound, *loopSym) ||
+                  Fortran::evaluate::FindImpureCall(foldingContext, *bound) ||
+                  ioExprReferencesVolatile(*bound)))
+      return std::nullopt;
 
   // The io-implied-do bounds and index are scalar integer expressions
   // (enforced by semantics), so each narrows to Expr<SomeInteger>
@@ -890,18 +918,16 @@ matchContiguousImpliedDo(Fortran::lower::AbstractConverter &converter,
                   upperSub},
               std::move(stepSub)}});
     } else {
-      // Every other subscript must be a loop-invariant scalar. It is evaluated
-      // once for the collapsed section instead of once per iteration, so it
-      // must not reference the loop variable and must be safe to evaluate a
-      // different number of times (i.e. free of impure function references).
+      // Every other subscript is retained and evaluated once for the collapsed
+      // section instead of once per iteration, so it must not reference the
+      // loop variable.
       if (subExpr.Rank() != 0 || ioExprReferencesSymbol(subExpr, *loopSym))
         return std::nullopt;
 
-      if (Fortran::evaluate::FindImpureCall(
-              foldingContext,
-              Fortran::evaluate::AsGenericExpr(
-                  Fortran::evaluate::Expr<Fortran::evaluate::SubscriptInteger>{
-                      subExpr})))
+      // A call in a retained subscript may read the loop variable or (on input)
+      // the array through its body, which CollectSymbols and FindImpureCall
+      // cannot see; bail on any call, pure or impure.
+      if (ioExprContainsProcedureRef(subExpr))
         return std::nullopt;
 
       if (ioExprReferencesVolatile(subExpr))
@@ -966,6 +992,23 @@ genImpliedDoLoopVarFinalValue(Fortran::lower::AbstractConverter &converter,
   fir::StoreOp::create(builder, loc, stored, loopVar);
 }
 
+/// A zero-trip io-implied-do transfers nothing, and its section may designate
+/// an unallocated array whose descriptor has a null base, so the descriptor
+/// call must be skipped when the section is empty to match the per-element
+/// loop.
+static void genGuardedCollapsedTransfer(fir::FirOpBuilder &builder,
+                                        mlir::Location loc,
+                                        mlir::Value sectionBox,
+                                        llvm::function_ref<void()> genCall) {
+  mlir::Type idxTy = builder.getIndexType();
+  mlir::Value zero = builder.createIntegerConstant(loc, idxTy, 0);
+  auto dims = fir::BoxDimsOp::create(builder, loc, idxTy, idxTy, idxTy,
+                                     sectionBox, zero);
+  mlir::Value hasElements = mlir::arith::CmpIOp::create(
+      builder, loc, mlir::arith::CmpIPredicate::sgt, dims.getResult(1), zero);
+  builder.genIfThen(loc, hasElements).genThen(genCall).end();
+}
+
 template <bool isInput, typename ImpliedDo>
 static bool
 tryCollapseContiguousImpliedDo(Fortran::lower::AbstractConverter &converter,
@@ -1171,7 +1214,9 @@ tryCollapseContiguousImpliedDo(Fortran::lower::AbstractConverter &converter,
         converter.genExprBox(loc, collapsed->section, stmtCtx);
     genImpliedDoLoopVarFinalValue(converter, *collapsed, fir::getBase(itemExv),
                                   stmtCtx);
-    ok = createIoRuntimeCallForItem(converter, loc, inputFunc, cookie, itemExv);
+    genGuardedCollapsedTransfer(builder, loc, fir::getBase(itemExv), [&]() {
+      createIoRuntimeCallForItem(converter, loc, inputFunc, cookie, itemExv);
+    });
   } else {
     mlir::func::FuncOp outputFunc =
         getOutputFunc(loc, builder, itemTy, /*isFormatted=*/false);
@@ -1182,7 +1227,9 @@ tryCollapseContiguousImpliedDo(Fortran::lower::AbstractConverter &converter,
         cookie, builder.createConvertWithVolatileCast(loc, argType, box)};
     if (containsDerivedType(itemTy))
       args.push_back(getNonTbpDefinedIoTableAddr(converter));
-    ok = fir::CallOp::create(builder, loc, outputFunc, args).getResult(0);
+    genGuardedCollapsedTransfer(builder, loc, box, [&]() {
+      fir::CallOp::create(builder, loc, outputFunc, args);
+    });
     genImpliedDoLoopVarFinalValue(converter, *collapsed, box, stmtCtx);
   }
   return true;
diff --git a/flang/test/Lower/io-implied-do-collapse.f90 b/flang/test/Lower/io-implied-do-collapse.f90
index d2e416864c0ca..3890569d4df1b 100644
--- a/flang/test/Lower/io-implied-do-collapse.f90
+++ b/flang/test/Lower/io-implied-do-collapse.f90
@@ -12,6 +12,33 @@ integer function impure_bound(k)
   end function
 end module
 
+module pure_mod
+  integer :: mi
+contains
+  ! A PURE function reading module state: conforming, but its body is invisible
+  ! to CollectSymbols/FindImpureCall.
+  pure integer function pure_read()
+    pure_read = mi
+  end function
+end module
+
+module dtio_mod
+  type t
+    integer :: v
+  contains
+    procedure :: wuf
+    generic :: write(unformatted) => wuf
+  end type
+contains
+  subroutine wuf(dtv, unit, iostat, iomsg)
+    class(t), intent(in) :: dtv
+    integer, intent(in) :: unit
+    integer, intent(out) :: iostat
+    character(*), intent(inout) :: iomsg
+    write(unit, iostat=iostat, iomsg=iomsg) dtv%v
+  end subroutine
+end module
+
 ! CHECK-LABEL: func @_QPwrite_whole(
 subroutine write_whole(a, n)
   integer :: n
@@ -51,6 +78,24 @@ subroutine write_finalval(a, n, k)
   k = i
 end subroutine
 
+! A collapsed transfer is guarded by a runtime trip-count check: a zero-trip
+! implied-do (whose section may designate an unallocated array with a null base)
+! must transfer nothing, matching the per-element loop. The loop variable's
+! final value is still stored unconditionally.
+! CHECK-LABEL: func @_QPwrite_zerotrip_guard(
+subroutine write_zerotrip_guard(a, n)
+  integer :: n
+  real :: a(n)
+  ! CHECK: %[[SEC:.*]] = hlfir.designate
+  ! CHECK: %[[DIMS:.*]]:3 = fir.box_dims %[[SEC]], %{{.*}} : (!fir.box<!fir.array<?xf32>>, index) -> (index, index, index)
+  ! CHECK: %[[NE:.*]] = arith.cmpi sgt, %[[DIMS]]#1, %{{.*}} : index
+  ! CHECK: fir.if %[[NE]] {
+  ! CHECK:   fir.call @_FortranAioOutputDescriptor
+  ! CHECK: }
+  ! CHECK-NOT: fir.do_loop
+  write(10) (a(i), i=1,n)
+end subroutine
+
 ! CHECK-LABEL: func @_QPwrite_fixed(
 subroutine write_fixed(b, n)
   integer :: n
@@ -287,3 +332,55 @@ subroutine read_dummy_subscript(a, k, n)
   ! CHECK: fir.call @_FortranAioInputDescriptor
   read(10) (a(k, i), i=1,n)
 end subroutine
+
+! A PURE function in a retained subscript may read the loop variable (or, on
+! input, the array) through its body, which the symbol/impurity checks cannot
+! see. Bail on any call in a retained subscript.
+! CHECK-LABEL: func @_QPwrite_pure_subscript(
+subroutine write_pure_subscript(a, n)
+  use pure_mod
+  integer :: n
+  real :: a(10, n)
+  ! CHECK: fir.do_loop
+  ! CHECK: fir.call @_FortranAioOutputDescriptor
+  write(10) (a(pure_read(), i), i=1,n)
+end subroutine
+
+! Derived-type items may use defined (unformatted) I/O, which runs user code
+! per element that can observe the loop variable. Do not collapse.
+! CHECK-LABEL: func @_QPwrite_derived_dtio(
+subroutine write_derived_dtio(x, n)
+  use dtio_mod
+  integer :: n
+  type(t) :: x(n)
+  ! CHECK: fir.do_loop
+  ! CHECK: fir.call @_FortranAioOutputDerivedType
+  write(10) (x(i), i=1,n)
+end subroutine
+
+! Loop variable is a Cray pointee storage-associated with an element of the
+! array (CrayPointee is a Symbol::Flag, not an Attr).
+! CHECK-LABEL: func @_QPwrite_cray_loopvar(
+subroutine write_cray_loopvar(a)
+  integer :: a(8)
+  pointer (pa, i)
+  integer :: i
+  pa = loc(a(4))
+  ! CHECK: fir.do_loop
+  ! CHECK: fir.call @_FortranAioOutputDescriptor
+  write(10) (a(i), i=1,8)
+end subroutine
+
+! A VOLATILE loop variable is stored once per iteration by the per-element loop
+! but only once by the collapsed form; that observable difference forbids the
+! transform.
+! CHECK-LABEL: func @_QPwrite_volatile_loopvar(
+subroutine write_volatile_loopvar(a, n)
+  integer :: n
+  integer, volatile :: i
+  real :: a(n)
+  ! CHECK: fir.do_loop
+  ! CHECK: fir.call @_FortranAioOutputDescriptor
+  write(10) (a(i), i=1,n)
+end subroutine
+

>From 639303588a60f19152c8c3ee8672ba4d07999d15 Mon Sep 17 00:00:00 2001
From: Jason Van Beusekom <jason.van-beusekom at hpe.com>
Date: Thu, 27 Aug 2026 14:25:55 -0500
Subject: [PATCH 5/6] feedback

---
 flang/lib/Lower/IO.cpp                      |  85 +++++------
 flang/test/Lower/io-implied-do-collapse.f90 | 153 ++++++++++++++++----
 2 files changed, 157 insertions(+), 81 deletions(-)

diff --git a/flang/lib/Lower/IO.cpp b/flang/lib/Lower/IO.cpp
index 7686a1eba93af..e7f96651744bc 100644
--- a/flang/lib/Lower/IO.cpp
+++ b/flang/lib/Lower/IO.cpp
@@ -718,8 +718,8 @@ getIoItemLeafExpr(const Fortran::parser::InputItem &item) {
 }
 
 // CollectSymbols does not look through callee bodies, so this only
-// sees symbols the expression names directly (see ioExprContainsProcedureRef
-// for the call case).
+// sees symbols the expression names directly (see NonSimpleCallFinder for the
+// call case).
 template <typename A, typename Pred>
 static bool ioAnyReferencedSymbol(const A &expr, Pred pred) {
   for (const Fortran::semantics::SymbolRef &ref :
@@ -738,43 +738,42 @@ static bool ioExprReferencesSymbol(const A &expr,
   });
 }
 
-template <typename A>
-static bool ioExprReferencesVolatile(const A &expr) {
-  return ioAnyReferencedSymbol(expr, [](const Fortran::semantics::Symbol &s) {
-    return s.attrs().test(Fortran::semantics::Attr::VOLATILE);
-  });
-}
-
 namespace {
-// Finds any procedure reference in an expression. CollectSymbols and
-// FindImpureCall do not look through callee bodies, so a (possibly PURE)
-// function hidden in a retained subscript could read the io-implied-do variable
-// or the array being transferred without being visible to the symbol and
-// aliasing checks below.
-struct ProcedureRefFinder
-    : public Fortran::evaluate::AnyTraverse<ProcedureRefFinder, bool> {
-  using Base = Fortran::evaluate::AnyTraverse<ProcedureRefFinder, bool>;
-  ProcedureRefFinder() : Base{*this} {}
+// Symbol collection does not look through callee bodies, so a non-SIMPLE
+// function hidden in a bound or retained subscript could read the io-implied-do
+// variable or the array being transferred.
+struct NonSimpleCallFinder
+    : public Fortran::evaluate::AnyTraverse<NonSimpleCallFinder, bool> {
+  using Base = Fortran::evaluate::AnyTraverse<NonSimpleCallFinder, bool>;
+  NonSimpleCallFinder() : Base{*this} {}
   using Base::operator();
-  bool operator()(const Fortran::evaluate::ProcedureRef &) const {
-    return true;
+  bool operator()(const Fortran::evaluate::ProcedureRef &call) const {
+    if (!call.proc().IsSimple())
+      return true;
+    return Base::operator()(call);
   }
 };
 } // namespace
 
+// A bound or retained subscript is evaluated once for the collapsed section
+// rather than once per source-loop iteration, so it must not depend on the loop
+// variable, hide a non-SIMPLE call that could read it, or read a volatile.
 template <typename A>
-static bool ioExprContainsProcedureRef(const A &expr) {
-  return ProcedureRefFinder{}(expr);
+static bool
+ioExprUnsafeForSingleEvaluation(const A &expr,
+                                const Fortran::semantics::Symbol &loopSym) {
+  return ioExprReferencesSymbol(expr, loopSym) || NonSimpleCallFinder{}(expr) ||
+         ioAnyReferencedSymbol(expr, [](const Fortran::semantics::Symbol &s) {
+           return s.attrs().test(Fortran::semantics::Attr::VOLATILE);
+         });
 }
 
 /// Return true if \p symbol may share storage with another symbol via
-/// EQUIVALENCE, COMMON, POINTER/TARGET, ASSOCIATE, Cray pointee, or
-/// dummy-argument aliasing.
+/// EQUIVALENCE, COMMON, POINTER/TARGET, ASSOCIATE, or Cray pointee.
 static bool
 ioSymbolMayBeStorageAssociated(const Fortran::semantics::Symbol &symbol) {
   const Fortran::semantics::Symbol &ultimate = symbol.GetUltimate();
   return Fortran::semantics::IsPointer(ultimate) ||
-         Fortran::semantics::IsDummy(ultimate) ||
          ultimate.attrs().test(Fortran::semantics::Attr::TARGET) ||
          ultimate.test(Fortran::semantics::Symbol::Flag::CrayPointee) ||
          Fortran::semantics::FindEquivalenceSet(ultimate) ||
@@ -782,11 +781,6 @@ ioSymbolMayBeStorageAssociated(const Fortran::semantics::Symbol &symbol) {
          ultimate.detailsIf<Fortran::semantics::AssocEntityDetails>();
 }
 
-template <typename A>
-static bool ioExprReferencesStorageAssociatedSymbol(const A &expr) {
-  return ioAnyReferencedSymbol(expr, ioSymbolMayBeStorageAssociated);
-}
-
 namespace {
 struct CollapsedImpliedDo {
   Fortran::lower::SomeExpr section;
@@ -852,16 +846,11 @@ matchContiguousImpliedDo(Fortran::lower::AbstractConverter &converter,
   if (!lowerExpr || !upperExpr || (control.Step() && !stepExpr))
     return std::nullopt;
 
-  // A bound must not reference the loop variable, and lower/step are
-  // re-evaluated when rebuilding the loop variable's final value, so an impure
-  // or volatile call in a bound could run a different number of times than in
-  // the source loop.
-  Fortran::evaluate::FoldingContext &foldingContext =
-      converter.getFoldingContext();
+  // Lower and step are re-evaluated after the transfer to rebuild the loop
+  // variable's final value, so an unsafe bound could change the trip count or
+  // the stored result relative to the source loop.
   for (const Fortran::lower::SomeExpr *bound : {lowerExpr, upperExpr, stepExpr})
-    if (bound && (ioExprReferencesSymbol(*bound, *loopSym) ||
-                  Fortran::evaluate::FindImpureCall(foldingContext, *bound) ||
-                  ioExprReferencesVolatile(*bound)))
+    if (bound && ioExprUnsafeForSingleEvaluation(*bound, *loopSym))
       return std::nullopt;
 
   // The io-implied-do bounds and index are scalar integer expressions
@@ -919,18 +908,10 @@ matchContiguousImpliedDo(Fortran::lower::AbstractConverter &converter,
               std::move(stepSub)}});
     } else {
       // Every other subscript is retained and evaluated once for the collapsed
-      // section instead of once per iteration, so it must not reference the
-      // loop variable.
-      if (subExpr.Rank() != 0 || ioExprReferencesSymbol(subExpr, *loopSym))
-        return std::nullopt;
-
-      // A call in a retained subscript may read the loop variable or (on input)
-      // the array through its body, which CollectSymbols and FindImpureCall
-      // cannot see; bail on any call, pure or impure.
-      if (ioExprContainsProcedureRef(subExpr))
-        return std::nullopt;
-
-      if (ioExprReferencesVolatile(subExpr))
+      // section instead of once per iteration; it must be scalar and safe to
+      // evaluate a single time.
+      if (subExpr.Rank() != 0 ||
+          ioExprUnsafeForSingleEvaluation(subExpr, *loopSym))
         return std::nullopt;
 
       // For input, a retained subscript is re-evaluated each iteration and sees
@@ -939,7 +920,7 @@ matchContiguousImpliedDo(Fortran::lower::AbstractConverter &converter,
       // symbol.
       if (isInput &&
           (ioExprReferencesSymbol(subExpr, arrayRef->base().GetLastSymbol()) ||
-           ioExprReferencesStorageAssociatedSymbol(subExpr)))
+           ioAnyReferencedSymbol(subExpr, ioSymbolMayBeStorageAssociated)))
         return std::nullopt;
 
       newSubscripts.push_back(sub);
diff --git a/flang/test/Lower/io-implied-do-collapse.f90 b/flang/test/Lower/io-implied-do-collapse.f90
index 3890569d4df1b..264068fddb7e9 100644
--- a/flang/test/Lower/io-implied-do-collapse.f90
+++ b/flang/test/Lower/io-implied-do-collapse.f90
@@ -15,13 +15,23 @@ integer function impure_bound(k)
 module pure_mod
   integer :: mi
 contains
-  ! A PURE function reading module state: conforming, but its body is invisible
-  ! to CollectSymbols/FindImpureCall.
+  ! A PURE (non-SIMPLE) function reading module state: conforming, but its body
+  ! is invisible to symbol collection.
   pure integer function pure_read()
     pure_read = mi
   end function
 end module
 
+module simple_mod
+contains
+  ! A SIMPLE function (F2023) may reference only its arguments, so it cannot
+  ! read the do-variable or array through host or use association.
+  simple integer function simple_bound(k)
+    integer, intent(in) :: k
+    simple_bound = k
+  end function
+end module
+
 module dtio_mod
   type t
     integer :: v
@@ -96,6 +106,25 @@ subroutine write_zerotrip_guard(a, n)
   write(10) (a(i), i=1,n)
 end subroutine
 
+! Zero-trip pin: the loop variable's final value (lower + tripCount*step, which
+! is lower for a zero-trip section) is stored unconditionally, after and outside
+! the trip-count guard, matching a zero-iteration DO.
+! CHECK-LABEL: func @_QPwrite_zerotrip_finalval(
+subroutine write_zerotrip_finalval(a, n, k)
+  integer :: n, k
+  real :: a(n)
+  ! CHECK: fir.if
+  ! CHECK:   fir.call @_FortranAioOutputDescriptor
+  ! CHECK: }
+  ! CHECK: %[[DIMS:.*]]:3 = fir.box_dims
+  ! CHECK: %[[TS:.*]] = arith.muli %[[DIMS]]#1, %{{.*}} : index
+  ! CHECK: %[[FV:.*]] = arith.addi %{{.*}}, %[[TS]] : index
+  ! CHECK: %[[FVC:.*]] = fir.convert %[[FV]] : (index) -> i32
+  ! CHECK: fir.store %[[FVC]] to %{{.*}} : !fir.ref<i32>
+  write(10) (a(i), i=1,n)
+  k = i
+end subroutine
+
 ! CHECK-LABEL: func @_QPwrite_fixed(
 subroutine write_fixed(b, n)
   integer :: n
@@ -116,15 +145,42 @@ subroutine write_step_valid(a, n)
   write(10) (a(i), i=1,n,2)
 end subroutine
 
-! CHECK-LABEL: func @_QPwrite_pure_bound(
-subroutine write_pure_bound(a, n)
-  use impure_mod
+! A negative step still designates a valid array-section descriptor, and the
+! final value lower + tripCount*step handles step < 0, so collapse.
+! CHECK-LABEL: func @_QPwrite_negstep(
+subroutine write_negstep(a, n)
   integer :: n
   real :: a(n)
   ! CHECK: fir.call @_FortranAioOutputDescriptor
   ! CHECK-NOT: fir.call @_FortranAioOutputReal
   ! CHECK-NOT: fir.do_loop
-  write(10) (a(i), i=1,pure_bound(n))
+  write(10) (a(i), i=n,1,-1)
+end subroutine
+
+! A SIMPLE function (F2023 C15115) may reference only its arguments, so it
+! cannot read the do-variable through host or use association; a bound calling
+! one is safe to re-evaluate, so collapse.
+! CHECK-LABEL: func @_QPwrite_simple_bound(
+subroutine write_simple_bound(a, n)
+  use simple_mod
+  integer :: n
+  real :: a(n)
+  ! CHECK: fir.call @_FortranAioOutputDescriptor
+  ! CHECK-NOT: fir.call @_FortranAioOutputReal
+  ! CHECK-NOT: fir.do_loop
+  write(10) (a(i), i=1,simple_bound(n))
+end subroutine
+
+! A SIMPLE function in a retained subscript depends only on its arguments, so
+! evaluating it once for the collapsed section matches the per-iteration loop.
+! CHECK-LABEL: func @_QPwrite_simple_subscript(
+subroutine write_simple_subscript(a, n)
+  use simple_mod
+  integer :: n
+  real :: a(10, n)
+  ! CHECK: fir.call @_FortranAioOutputDescriptor
+  ! CHECK-NOT: fir.do_loop
+  write(10) (a(simple_bound(3), i), i=1,n)
 end subroutine
 
 ! CHECK-LABEL: func @_QPwrite_alias_subscript(
@@ -137,6 +193,27 @@ subroutine write_alias_subscript(b, n)
   write(10) (b(b(1,1), i), i=1,n)
 end subroutine
 
+! Loop variable is a plain dummy argument (no TARGET/POINTER); the standard's
+! anti-aliasing rules let us assume it does not overlap the array, so collapse.
+! CHECK-LABEL: func @_QPwrite_dummy_loopvar(
+subroutine write_dummy_loopvar(a, i)
+  integer :: a(8), i
+  ! CHECK: fir.call @_FortranAioOutputDescriptor
+  ! CHECK-NOT: fir.do_loop
+  write(10) (a(i), i=1,8)
+end subroutine
+
+! Input: a retained subscript that is a plain dummy argument (no TARGET/POINTER)
+! is assumed not to alias the array being read, so collapse.
+! CHECK-LABEL: func @_QPread_dummy_subscript(
+subroutine read_dummy_subscript(a, k, n)
+  integer :: n
+  integer :: a(10, n), k
+  ! CHECK: fir.call @_FortranAioInputDescriptor
+  ! CHECK-NOT: fir.do_loop
+  read(10) (a(k, i), i=1,n)
+end subroutine
+
 ! ===========================================================================
 ! The cases below are NOT collapsed and fall back to a per-element loop.
 ! ===========================================================================
@@ -195,6 +272,30 @@ subroutine write_impure_bound(a, n)
   write(10) (a(i), i=1,impure_bound(n))
 end subroutine
 
+! A PURE but non-SIMPLE function may still read the do-variable through host or
+! use association, invisible to the symbol checks, and the bound is re-evaluated
+! to rebuild the final value. Only SIMPLE calls are allowed, so fall back.
+! CHECK-LABEL: func @_QPwrite_pure_bound(
+subroutine write_pure_bound(a, n)
+  use impure_mod
+  integer :: n
+  real :: a(n)
+  ! CHECK: fir.do_loop
+  ! CHECK: fir.call @_FortranAioOutputDescriptor
+  write(10) (a(i), i=1,pure_bound(n))
+end subroutine
+
+! The do-variable is the module variable mi, and the PURE (non-SIMPLE) bound
+! function pure_read() reads it through use association, invisible to the checks.
+! CHECK-LABEL: func @_QPwrite_module_dovar_bound(
+subroutine write_module_dovar_bound(a)
+  use pure_mod
+  real :: a(8)
+  ! CHECK: fir.do_loop
+  ! CHECK: fir.call @_FortranAioOutputDescriptor
+  write(10) (a(mi), mi=pure_read(),pure_read()+7)
+end subroutine
+
 ! Loop variable used in more than one subscript, b(i,i).
 ! CHECK-LABEL: func @_QPwrite_loopvar_twice(
 subroutine write_loopvar_twice(b, n)
@@ -312,38 +413,32 @@ subroutine write_associate_loopvar(a)
   end associate
 end subroutine
 
-! Loop variable is a dummy argument that may be argument associated with the
-! array (e.g. call sub(b, b(4))).
-! CHECK-LABEL: func @_QPwrite_dummy_loopvar(
-subroutine write_dummy_loopvar(a, i)
-  integer :: a(8), i
-  ! CHECK: fir.do_loop
-  ! CHECK: fir.call @_FortranAioOutputDescriptor
-  write(10) (a(i), i=1,8)
-end subroutine
-
-! Input: a retained subscript that is a dummy argument may be argument
-! associated with an element being read, so it must not be collapsed.
-! CHECK-LABEL: func @_QPread_dummy_subscript(
-subroutine read_dummy_subscript(a, k, n)
+! A PURE but non-SIMPLE function in a retained subscript may read the loop
+! variable (or, on input, the array) through host or use association, invisible
+! to the symbol checks. Only SIMPLE calls are allowed, so fall back.
+! CHECK-LABEL: func @_QPwrite_pure_subscript(
+subroutine write_pure_subscript(a, n)
+  use pure_mod
   integer :: n
-  integer :: a(10, n), k
+  real :: a(10, n)
   ! CHECK: fir.do_loop
-  ! CHECK: fir.call @_FortranAioInputDescriptor
-  read(10) (a(k, i), i=1,n)
+  ! CHECK: fir.call @_FortranAioOutputDescriptor
+  write(10) (a(pure_read(), i), i=1,n)
 end subroutine
 
-! A PURE function in a retained subscript may read the loop variable (or, on
-! input, the array) through its body, which the symbol/impurity checks cannot
-! see. Bail on any call in a retained subscript.
-! CHECK-LABEL: func @_QPwrite_pure_subscript(
-subroutine write_pure_subscript(a, n)
+! A SIMPLE call whose actual argument hides a non-SIMPLE PURE function is not
+! safe: the inner function may read the do-variable (or, on input, the array)
+! through host or use association, invisible to the symbol checks. The finder
+! must descend into SIMPLE-call arguments, so fall back.
+! CHECK-LABEL: func @_QPwrite_simple_wraps_pure(
+subroutine write_simple_wraps_pure(a, n)
+  use simple_mod
   use pure_mod
   integer :: n
   real :: a(10, n)
   ! CHECK: fir.do_loop
   ! CHECK: fir.call @_FortranAioOutputDescriptor
-  write(10) (a(pure_read(), i), i=1,n)
+  write(10) (a(simple_bound(pure_read()), i), i=1,n)
 end subroutine
 
 ! Derived-type items may use defined (unformatted) I/O, which runs user code

>From 1fd54993f0f7181bd29ea7288d8f537d0e5b48cb Mon Sep 17 00:00:00 2001
From: Jason-Van-Beusekom <jason.van-beusekom at hpe.com>
Date: Tue, 15 Sep 2026 11:45:50 -0500
Subject: [PATCH 6/6] reject impiled do loops with optional attr

---
 flang/lib/Lower/IO.cpp                      | 11 ++++++----
 flang/test/Lower/io-implied-do-collapse.f90 | 23 +++++++++++++++++++++
 2 files changed, 30 insertions(+), 4 deletions(-)

diff --git a/flang/lib/Lower/IO.cpp b/flang/lib/Lower/IO.cpp
index e7f96651744bc..bcbd947c74138 100644
--- a/flang/lib/Lower/IO.cpp
+++ b/flang/lib/Lower/IO.cpp
@@ -795,8 +795,7 @@ struct CollapsedImpliedDo {
 /// otherwise
 template <typename ImpliedDo>
 static std::optional<CollapsedImpliedDo>
-matchContiguousImpliedDo(Fortran::lower::AbstractConverter &converter,
-                         const ImpliedDo &impliedDo, bool isInput) {
+matchContiguousImpliedDo(const ImpliedDo &impliedDo, bool isInput) {
 
   // Only collapse a single body item
   const auto &items = std::get<0>(impliedDo.t);
@@ -837,6 +836,9 @@ matchContiguousImpliedDo(Fortran::lower::AbstractConverter &converter,
   if (!arrayRef || !arrayRef->base().IsSymbol())
     return std::nullopt;
 
+  if (Fortran::semantics::IsOptional(arrayRef->base().GetLastSymbol()))
+    return std::nullopt;
+
   const Fortran::lower::SomeExpr *lowerExpr =
       Fortran::semantics::GetExpr(control.Lower());
   const Fortran::lower::SomeExpr *upperExpr =
@@ -911,7 +913,8 @@ matchContiguousImpliedDo(Fortran::lower::AbstractConverter &converter,
       // section instead of once per iteration; it must be scalar and safe to
       // evaluate a single time.
       if (subExpr.Rank() != 0 ||
-          ioExprUnsafeForSingleEvaluation(subExpr, *loopSym))
+          ioExprUnsafeForSingleEvaluation(subExpr, *loopSym) ||
+          ioAnyReferencedSymbol(subExpr, Fortran::semantics::IsOptional))
         return std::nullopt;
 
       // For input, a retained subscript is re-evaluated each iteration and sees
@@ -1181,7 +1184,7 @@ tryCollapseContiguousImpliedDo(Fortran::lower::AbstractConverter &converter,
   if (isFormatted || checkResult)
     return false;
   std::optional<CollapsedImpliedDo> collapsed =
-      matchContiguousImpliedDo(converter, impliedDo, isInput);
+      matchContiguousImpliedDo(impliedDo, isInput);
   if (!collapsed)
     return false;
   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
diff --git a/flang/test/Lower/io-implied-do-collapse.f90 b/flang/test/Lower/io-implied-do-collapse.f90
index 264068fddb7e9..1b8a920e97c9a 100644
--- a/flang/test/Lower/io-implied-do-collapse.f90
+++ b/flang/test/Lower/io-implied-do-collapse.f90
@@ -479,3 +479,26 @@ subroutine write_volatile_loopvar(a, n)
   write(10) (a(i), i=1,n)
 end subroutine
 
+! An OPTIONAL base array may be absent, giving a null descriptor that the
+! collapsed path would still box and read even for a legal zero-trip transfer.
+! CHECK-LABEL: func @_QPwrite_optional_base(
+subroutine write_optional_base(a, n)
+  integer :: n
+  real, optional :: a(n)
+  ! CHECK: fir.do_loop
+  ! CHECK: fir.call @_FortranAioOutputDescriptor
+  write(10) (a(i), i=1,n)
+end subroutine
+
+! An OPTIONAL retained subscript may be absent; the collapsed section reads it
+! once when building the box, even for a legal zero-trip transfer.
+! CHECK-LABEL: func @_QPwrite_optional_subscript(
+subroutine write_optional_subscript(b, n, k)
+  integer :: n
+  integer, optional :: k
+  real :: b(10, n)
+  ! CHECK: fir.do_loop
+  ! CHECK: fir.call @_FortranAioOutputDescriptor
+  write(10) (b(k, i), i=1,n)
+end subroutine
+



More information about the flang-commits mailing list