[flang] Upstream code to lower pointer assignment in FORALL constructs

[schweitz]

Summary

This patch upstreams initial work to support the lowering of pointer assignments in a FORALL construct.

Also includes some other bug fixes that are related and need upstreaming as well.

[PeteSteinfeld]

All builds and tests correctly and looks good.

[Meinersbur]

This broke the msvs buildbot caused by the removal of the __SIZEOF_INT128__ conditional compilation: https://lab.llvm.org/buildbot/#/builders/172/builds/12046

[peixin]

flang/lib/Lower/IO.cpp

84

This seems to be failed on X86.

https://buildkite.com/llvm-project/premerge-checks/builds/91903#b24dc0c7-8505-49f2-a757-ab5a0576c2f0

[3999/4207] Building CXX object tools\flang\lib\Lower\CMakeFiles\obj.FortranLower.dir\IO.cpp.obj
FAILED: tools/flang/lib/Lower/CMakeFiles/obj.FortranLower.dir/IO.cpp.obj
sccache C:\BuildTools\VC\Tools\MSVC\14.29.30133\bin\Hostx64\x64\cl.exe /nologo /TP -DBUILD_EXAMPLES -DFLANG_LITTLE_ENDIAN=1 -DGTEST_HAS_RTTI=0 -DUNICODE -D_CRT_NONSTDC_NO_DEPRECATE -D_CRT_NONSTDC_NO_WARNINGS -D_CRT_SECURE_NO_DEPRECATE -D_CRT_SECURE_NO_WARNINGS -D_HAS_EXCEPTIONS=0 -D_SCL_SECURE_NO_DEPRECATE -D_SCL_SECURE_NO_WARNINGS -D_UNICODE -DSTDC_CONSTANT_MACROS -DSTDC_FORMAT_MACROS -DSTDC_LIMIT_MACROS -Itools\flang\lib\Lower -IC:\ws\w5\llvm-project\premerge-checks\flang\lib\Lower -IC:\ws\w5\llvm-project\premerge-checks\flang\include -Itools\flang\include -Iinclude -IC:\ws\w5\llvm-project\premerge-checks\llvm\include -IC:\ws\w5\llvm-project\premerge-checks\llvm\..\mlir\include -Itools\mlir\include -Itools\clang\include -IC:\ws\w5\llvm-project\premerge-checks\llvm\..\clang\include /DWIN32 /D_WINDOWS /Zc:inline /Zc:cplusplus /Zc:strictStrings /Oi /Zc:rvalueCast /bigobj /W4 -wd4141 -wd4146 -wd4244 -wd4267 -wd4291 -wd4351 -wd4456 -wd4457 -wd4458 -wd4459 -wd4503 -wd4624 -wd4722 -wd4100 -wd4127 -wd4512 -wd4505 -wd4610 -wd4510 -wd4702 -wd4245 -wd4706 -wd4310 -wd4701 -wd4703 -wd4389 -wd4611 -wd4805 -wd4204 -wd4577 -wd4091 -wd4592 -wd4319 -wd4709 -wd4324 -w14062 -we4238 /Gw /MD /O2 /Ob2 /EHs-c- /GR- -UNDEBUG -std:c++17 /showIncludes /Fotools\flang\lib\Lower\CMakeFiles\obj.FortranLower.dir\IO.cpp.obj /Fdtools\flang\lib\Lower\CMakeFiles\obj.FortranLower.dir\ /FS -c C:\ws\w5\llvm-project\premerge-checks\flang\lib\Lower\IO.cpp
C:\ws\w5\llvm-project\premerge-checks\flang\lib\Lower\IO.cpp(84): error C2065: '_FortranAioCheckUnitNumberInRange128': undeclared identifier
C:\ws\w5\llvm-project\premerge-checks\flang\lib\Lower\IO.cpp(84): error C3203: 'RuntimeTableKey': unspecialized class template can't be used as a template argument for template parameter '<unnamed-symbol>', expected a real type
C:\BuildTools\VC\Tools\MSVC\14.29.30133\include\tuple(189): error C2079: 'std::_Tuple_val<_This>::_Val' uses undefined struct 'fir::runtime::RuntimeTableEntry<int,std::integer_sequence<T,95,70,111,114,116,114,97,110,65,105,111,67,104,101,99,107,85,110,105,116,78,117,109,98,101,114,73,110,82,97,110,103,101,49,50,56>>'

with
[
    _This=fir::runtime::RuntimeTableEntry<int,std::integer_sequence<char,95,70,111,114,116,114,97,110,65,105,111,67,104,101,99,107,85,110,105,116,78,117,109,98,101,114,73,110,82,97,110,103,101,49,50,56>>
]
and
[
    T=char
]

C:\BuildTools\VC\Tools\MSVC\14.29.30133\include\tuple(730): note: see reference to class template instantiation 'std::_Tuple_val<_This>' being compiled

flang/include/flang/Lower/AbstractConverter.h

public:
   createHostAssociateVarClone(const Fortran::semantics::Symbol &sym) = 0;
 
   virtual void copyHostAssociateVar(const Fortran::semantics::Symbol &sym) = 0;
 
   //===--------------------------------------------------------------------===//
   // Expressions
   //===--------------------------------------------------------------------===//
 
-  /// Generate the address of the location holding the expression, someExpr.
-  virtual fir::ExtendedValue genExprAddr(const SomeExpr &, StatementContext &,
+  /// Generate the address of the location holding the expression, \p expr.
+  /// If \p expr is a Designator that is not compile time contiguous, the
+  /// address returned is the one of a contiguous temporary storage holding the
+  /// expression value. The clean-up for this temporary is added to \p context.
+  virtual fir::ExtendedValue genExprAddr(const SomeExpr &expr,
+                                         StatementContext &context,
                                          mlir::Location *loc = nullptr) = 0;
-  /// Generate the address of the location holding the expression, someExpr
-  fir::ExtendedValue genExprAddr(const SomeExpr *someExpr,
-                                 StatementContext &stmtCtx,
-                                 mlir::Location loc) {
-    return genExprAddr(*someExpr, stmtCtx, &loc);
+
+  /// Generate the address of the location holding the expression, \p expr.
+  fir::ExtendedValue genExprAddr(mlir::Location loc, const SomeExpr *expr,
+                                 StatementContext &stmtCtx) {
+    return genExprAddr(*expr, stmtCtx, &loc);
+  }
+  fir::ExtendedValue genExprAddr(mlir::Location loc, const SomeExpr &expr,
+                                 StatementContext &stmtCtx) {
+    return genExprAddr(expr, stmtCtx, &loc);
   }
 
-  /// Generate the computations of the expression to produce a value
-  virtual fir::ExtendedValue genExprValue(const SomeExpr &, StatementContext &,
+  /// Generate the computations of the expression to produce a value.
+  virtual fir::ExtendedValue genExprValue(const SomeExpr &expr,
+                                          StatementContext &context,
                                           mlir::Location *loc = nullptr) = 0;
-  /// Generate the computations of the expression, someExpr, to produce a value
-  fir::ExtendedValue genExprValue(const SomeExpr *someExpr,
-                                  StatementContext &stmtCtx,
-                                  mlir::Location loc) {
-    return genExprValue(*someExpr, stmtCtx, &loc);
+
+  /// Generate the computations of the expression, \p expr, to produce a value.
+  fir::ExtendedValue genExprValue(mlir::Location loc, const SomeExpr *expr,
+                                  StatementContext &stmtCtx) {
+    return genExprValue(*expr, stmtCtx, &loc);
+  }
+  fir::ExtendedValue genExprValue(mlir::Location loc, const SomeExpr &expr,
+                                  StatementContext &stmtCtx) {
+    return genExprValue(expr, stmtCtx, &loc);
   }
 
   /// Generate or get a fir.box describing the expression. If SomeExpr is
   /// a Designator, the fir.box describes an entity over the Designator base
   /// storage without making a temporary.
-  virtual fir::ExtendedValue genExprBox(const SomeExpr &, StatementContext &,
-                                        mlir::Location) = 0;
+  virtual fir::ExtendedValue genExprBox(mlir::Location loc,
+                                        const SomeExpr &expr,
+                                        StatementContext &stmtCtx) = 0;
 
   /// Generate the address of the box describing the variable designated
   /// by the expression. The expression must be an allocatable or pointer
   /// designator.
   virtual fir::MutableBoxValue genExprMutableBox(mlir::Location loc,
-                                                 const SomeExpr &) = 0;
+                                                 const SomeExpr &expr) = 0;
 
   /// Get FoldingContext that is required for some expression
   /// analysis.
   virtual Fortran::evaluate::FoldingContext &getFoldingContext() = 0;
 
   /// Host associated variables are grouped as a tuple. This returns that value,
   /// which is itself a reference. Use bindTuple() to set this value.
   virtual mlir::Value hostAssocTupleValue() = 0;

flang/include/flang/Lower/Allocatable.h

 //===-- Allocatable.h -- Allocatable statements lowering ------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 //
 // Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/
 //
 //===----------------------------------------------------------------------===//
 
 #ifndef FORTRAN_LOWER_ALLOCATABLE_H
 #define FORTRAN_LOWER_ALLOCATABLE_H
 
+#include "flang/Lower/AbstractConverter.h"
 #include "flang/Optimizer/Builder/MutableBox.h"
 #include "llvm/ADT/StringRef.h"
 
 namespace mlir {
 class Value;
 class ValueRange;
 class Location;
 } // namespace mlir
 
 namespace fir {
-class MutableBoxValue;
-}
+class FirOpBuilder;
+} // namespace fir
 
-namespace Fortran::parser {
+namespace Fortran {
+namespace parser {
 struct AllocateStmt;
 struct DeallocateStmt;
-} // namespace Fortran::parser
+} // namespace parser
 
-namespace Fortran::evaluate {
-template <typename T>
-class Expr;
-struct SomeType;
-} // namespace Fortran::evaluate
+namespace lower {
+struct SymbolBox;
 
-namespace Fortran::lower {
-class AbstractConverter;
 class StatementContext;
 
-namespace pft {
-struct Variable;
-}
+bool isArraySectionWithoutVectorSubscript(const SomeExpr &expr);
 
 /// Lower an allocate statement to fir.
-void genAllocateStmt(Fortran::lower::AbstractConverter &,
-                     const Fortran::parser::AllocateStmt &, mlir::Location);
+void genAllocateStmt(AbstractConverter &converter,
+                     const parser::AllocateStmt &stmt, mlir::Location loc);
 
 /// Lower a deallocate statement to fir.
-void genDeallocateStmt(Fortran::lower::AbstractConverter &,
-                       const Fortran::parser::DeallocateStmt &, mlir::Location);
+void genDeallocateStmt(AbstractConverter &converter,
+                       const parser::DeallocateStmt &stmt, mlir::Location loc);
 
 /// Create a MutableBoxValue for an allocatable or pointer entity.
 /// If the variables is a local variable that is not a dummy, it will be
 /// initialized to unallocated/diassociated status.
-fir::MutableBoxValue createMutableBox(Fortran::lower::AbstractConverter &,
-                                      mlir::Location,
-                                      const Fortran::lower::pft::Variable &var,
+fir::MutableBoxValue createMutableBox(AbstractConverter &converter,
+                                      mlir::Location loc,
+                                      const pft::Variable &var,
                                       mlir::Value boxAddr,
                                       mlir::ValueRange nonDeferredParams);
 
-/// Update a MutableBoxValue to describe the entity designated by the expression
-/// \p source. This version takes care of \p source lowering.
-/// If \lbounds is not empty, it is used to defined the MutableBoxValue
-/// lower bounds, otherwise, the lower bounds from \p source are used.
-void associateMutableBox(
-    Fortran::lower::AbstractConverter &, mlir::Location,
-    const fir::MutableBoxValue &,
-    const Fortran::evaluate::Expr<Fortran::evaluate::SomeType> &source,
-    mlir::ValueRange lbounds, Fortran::lower::StatementContext &);
+/// Assign a boxed value to a boxed variable, \p box (known as a
+/// MutableBoxValue). Expression \p source will be lowered to build the
+/// assignment. If \p lbounds is not empty, it is used to define the result's
+/// lower bounds. Otherwise, the lower bounds from \p source will be used.
+void associateMutableBox(AbstractConverter &converter, mlir::Location loc,
+                         const fir::MutableBoxValue &box,
+                         const SomeExpr &source, mlir::ValueRange lbounds,
+                         StatementContext &stmtCtx);
 
-} // namespace Fortran::lower
+/// Is \p expr a reference to an entity with the ALLOCATABLE attribute?
+bool isWholeAllocatable(const SomeExpr &expr);
+
+/// Is \p expr a reference to an entity with the POINTER attribute?
+bool isWholePointer(const SomeExpr &expr);
+
+} // namespace lower
+} // namespace Fortran
 
 #endif // FORTRAN_LOWER_ALLOCATABLE_H

flang/include/flang/Lower/ComponentPath.h

 namespace Fortran::lower {
 
 namespace details {
 class ImplicitSubscripts {};
 } // namespace details
 
 using PathComponent =
     std::variant<const evaluate::ArrayRef *, const evaluate::Component *,
-                 const Fortran::evaluate::ComplexPart *,
-                 details::ImplicitSubscripts>;
+                 const evaluate::ComplexPart *, details::ImplicitSubscripts>;
 
 /// Collection of components.
 ///
 /// This class is used both to collect front-end post-order functional Expr
 /// trees and their translations to Values to be used in a pre-order list of
 /// arguments.
 class ComponentPath {
 public:
+  using ExtendRefFunc = std::function<mlir::Value(const mlir::Value &)>;
+
   ComponentPath(bool isImplicit) { setPC(isImplicit); }
   ComponentPath(bool isImplicit, const evaluate::Substring *ss)
       : substring(ss) {
     setPC(isImplicit);
   }
   ComponentPath() = delete;
 
-  bool isSlice() { return !trips.empty() || hasComponents(); }
-  bool hasComponents() { return !suffixComponents.empty(); }
+  bool isSlice() const { return !trips.empty() || hasComponents(); }
+  bool hasComponents() const { return !suffixComponents.empty(); }
   void clear();
 
+  bool hasExtendCoorRef() const { return extendCoorRef.hasValue(); }
+  ExtendRefFunc getExtendCoorRef() const;
+  void resetExtendCoorRef() { extendCoorRef = llvm::None; }
+  void resetPC();
+
   llvm::SmallVector<PathComponent> reversePath;
   const evaluate::Substring *substring = nullptr;
   bool applied = false;
 
   llvm::SmallVector<mlir::Value> prefixComponents;
   llvm::SmallVector<mlir::Value> trips;
   llvm::SmallVector<mlir::Value> suffixComponents;
   std::function<IterationSpace(const IterationSpace &)> pc;
 
+  /// In the case where a path of components involves members that are POINTER
+  /// or ALLOCATABLE, a dereference is required in FIR for semantic correctness.
+  /// This optional continuation allows the generation of those dereferences.
+  /// These accesses are always on Fortran entities of record types, which are
+  /// implicitly in-memory objects.
+  llvm::Optional<ExtendRefFunc> extendCoorRef = llvm::None;
+
 private:
   void setPC(bool isImplicit);
 };
 
 /// Examine each subscript expression of \p x and return true if and only if any
 /// of the subscripts is a vector or has a rank greater than 0.
 bool isRankedArrayAccess(const Fortran::evaluate::ArrayRef &x);
 
 } // namespace Fortran::lower
 
 #endif // FORTRAN_LOWER_COMPONENTPATH_H

flang/include/flang/Lower/ConvertExpr.h

 /// iteration space as well as a inner (subordinate) implied iteration
 /// space. The implied iteration space may include WHERE conditions, `masks`.
 void createAnyMaskedArrayAssignment(AbstractConverter &converter,
                                     const SomeExpr &lhs, const SomeExpr &rhs,
                                     ExplicitIterSpace &explicitIterSpace,
                                     ImplicitIterSpace &implicitIterSpace,
                                     SymMap &symMap, StatementContext &stmtCtx);
 
-/// In the context of a FORALL, a pointer assignment is allowed. The pointer
-/// assignment can be elementwise on an array of pointers. The bounds
-/// expressions as well as the component path may contain references to the
-/// concurrent control variables. The explicit iteration space must be defined.
-void createAnyArrayPointerAssignment(
-    AbstractConverter &converter, const SomeExpr &lhs, const SomeExpr &rhs,
-    const evaluate::Assignment::BoundsSpec &bounds,
-    ExplicitIterSpace &explicitIterSpace, ImplicitIterSpace &implicitIterSpace,
-    SymMap &symMap);
-/// Support the bounds remapping flavor of pointer assignment.
-void createAnyArrayPointerAssignment(
-    AbstractConverter &converter, const SomeExpr &lhs, const SomeExpr &rhs,
-    const evaluate::Assignment::BoundsRemapping &bounds,
-    ExplicitIterSpace &explicitIterSpace, ImplicitIterSpace &implicitIterSpace,
-    SymMap &symMap);
-
 /// Lower an assignment to an allocatable array, allocating the array if
 /// it is not allocated yet or reallocation it if it does not conform
 /// with the right hand side.
 void createAllocatableArrayAssignment(AbstractConverter &converter,
                                       const SomeExpr &lhs, const SomeExpr &rhs,
                                       ExplicitIterSpace &explicitIterSpace,
                                       ImplicitIterSpace &implicitIterSpace,
                                       SymMap &symMap,
                                       StatementContext &stmtCtx);
 
+/// Lower a pointer assignment in an explicit iteration space. The explicit
+/// space iterates over a data structure with a type of `!fir.array<...
+/// !fir.box<!fir.ptr<T>> ...>`. Lower the assignment by copying the rhs box
+/// value to each array element.
+void createArrayOfPointerAssignment(
+    AbstractConverter &converter, const SomeExpr &lhs, const SomeExpr &rhs,
+    ExplicitIterSpace &explicitIterSpace, ImplicitIterSpace &implicitIterSpace,
+    const llvm::SmallVector<mlir::Value> &lbounds,
+    llvm::Optional<llvm::SmallVector<mlir::Value>> ubounds, SymMap &symMap,
+    StatementContext &stmtCtx);
+
 /// Lower an array expression with "parallel" semantics. Such a rhs expression
 /// is fully evaluated prior to being assigned back to a temporary array.
 fir::ExtendedValue createSomeArrayTempValue(AbstractConverter &converter,
                                             const SomeExpr &expr,
                                             SymMap &symMap,
                                             StatementContext &stmtCtx);
 
 /// Somewhat similar to createSomeArrayTempValue, but the temporary buffer is

flang/include/flang/Lower/Support/Utils.h

 /// Get rid of it here so the vector can be loaded. Add it back when
 /// generating the elemental evaluation (inside the loop nest).
 inline Fortran::lower::SomeExpr
 ignoreEvConvert(const Fortran::evaluate::Expr<Fortran::evaluate::Type<
                     Fortran::common::TypeCategory::Integer, 8>> &x) {
   return std::visit([](const auto &v) { return ignoreEvConvert(v); }, x.u);
 }
 
+/// Zip two containers of the same size together and flatten the pairs. `flatZip
+/// [1;2] [3;4]` yields `[1;3;2;4]`.
+template <typename A>
+A flatZip(const A &container1, const A &container2) {
+  assert(container1.size() == container2.size());
+  A result;
+  for (auto [e1, e2] : llvm::zip(container1, container2)) {
+    result.emplace_back(e1);
+    result.emplace_back(e2);
+  }
+  return result;
+}
+
 #endif // FORTRAN_LOWER_SUPPORT_UTILS_H

flang/include/flang/Optimizer/Builder/BoxValue.h

 #include "mlir/IR/Value.h"
 #include "llvm/ADT/SmallVector.h"
 #include "llvm/Support/Compiler.h"
 #include "llvm/Support/raw_ostream.h"
 #include <utility>
 
 namespace fir {
 class FirOpBuilder;
+class ArrayLoadOp;
 
-class CharBoxValue;
 class ArrayBoxValue;
 class BoxValue;
 class CharBoxValue;
 class CharArrayBoxValue;
 class MutableBoxValue;
 class ProcBoxValue;
 
 llvm::raw_ostream &operator<<(llvm::raw_ostream &, const CharBoxValue &);

 using UnboxedValue = mlir::Value;
 
 /// Abstract base class.
 class AbstractBox {
 public:
   AbstractBox() = delete;
   AbstractBox(mlir::Value addr) : addr{addr} {}
 
-  /// FIXME: this comment is not true anymore since genLoad
-  /// is loading constant length characters. What is the impact  /// ?
-  /// An abstract box always contains a memory reference to a value.
+  /// An abstract box most often contains a memory reference to a value. Despite
+  /// the name here, it is possible that `addr` is a scalar value that is not a
+  /// memory reference.
   mlir::Value getAddr() const { return addr; }
 
 protected:
   mlir::Value addr;
 };
 
 /// Expressions of CHARACTER type have an associated, possibly dynamic LEN
 /// value.
public:
   }
   /// Returns the rank of the entity. Beware that zero will be returned for
   /// both scalars and assumed rank.
   unsigned rank() const {
     if (auto seqTy = getBaseTy().dyn_cast<fir::SequenceType>())
       return seqTy.getDimension();
     return 0;
   }
+
   /// Is this a character entity ?
-  bool isCharacter() const { return fir::isa_char(getEleTy()); };
+  bool isCharacter() const { return fir::isa_char(getEleTy()); }
+
   /// Is this a derived type entity ?
-  bool isDerived() const { return getEleTy().isa<fir::RecordType>(); };
+  bool isDerived() const { return getEleTy().isa<fir::RecordType>(); }
+
+  bool isDerivedWithLenParameters() const {
+    return fir::isRecordWithTypeParameters(getEleTy());
+  }
 
-  bool isDerivedWithLengthParameters() const {
-    auto record = getEleTy().dyn_cast<fir::RecordType>();
-    return record && record.getNumLenParams() != 0;
-  };
   /// Is this a CLASS(*)/TYPE(*) ?
   bool isUnlimitedPolymorphic() const {
-    return getEleTy().isa<mlir::NoneType>();
+    return fir::isUnlimitedPolymorphicType(getBaseTy());
   }
 };
 
 /// An entity described by a fir.box value that cannot be read into
 /// another ExtendedValue category, either because the fir.box may be an
 /// absent optional and we need to wait until the user is referencing it
 /// to read it, or because it contains important information that cannot
 /// be exposed in FIR (e.g. non contiguous byte stride).
-/// It may also store explicit bounds or length parameters that were specified
+/// It may also store explicit bounds or LEN parameters that were specified
 /// for the entity.
 class BoxValue : public AbstractIrBox {
 public:
   BoxValue(mlir::Value addr) : AbstractIrBox{addr} { assert(verify()); }
   BoxValue(mlir::Value addr, llvm::ArrayRef<mlir::Value> lbounds,
            llvm::ArrayRef<mlir::Value> explicitParams,
            llvm::ArrayRef<mlir::Value> explicitExtents = {})
       : AbstractIrBox{addr, lbounds, explicitExtents},
public:
   friend llvm::raw_ostream &operator<<(llvm::raw_ostream &, const BoxValue &);
   LLVM_DUMP_METHOD void dump() const { llvm::errs() << *this; }
 
   llvm::ArrayRef<mlir::Value> getLBounds() const { return lbounds; }
 
   // The extents member is not guaranteed to be field for arrays. It is only
   // guaranteed to be field for explicit shape arrays. In general,
   // explicit-shape will not come as descriptors, so this field will be empty in
-  // most cases. The exception are derived types with length parameters and
+  // most cases. The exception are derived types with LEN parameters and
   // polymorphic dummy argument arrays. It may be possible for the explicit
   // extents to conflict with the shape information that is in the box according
   // to 15.5.2.11 sequence association rules.
   llvm::ArrayRef<mlir::Value> getExplicitExtents() const { return extents; }
 
   llvm::ArrayRef<mlir::Value> getExplicitParameters() const {
     return explicitParams;
   }
 
 protected:
   // Verify constructor invariants.
   bool verify() const;
 
-  // Only field when the BoxValue has explicit length parameters.
-  // Otherwise, the length parameters are in the fir.box.
+  // Only field when the BoxValue has explicit LEN parameters.
+  // Otherwise, the LEN parameters are in the fir.box.
   llvm::SmallVector<mlir::Value, 2> explicitParams;
 };
 
 /// Set of variables (addresses) holding the allocatable properties. These may
 /// be empty in case it is not deemed safe to duplicate the descriptor
 /// information locally (For instance, a volatile allocatable will always be
 /// lowered to a descriptor to preserve the integrity of the entity and its
 /// associated properties. As such, all references to the entity and its
 /// property will go through the descriptor explicitly.).
 class MutableProperties {
 public:
   bool isEmpty() const { return !addr; }
   mlir::Value addr;
   llvm::SmallVector<mlir::Value, 2> extents;
   llvm::SmallVector<mlir::Value, 2> lbounds;
-  /// Only keep track of the deferred length parameters through variables, since
+  /// Only keep track of the deferred LEN parameters through variables, since
   /// they are the only ones that can change as per the deferred type parameters
   /// definition in F2018 standard section 3.147.12.2.
   /// Non-deferred values are returned by
   /// MutableBoxValue.nonDeferredLenParams().
   llvm::SmallVector<mlir::Value, 2> deferredParams;
 };
 
 /// MutableBoxValue is used for entities that are represented by the address of
 /// a box. This is intended to be used for entities whose base address, shape
 /// and type are not constant in the entity lifetime (e.g Allocatables and
 /// Pointers).
 class MutableBoxValue : public AbstractIrBox {
 public:
   /// Create MutableBoxValue given the address \p addr of the box and the non
-  /// deferred length parameters \p lenParameters. The non deferred length
-  /// parameters must always be provided, even if they are constant and already
-  /// reflected in the address type.
+  /// deferred LEN parameters \p lenParameters. The non deferred LEN parameters
+  /// must always be provided, even if they are constant and already reflected
+  /// in the address type.
   MutableBoxValue(mlir::Value addr, mlir::ValueRange lenParameters,
                   MutableProperties mutableProperties)
       : AbstractIrBox(addr), lenParams{lenParameters.begin(),
                                        lenParameters.end()},
         mutableProperties{mutableProperties} {
     // Currently only accepts fir.(ref/ptr/heap)<fir.box<type>> mlir::Value for
     // the address. This may change if we accept
-    // fir.(ref/ptr/heap)<fir.heap<type>> for scalar without length parameters.
+    // fir.(ref/ptr/heap)<fir.heap<type>> for scalar without LEN parameters.
     assert(verify() &&
            "MutableBoxValue requires mem ref to fir.box<fir.[heap|ptr]<type>>");
   }
   /// Is this a Fortran pointer ?
   bool isPointer() const {
     return getBoxTy().getEleTy().isa<fir::PointerType>();
   }
   /// Is this an allocatable ?
   bool isAllocatable() const {
     return getBoxTy().getEleTy().isa<fir::HeapType>();
   }
   // Replace the fir.ref<fir.box>, keeping any non-deferred parameters.
   MutableBoxValue clone(mlir::Value newBox) const {
     return {newBox, lenParams, mutableProperties};
   }
-  /// Does this entity has any non deferred length parameters ?
+  /// Does this entity has any non deferred LEN parameters?
   bool hasNonDeferredLenParams() const { return !lenParams.empty(); }
-  /// Return the non deferred length parameters.
+  /// Return the non deferred LEN parameters.
   llvm::ArrayRef<mlir::Value> nonDeferredLenParams() const { return lenParams; }
   friend llvm::raw_ostream &operator<<(llvm::raw_ostream &,
                                        const MutableBoxValue &);
   LLVM_DUMP_METHOD void dump() const { llvm::errs() << *this; }
 
   /// Set of variable is used instead of a descriptor to hold the entity
   /// properties instead of a fir.ref<fir.box<>>.
   bool isDescribedByVariables() const { return !mutableProperties.isEmpty(); }
 
   const MutableProperties &getMutableProperties() const {
     return mutableProperties;
   }
 
 protected:
   /// Validate the address type form in the constructor.
   bool verify() const;
-  /// Hold the non-deferred length parameter values  (both for characters and
-  /// derived). Non-deferred length parameters cannot change dynamically, as
+  /// Hold the non-deferred LEN parameter values  (both for characters and
+  /// derived). Non-deferred LEN parameters cannot change dynamically, as
   /// opposed to deferred type parameters (3.147.12.2).
   llvm::SmallVector<mlir::Value, 2> lenParams;
   /// Set of variables holding the extents, lower bounds and
   /// base address when it is deemed safe to work with these variables rather
   /// than directly with a descriptor.
   MutableProperties mutableProperties;
 };
 

 ExtendedValue substBase(const ExtendedValue &exv, mlir::Value base);
 
 /// Is the extended value `exv` an array?
 bool isArray(const ExtendedValue &exv);
 
 /// Get the type parameters for `exv`.
 llvm::SmallVector<mlir::Value> getTypeParams(const ExtendedValue &exv);
 
+//===----------------------------------------------------------------------===//
+// Functions that may generate IR to recover properties from extended values.
+//===----------------------------------------------------------------------===//
+namespace factory {
+
+/// Generalized function to recover dependent type parameters. This does away
+/// with the distinction between deferred and non-deferred LEN type parameters
+/// (Fortran definition), since that categorization is irrelevant when getting
+/// all type parameters for a value of dependent type.
+llvm::SmallVector<mlir::Value> getTypeParams(mlir::Location loc,
+                                             FirOpBuilder &builder,
+                                             const ExtendedValue &exv);
+
+/// Specialization of get type parameters for an ArrayLoadOp. An array load must
+/// either have all type parameters given as arguments or be a boxed value.
+llvm::SmallVector<mlir::Value>
+getTypeParams(mlir::Location loc, FirOpBuilder &builder, ArrayLoadOp load);
+
 // The generalized function to get a vector of extents is
-// fir::factory::getExtents(). See FIRBuilder.h.
+/// Get extents from \p box. For fir::BoxValue and
+/// fir::MutableBoxValue, this will generate code to read the extents.
+llvm::SmallVector<mlir::Value>
+getExtents(mlir::Location loc, FirOpBuilder &builder, const ExtendedValue &box);
 
 /// Get exactly one extent for any array-like extended value, \p exv. If \p exv
 /// is not an array or has rank less then \p dim, the result will be a nullptr.
-mlir::Value getExtentAtDimension(const ExtendedValue &exv,
-                                 FirOpBuilder &builder, mlir::Location loc,
-                                 unsigned dim);
+mlir::Value getExtentAtDimension(mlir::Location loc, FirOpBuilder &builder,
+                                 const ExtendedValue &exv, unsigned dim);
+
+} // namespace factory
 
 /// An extended value is a box of values pertaining to a discrete entity. It is
 /// used in lowering to track all the runtime values related to an entity. For
 /// example, an entity may have an address in memory that contains its value(s)
 /// as well as various attribute values that describe the shape and starting
 /// indices if it is an array entity.
 class ExtendedValue : public details::matcher<ExtendedValue> {
 public:

 }
 
 /// Return the scalar type of \p exv type. This removes all
 /// reference, box, or sequence type from \p exv base.
 inline mlir::Type getElementTypeOf(const ExtendedValue &exv) {
   return fir::unwrapSequenceType(getBaseTypeOf(exv));
 }
 
-/// Is the extended value `exv` a derived type with length parameters ?
-inline bool isDerivedWithLengthParameters(const ExtendedValue &exv) {
-  auto record = getElementTypeOf(exv).dyn_cast<fir::RecordType>();
-  return record && record.getNumLenParams() != 0;
+/// Is the extended value `exv` a derived type with LEN parameters?
+inline bool isDerivedWithLenParameters(const ExtendedValue &exv) {
+  return fir::isRecordWithTypeParameters(getElementTypeOf(exv));
 }
 
 } // namespace fir
 
 #endif // FORTRAN_OPTIMIZER_BUILDER_BOXVALUE_H

flang/include/flang/Optimizer/Builder/FIRBuilder.h

mlir::Value readLowerBound(fir::FirOpBuilder &builder, mlir::Location loc,
                            const fir::ExtendedValue &box, unsigned dim,
                            mlir::Value defaultValue);
 
 /// Read extents from \p box.
 llvm::SmallVector<mlir::Value> readExtents(fir::FirOpBuilder &builder,
                                            mlir::Location loc,
                                            const fir::BoxValue &box);
 
-/// Get extents from \p box. For fir::BoxValue and
-/// fir::MutableBoxValue, this will generate code to read the extents.
-llvm::SmallVector<mlir::Value> getExtents(fir::FirOpBuilder &builder,
-                                          mlir::Location loc,
-                                          const fir::ExtendedValue &box);
-
 /// Read a fir::BoxValue into an fir::UnboxValue, a fir::ArrayBoxValue or a
 /// fir::CharArrayBoxValue. This should only be called if the fir::BoxValue is
 /// known to be contiguous given the context (or if the resulting address will
 /// not be used). If the value is polymorphic, its dynamic type will be lost.
 /// This must not be used on unlimited polymorphic and assumed rank entities.
 fir::ExtendedValue readBoxValue(fir::FirOpBuilder &builder, mlir::Location loc,
                                 const fir::BoxValue &box);
 
-/// Get non default (not all ones) lower bounds of \p exv. Returns empty
-/// vector if the lower bounds are all ones.
+/// Get the lower bounds of \p exv. NB: returns an empty vector if the lower
+/// bounds are all ones, which is the default in Fortran.
 llvm::SmallVector<mlir::Value>
 getNonDefaultLowerBounds(fir::FirOpBuilder &builder, mlir::Location loc,
                          const fir::ExtendedValue &exv);
 
 /// Return length parameters associated to \p exv that are not deferred (that
 /// are available without having to read any fir.box values).
 /// Empty if \p exv has no length parameters or if they are all deferred.
 llvm::SmallVector<mlir::Value>

flang/include/flang/Optimizer/Builder/Factory.h

void genCharacterCopy(mlir::Value src, mlir::Value srcLen, mlir::Value dst,
   auto out2 = builder.template create<fir::CoordinateOp>(
       loc, toCoorTy(cdstTy), cdst2, loop.getInductionVar());
   builder.template create<fir::StoreOp>(loc, space, out2);
   builder.restoreInsertionPoint(insPt);
 }
 
 /// Get extents from fir.shape/fir.shape_shift op. Empty result if
 /// \p shapeVal is empty or is a fir.shift.
-inline std::vector<mlir::Value> getExtents(mlir::Value shapeVal) {
+inline llvm::SmallVector<mlir::Value> getExtents(mlir::Value shapeVal) {
   if (shapeVal)
     if (auto *shapeOp = shapeVal.getDefiningOp()) {
       if (auto shOp = mlir::dyn_cast<fir::ShapeOp>(shapeOp)) {
         auto operands = shOp.getExtents();
         return {operands.begin(), operands.end()};
       }
-      if (auto shOp = mlir::dyn_cast<fir::ShapeShiftOp>(shapeOp))
-        return shOp.getExtents();
+      if (auto shOp = mlir::dyn_cast<fir::ShapeShiftOp>(shapeOp)) {
+        auto operands = shOp.getExtents();
+        return {operands.begin(), operands.end()};
+      }
     }
   return {};
 }
 
 /// Get origins from fir.shape_shift/fir.shift op. Empty result if
 /// \p shapeVal is empty or is a fir.shape.
-inline std::vector<mlir::Value> getOrigins(mlir::Value shapeVal) {
+inline llvm::SmallVector<mlir::Value> getOrigins(mlir::Value shapeVal) {
   if (shapeVal)
     if (auto *shapeOp = shapeVal.getDefiningOp()) {
-      if (auto shOp = mlir::dyn_cast<fir::ShapeShiftOp>(shapeOp))
-        return shOp.getOrigins();
+      if (auto shOp = mlir::dyn_cast<fir::ShapeShiftOp>(shapeOp)) {
+        auto operands = shOp.getOrigins();
+        return {operands.begin(), operands.end()};
+      }
       if (auto shOp = mlir::dyn_cast<fir::ShiftOp>(shapeOp)) {
         auto operands = shOp.getOrigins();
         return {operands.begin(), operands.end()};
       }
     }
   return {};
 }
 

flang/include/flang/Optimizer/Dialect/FIRType.h

 /// Is `t` a FIR dialect type that implies a memory (de)reference?
 inline bool isa_ref_type(mlir::Type t) {
   return t.isa<ReferenceType>() || t.isa<PointerType>() || t.isa<HeapType>() ||
          t.isa<fir::LLVMPointerType>();
 }
 
 /// Is `t` a boxed type?
 inline bool isa_box_type(mlir::Type t) {
-  return t.isa<BoxType>() || t.isa<BoxCharType>() || t.isa<BoxProcType>();
+  return t.isa<fir::BoxType, fir::BoxCharType, fir::BoxProcType>();
 }
 
 /// Is `t` a type that is always trivially pass-by-reference? Specifically, this
 /// is testing if `t` is a ReferenceType or any box type. Compare this to
 /// conformsWithPassByRef(), which includes pointers and allocatables.
 inline bool isa_passbyref_type(mlir::Type t) {
-  return t.isa<ReferenceType>() || isa_box_type(t) ||
-         t.isa<mlir::FunctionType>();
+  return t.isa<fir::ReferenceType, mlir::FunctionType>() || isa_box_type(t);
 }
 
 /// Is `t` a type that can conform to be pass-by-reference? Depending on the
 /// context, these types may simply demote to pass-by-reference or a reference
 /// to them may have to be passed instead. Functions are always referent.
 inline bool conformsWithPassByRef(mlir::Type t) {
   return isa_ref_type(t) || isa_box_type(t) || t.isa<mlir::FunctionType>();
 }
 
 /// Is `t` a derived (record) type?
 inline bool isa_derived(mlir::Type t) { return t.isa<fir::RecordType>(); }
 
 /// Is `t` a FIR dialect aggregate type?
 inline bool isa_aggregate(mlir::Type t) {
-  return t.isa<SequenceType>() || fir::isa_derived(t) ||
-         t.isa<mlir::TupleType>();
+  return t.isa<SequenceType, mlir::TupleType>() || fir::isa_derived(t);
 }
 
 /// Extract the `Type` pointed to from a FIR memory reference type. If `t` is
 /// not a memory reference type, then returns a null `Type`.
 mlir::Type dyn_cast_ptrEleTy(mlir::Type t);
 
 /// Extract the `Type` pointed to from a FIR memory reference or box type. If
 /// `t` is not a memory reference or box type, then returns a null `Type`.
 mlir::Type dyn_cast_ptrOrBoxEleTy(mlir::Type t);
 
 /// Is `t` a FIR Real or MLIR Float type?
 inline bool isa_real(mlir::Type t) {
-  return t.isa<fir::RealType>() || t.isa<mlir::FloatType>();
+  return t.isa<fir::RealType, mlir::FloatType>();
 }
 
 /// Is `t` an integral type?
 inline bool isa_integer(mlir::Type t) {
-  return t.isa<mlir::IndexType>() || t.isa<mlir::IntegerType>() ||
-         t.isa<fir::IntegerType>();
+  return t.isa<mlir::IndexType, mlir::IntegerType, fir::IntegerType>();
 }
 
 mlir::Type parseFirType(FIROpsDialect *, mlir::DialectAsmParser &parser);
 
 void printFirType(FIROpsDialect *, mlir::Type ty, mlir::DialectAsmPrinter &p);
 
 /// Guarantee `type` is a scalar integral type (standard Integer, standard
 /// Index, or FIR Int). Aborts execution if condition is false.
 void verifyIntegralType(mlir::Type type);
 
 /// Is `t` a FIR or MLIR Complex type?
 inline bool isa_complex(mlir::Type t) {
-  return t.isa<fir::ComplexType>() || t.isa<mlir::ComplexType>();
+  return t.isa<fir::ComplexType, mlir::ComplexType>();
 }
 
 /// Is `t` a CHARACTER type? Does not check the length.
 inline bool isa_char(mlir::Type t) { return t.isa<fir::CharacterType>(); }
 
 /// Is `t` a trivial intrinsic type? CHARACTER is <em>excluded</em> because it
 /// is a dependent type.
 inline bool isa_trivial(mlir::Type t) {

 /// If `t` conforms with a pass-by-reference type (box, ref, ptr, etc.) then
 /// return the element type of `t`. Otherwise, return `t`.
 inline mlir::Type unwrapPassByRefType(mlir::Type t) {
   if (auto eleTy = dyn_cast_ptrOrBoxEleTy(t))
     return eleTy;
   return t;
 }
 
+/// Unwrap either a sequence or a boxed sequence type, returning the element
+/// type of the sequence type.
+/// e.g.,
+///   !fir.array<...xT>  ->  T
+///   !fir.box<!fir.ptr<!fir.array<...xT>>>  ->  T
+/// otherwise
+///   T -> T
+mlir::Type unwrapSeqOrBoxedSeqType(mlir::Type ty);
+
+/// Unwrap all referential and sequential outer types (if any). Returns the
+/// element type. This is useful for determining the element type of any object
+/// memory reference, whether it is a single instance or a series of instances.
+mlir::Type unwrapAllRefAndSeqType(mlir::Type ty);
+
 /// Unwrap all pointer and box types and return the element type if it is a
 /// sequence type, otherwise return null.
 inline fir::SequenceType unwrapUntilSeqType(mlir::Type t) {
   while (true) {
     if (!t)
       return {};
     if (auto ty = dyn_cast_ptrOrBoxEleTy(t)) {
       t = ty;

 
 /// Return true iff `ty` is the type of a POINTER entity or value.
 /// `isa_ref_type()` can be used to distinguish.
 bool isPointerType(mlir::Type ty);
 
 /// Return true iff `ty` is the type of an ALLOCATABLE entity or value.
 bool isAllocatableType(mlir::Type ty);
 
+/// Return true iff `ty` is the type of an unlimited polymorphic entity or
+/// value.
+bool isUnlimitedPolymorphicType(mlir::Type ty);
+
 /// Return true iff `ty` is a RecordType with members that are allocatable.
 bool isRecordWithAllocatableMember(mlir::Type ty);
 
 /// Return true iff `ty` is a RecordType with type parameters.
 inline bool isRecordWithTypeParameters(mlir::Type ty) {
   if (auto recTy = ty.dyn_cast_or_null<fir::RecordType>())
     return recTy.getNumLenParams() != 0;
   return false;

flang/include/flang/Runtime/io-api.h

bool IONAME(OutputUnformattedBlock)(
     Cookie, const char *, std::size_t, std::size_t elementBytes);
 bool IONAME(InputUnformattedBlock)(
     Cookie, char *, std::size_t, std::size_t elementBytes);
 // Formatted (including list directed) I/O data items
 bool IONAME(OutputInteger8)(Cookie, std::int8_t);
 bool IONAME(OutputInteger16)(Cookie, std::int16_t);
 bool IONAME(OutputInteger32)(Cookie, std::int32_t);
 bool IONAME(OutputInteger64)(Cookie, std::int64_t);
-#ifdef __SIZEOF_INT128__
 bool IONAME(OutputInteger128)(Cookie, common::int128_t);
-#endif
 bool IONAME(InputInteger)(Cookie, std::int64_t &, int kind = 8);
 bool IONAME(OutputReal32)(Cookie, float);
 bool IONAME(InputReal32)(Cookie, float &);
 bool IONAME(OutputReal64)(Cookie, double);
 bool IONAME(InputReal64)(Cookie, double &);
 bool IONAME(OutputComplex32)(Cookie, float, float);
 bool IONAME(InputComplex32)(Cookie, float[2]);
 bool IONAME(OutputComplex64)(Cookie, double, double);

flang/lib/Lower/Allocatable.cpp

 //===-- Allocatable.cpp -- Allocatable statements lowering ----------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 //
 // Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/
 //
 //===----------------------------------------------------------------------===//
 
 #include "flang/Lower/Allocatable.h"
 #include "flang/Evaluate/tools.h"
 #include "flang/Lower/AbstractConverter.h"
+#include "flang/Lower/IterationSpace.h"
 #include "flang/Lower/PFTBuilder.h"
 #include "flang/Lower/Runtime.h"
 #include "flang/Lower/StatementContext.h"
 #include "flang/Lower/Todo.h"
 #include "flang/Optimizer/Builder/FIRBuilder.h"
 #include "flang/Optimizer/Builder/Runtime/RTBuilder.h"
 #include "flang/Optimizer/Dialect/FIROps.h"
 #include "flang/Optimizer/Dialect/FIROpsSupport.h"

 struct ErrorManager {
   void init(Fortran::lower::AbstractConverter &converter, mlir::Location loc,
             const Fortran::lower::SomeExpr *statExpr,
             const Fortran::lower::SomeExpr *errMsgExpr) {
     Fortran::lower::StatementContext stmtCtx;
     fir::FirOpBuilder &builder = converter.getFirOpBuilder();
     hasStat = builder.createBool(loc, statExpr != nullptr);
     statAddr = statExpr
-                   ? fir::getBase(converter.genExprAddr(statExpr, stmtCtx, loc))
+                   ? fir::getBase(converter.genExprAddr(loc, statExpr, stmtCtx))
                    : mlir::Value{};
     errMsgAddr =
         statExpr && errMsgExpr
             ? builder.createBox(loc,
-                                converter.genExprAddr(errMsgExpr, stmtCtx, loc))
+                                converter.genExprAddr(loc, errMsgExpr, stmtCtx))
             : builder.create<fir::AbsentOp>(
                   loc,
                   fir::BoxType::get(mlir::NoneType::get(builder.getContext())));
     sourceFile = fir::factory::locationToFilename(builder, loc);
     sourceLine = fir::factory::locationToLineNo(builder, loc,
                                                 builder.getIntegerType(32));
   }
 
void genInlinedAllocation(const Allocation &alloc,
     mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1);
     for (const Fortran::parser::AllocateShapeSpec &shapeSpec :
          alloc.getShapeSpecs()) {
       mlir::Value lb;
       if (!lBoundsAreOnes) {
         if (const std::optional<Fortran::parser::BoundExpr> &lbExpr =
                 std::get<0>(shapeSpec.t)) {
           lb = fir::getBase(converter.genExprValue(
-              Fortran::semantics::GetExpr(*lbExpr), stmtCtx, loc));
+              loc, Fortran::semantics::GetExpr(*lbExpr), stmtCtx));
           lb = builder.createConvert(loc, idxTy, lb);
         } else {
           lb = one;
         }
         lbounds.emplace_back(lb);
       }
       mlir::Value ub = fir::getBase(converter.genExprValue(
-          Fortran::semantics::GetExpr(std::get<1>(shapeSpec.t)), stmtCtx, loc));
+          loc, Fortran::semantics::GetExpr(std::get<1>(shapeSpec.t)), stmtCtx));
       ub = builder.createConvert(loc, idxTy, ub);
       if (lb) {
         mlir::Value diff = builder.create<mlir::arith::SubIOp>(loc, ub, lb);
         extents.emplace_back(
             builder.create<mlir::arith::AddIOp>(loc, diff, one));
       } else {
         extents.emplace_back(ub);
       }
void genSimpleAllocation(const Allocation &alloc,
     mlir::Type i32Ty = builder.getIntegerType(32);
     Fortran::lower::StatementContext stmtCtx;
     for (const auto &iter : llvm::enumerate(alloc.getShapeSpecs())) {
       mlir::Value lb;
       const auto &bounds = iter.value().t;
       if (const std::optional<Fortran::parser::BoundExpr> &lbExpr =
               std::get<0>(bounds))
         lb = fir::getBase(converter.genExprValue(
-            Fortran::semantics::GetExpr(*lbExpr), stmtCtx, loc));
+            loc, Fortran::semantics::GetExpr(*lbExpr), stmtCtx));
       else
         lb = builder.createIntegerConstant(loc, idxTy, 1);
       mlir::Value ub = fir::getBase(converter.genExprValue(
-          Fortran::semantics::GetExpr(std::get<1>(bounds)), stmtCtx, loc));
+          loc, Fortran::semantics::GetExpr(std::get<1>(bounds)), stmtCtx));
       mlir::Value dimIndex =
           builder.createIntegerConstant(loc, i32Ty, iter.index());
       // Runtime call
       genRuntimeSetBounds(builder, loc, box, dimIndex, lb, ub);
     }
     mlir::Value stat = genRuntimeAllocate(builder, loc, box, errorManager);
     fir::factory::syncMutableBoxFromIRBox(builder, loc, box);
     errorManager.assignStat(builder, loc, stat);
void lowerAllocateLengthParameters() {
     if (typeSpec->category() ==
         Fortran::semantics::DeclTypeSpec::Category::Character) {
       Fortran::semantics::ParamValue lenParam =
           typeSpec->characterTypeSpec().length();
       if (Fortran::semantics::MaybeIntExpr intExpr = lenParam.GetExplicit()) {
         Fortran::lower::StatementContext stmtCtx;
         Fortran::lower::SomeExpr lenExpr{*intExpr};
         lenParams.push_back(
-            fir::getBase(converter.genExprValue(lenExpr, stmtCtx, &loc)));
+            fir::getBase(converter.genExprValue(loc, lenExpr, stmtCtx)));
       }
     }
   }
 
   // Set length parameters in the box stored in boxAddr.
   // This must be called before setting the bounds because it may use
   // Init runtime calls that may set the bounds to zero.
   void genSetDeferredLengthParameters(const Allocation &alloc,
static void genDeallocate(fir::FirOpBuilder &builder, mlir::Location loc,
   mlir::Value stat = genRuntimeDeallocate(builder, loc, box, errorManager);
   fir::factory::syncMutableBoxFromIRBox(builder, loc, box);
   errorManager.assignStat(builder, loc, stat);
 }
 
 void Fortran::lower::genDeallocateStmt(
     Fortran::lower::AbstractConverter &converter,
     const Fortran::parser::DeallocateStmt &stmt, mlir::Location loc) {
-  const Fortran::lower::SomeExpr *statExpr{nullptr};
-  const Fortran::lower::SomeExpr *errMsgExpr{nullptr};
+  const Fortran::lower::SomeExpr *statExpr = nullptr;
+  const Fortran::lower::SomeExpr *errMsgExpr = nullptr;
   for (const Fortran::parser::StatOrErrmsg &statOrErr :
        std::get<std::list<Fortran::parser::StatOrErrmsg>>(stmt.t))
     std::visit(Fortran::common::visitors{
                    [&](const Fortran::parser::StatVariable &statVar) {
                      statExpr = Fortran::semantics::GetExpr(statVar);
                    },
                    [&](const Fortran::parser::MsgVariable &errMsgVar) {
                      errMsgExpr = Fortran::semantics::GetExpr(errMsgVar);
if (!var.isGlobal() && !Fortran::semantics::IsDummy(var.getSymbol()))
     fir::factory::disassociateMutableBox(builder, loc, box);
   return box;
 }
 
 //===----------------------------------------------------------------------===//
 // MutableBoxValue reading interface implementation
 //===----------------------------------------------------------------------===//
 
-static bool
-isArraySectionWithoutVectorSubscript(const Fortran::lower::SomeExpr &expr) {
+bool Fortran::lower::isArraySectionWithoutVectorSubscript(
+    const Fortran::lower::SomeExpr &expr) {
   return expr.Rank() > 0 && Fortran::evaluate::IsVariable(expr) &&
          !Fortran::evaluate::UnwrapWholeSymbolDataRef(expr) &&
          !Fortran::evaluate::HasVectorSubscript(expr);
 }
 
 void Fortran::lower::associateMutableBox(
     Fortran::lower::AbstractConverter &converter, mlir::Location loc,
     const fir::MutableBoxValue &box, const Fortran::lower::SomeExpr &source,
     mlir::ValueRange lbounds, Fortran::lower::StatementContext &stmtCtx) {
   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
   if (Fortran::evaluate::UnwrapExpr<Fortran::evaluate::NullPointer>(source)) {
     fir::factory::disassociateMutableBox(builder, loc, box);
     return;
   }
-  // The right hand side must not be evaluated in a temp.
-  // Array sections can be described by fir.box without making a temp.
-  // Otherwise, do not generate a fir.box to avoid having to later use a
-  // fir.rebox to implement the pointer association.
+
+  // The right hand side is not be evaluated into a temp. Array sections can
+  // typically be represented as a value of type `!fir.box`. However, an
+  // expression that uses vector subscripts cannot be emboxed. In that case,
+  // generate a reference to avoid having to later use a fir.rebox to implement
+  // the pointer association.
   fir::ExtendedValue rhs = isArraySectionWithoutVectorSubscript(source)
-                               ? converter.genExprBox(source, stmtCtx, loc)
-                               : converter.genExprAddr(source, stmtCtx);
+                               ? converter.genExprBox(loc, source, stmtCtx)
+                               : converter.genExprAddr(loc, source, stmtCtx);
   fir::factory::associateMutableBox(builder, loc, box, rhs, lbounds);
 }
+
+bool Fortran::lower::isWholeAllocatable(const Fortran::lower::SomeExpr &expr) {
+  if (const Fortran::semantics::Symbol *sym =
+          Fortran::evaluate::UnwrapWholeSymbolOrComponentDataRef(expr))
+    return Fortran::semantics::IsAllocatable(*sym);
+  return false;
+}
+
+bool Fortran::lower::isWholePointer(const Fortran::lower::SomeExpr &expr) {
+  if (const Fortran::semantics::Symbol *sym =
+          Fortran::evaluate::UnwrapWholeSymbolOrComponentDataRef(expr))
+    return Fortran::semantics::IsPointer(*sym);
+  return false;
+}

flang/lib/Lower/Bridge.cpp

public:
   }
   fir::ExtendedValue
   genExprValue(const Fortran::lower::SomeExpr &expr,
                Fortran::lower::StatementContext &context,
                mlir::Location *loc = nullptr) override final {
     return Fortran::lower::createSomeExtendedExpression(
         loc ? *loc : toLocation(), *this, expr, localSymbols, context);
   }
-  fir::MutableBoxValue
-  genExprMutableBox(mlir::Location loc,
-                    const Fortran::lower::SomeExpr &expr) override final {
-    return Fortran::lower::createMutableBox(loc, *this, expr, localSymbols);
-  }
-  fir::ExtendedValue genExprBox(const Fortran::lower::SomeExpr &expr,
-                                Fortran::lower::StatementContext &context,
-                                mlir::Location loc) override final {
+
+  fir::ExtendedValue
+  genExprBox(mlir::Location loc, const Fortran::lower::SomeExpr &expr,
+             Fortran::lower::StatementContext &stmtCtx) override final {
     return Fortran::lower::createBoxValue(loc, *this, expr, localSymbols,
-                                          context);
+                                          stmtCtx);
   }
 
   Fortran::evaluate::FoldingContext &getFoldingContext() override final {
     return foldingContext;
   }
 
   mlir::Type genType(const Fortran::lower::SomeExpr &expr) override final {
     return Fortran::lower::translateSomeExprToFIRType(*this, expr);
bool createHostAssociateVarClone(
     fir::ExtendedValue exv = hexv.match(
         [&](const fir::BoxValue &box) -> fir::ExtendedValue {
           const Fortran::semantics::DeclTypeSpec *type = sym.GetType();
           if (type && type->IsPolymorphic())
             TODO(loc, "create polymorphic host associated copy");
           // Create a contiguous temp with the same shape and length as
           // the original variable described by a fir.box.
           llvm::SmallVector<mlir::Value> extents =
-              fir::factory::getExtents(*builder, loc, hexv);
-          if (box.isDerivedWithLengthParameters())
+              fir::factory::getExtents(loc, *builder, hexv);
+          if (box.isDerivedWithLenParameters())
             TODO(loc, "get length parameters from derived type BoxValue");
           if (box.isCharacter()) {
             mlir::Value len = fir::factory::readCharLen(*builder, loc, box);
             mlir::Value temp = allocate(extents, {len});
             return fir::CharArrayBoxValue{temp, len, extents};
           }
           return fir::ArrayBoxValue{allocate(extents, {}), extents};
         },
         [&](const fir::MutableBoxValue &box) -> fir::ExtendedValue {
           // Allocate storage for a pointer/allocatble descriptor.
           // No shape/lengths to be passed to the alloca.
           return fir::MutableBoxValue(allocate({}, {}),
                                       box.nonDeferredLenParams(), {});
         },
         [&](const auto &) -> fir::ExtendedValue {
           mlir::Value temp =
-              allocate(fir::factory::getExtents(*builder, loc, hexv),
+              allocate(fir::factory::getExtents(loc, *builder, hexv),
                        fir::getTypeParams(hexv));
           return fir::substBase(hexv, temp);
         });
 
     return bindIfNewSymbol(sym, exv);
   }
 
   void
void genFIR(const Fortran::parser::SelectCaseStmt &stmt) {
     builder->setInsertionPointToEnd(eval.parentConstruct->constructExit->block);
     stmtCtx.finalize();
     builder->restoreInsertionPoint(insertPt);
   }
 
   fir::ExtendedValue
   genAssociateSelector(const Fortran::lower::SomeExpr &selector,
                        Fortran::lower::StatementContext &stmtCtx) {
-    return isArraySectionWithoutVectorSubscript(selector)
+    return Fortran::lower::isArraySectionWithoutVectorSubscript(selector)
                ? Fortran::lower::createSomeArrayBox(*this, selector,
                                                     localSymbols, stmtCtx)
                : genExprAddr(selector, stmtCtx);
   }
 
   void genFIR(const Fortran::parser::AssociateConstruct &) {
     Fortran::lower::StatementContext stmtCtx;
     Fortran::lower::pft::Evaluation &eval = getEval();

   /// Return true if context is currently an explicit iteration space. A scalar
   /// assignment expression may be contextually within a user-defined iteration
   /// space, transforming it into an array expression.
   bool explicitIterationSpace() { return explicitIterSpace.isActive(); }
 
   /// Generate an array assignment.
   /// This is an assignment expression with rank > 0. The assignment may or may
   /// not be in a WHERE and/or FORALL context.
-  void genArrayAssignment(const Fortran::evaluate::Assignment &assign,
-                          Fortran::lower::StatementContext &stmtCtx) {
-    if (isWholeAllocatable(assign.lhs)) {
+  /// In a FORALL context, the assignment may be a pointer assignment and the \p
+  /// lbounds and \p ubounds parameters should only be used in such a pointer
+  /// assignment case. (If both are None then the array assignment cannot be a
+  /// pointer assignment.)
+  void genArrayAssignment(
+      const Fortran::evaluate::Assignment &assign,
+      Fortran::lower::StatementContext &stmtCtx,
+      llvm::Optional<llvm::SmallVector<mlir::Value>> lbounds = llvm::None,
+      llvm::Optional<llvm::SmallVector<mlir::Value>> ubounds = llvm::None) {
+    if (Fortran::lower::isWholeAllocatable(assign.lhs)) {
       // Assignment to allocatables may require the lhs to be
       // deallocated/reallocated. See Fortran 2018 10.2.1.3 p3
       Fortran::lower::createAllocatableArrayAssignment(
           *this, assign.lhs, assign.rhs, explicitIterSpace, implicitIterSpace,
           localSymbols, stmtCtx);
       return;
     }
 
+    if (lbounds.hasValue()) {
+      // Array of POINTER entities, with elemental assignment.
+      if (!Fortran::lower::isWholePointer(assign.lhs))
+        fir::emitFatalError(toLocation(), "pointer assignment to non-pointer");
+
+      Fortran::lower::createArrayOfPointerAssignment(
+          *this, assign.lhs, assign.rhs, explicitIterSpace, implicitIterSpace,
+          lbounds.getValue(), ubounds, localSymbols, stmtCtx);
+      return;
+    }
+
     if (!implicitIterationSpace() && !explicitIterationSpace()) {
       // No masks and the iteration space is implied by the array, so create a
       // simple array assignment.
       Fortran::lower::createSomeArrayAssignment(*this, assign.lhs, assign.rhs,
                                                 localSymbols, stmtCtx);
       return;
     }
 
     // If there is an explicit iteration space, generate an array assignment
     // with a user-specified iteration space and possibly with masks. These
     // assignments may *appear* to be scalar expressions, but the scalar
     // expression is evaluated at all points in the user-defined space much like
     // an ordinary array assignment. More specifically, the semantics inside the
     // FORALL much more closely resembles that of WHERE than a scalar
     // assignment.
     // Otherwise, generate a masked array assignment. The iteration space is
     // implied by the lhs array expression.
     Fortran::lower::createAnyMaskedArrayAssignment(
         *this, assign.lhs, assign.rhs, explicitIterSpace, implicitIterSpace,
         localSymbols,
         explicitIterationSpace() ? explicitIterSpace.stmtContext()
                                  : implicitIterSpace.stmtContext());
   }
 
-  static bool
-  isArraySectionWithoutVectorSubscript(const Fortran::lower::SomeExpr &expr) {
-    return expr.Rank() > 0 && Fortran::evaluate::IsVariable(expr) &&
-           !Fortran::evaluate::UnwrapWholeSymbolDataRef(expr) &&
-           !Fortran::evaluate::HasVectorSubscript(expr);
-  }
-
 #if !defined(NDEBUG)
   static bool isFuncResultDesignator(const Fortran::lower::SomeExpr &expr) {
     const Fortran::semantics::Symbol *sym =
         Fortran::evaluate::GetFirstSymbol(expr);
     return sym && sym->IsFuncResult();
   }
 #endif
 
-  static bool isWholeAllocatable(const Fortran::lower::SomeExpr &expr) {
-    const Fortran::semantics::Symbol *sym =
-        Fortran::evaluate::UnwrapWholeSymbolOrComponentDataRef(expr);
-    return sym && Fortran::semantics::IsAllocatable(*sym);
+  inline fir::MutableBoxValue
+  genExprMutableBox(mlir::Location loc,
+                    const Fortran::lower::SomeExpr &expr) override final {
+    return Fortran::lower::createMutableBox(loc, *this, expr, localSymbols);
   }
 
   /// Shared for both assignments and pointer assignments.
   void genAssignment(const Fortran::evaluate::Assignment &assign) {
     Fortran::lower::StatementContext stmtCtx;
     mlir::Location loc = toLocation();
     if (explicitIterationSpace()) {
       Fortran::lower::createArrayLoads(*this, explicitIterSpace, localSymbols);
std::visit(
               if (!sym)
                 TODO(loc, "assignment to pointer result of function reference");
 
               std::optional<Fortran::evaluate::DynamicType> lhsType =
                   assign.lhs.GetType();
               assert(lhsType && "lhs cannot be typeless");
               // Assignment to polymorphic allocatables may require changing the
               // variable dynamic type (See Fortran 2018 10.2.1.3 p3).
-              if (lhsType->IsPolymorphic() && isWholeAllocatable(assign.lhs))
+              if (lhsType->IsPolymorphic() &&
+                  Fortran::lower::isWholeAllocatable(assign.lhs))
                 TODO(loc, "assignment to polymorphic allocatable");
 
               // Note: No ad-hoc handling for pointers is required here. The
               // target will be assigned as per 2018 10.2.1.3 p2. genExprAddr
               // on a pointer returns the target address and not the address of
               // the pointer variable.
 
               if (assign.lhs.Rank() > 0 || explicitIterationSpace()) {
                 // Array assignment
                 // See Fortran 2018 10.2.1.3 p5, p6, and p7
                 genArrayAssignment(assign, stmtCtx);
                 return;
               }
 
               // Scalar assignment
               const bool isNumericScalar =
                   isNumericScalarCategory(lhsType->category());
               fir::ExtendedValue rhs = isNumericScalar
                                            ? genExprValue(assign.rhs, stmtCtx)
                                            : genExprAddr(assign.rhs, stmtCtx);
-              bool lhsIsWholeAllocatable = isWholeAllocatable(assign.lhs);
+              const bool lhsIsWholeAllocatable =
+                  Fortran::lower::isWholeAllocatable(assign.lhs);
               llvm::Optional<fir::factory::MutableBoxReallocation> lhsRealloc;
               llvm::Optional<fir::MutableBoxValue> lhsMutableBox;
               auto lhs = [&]() -> fir::ExtendedValue {
                 if (lhsIsWholeAllocatable) {
                   lhsMutableBox = genExprMutableBox(loc, assign.lhs);
                   llvm::SmallVector<mlir::Value> lengthParams;
                   if (const fir::CharBoxValue *charBox = rhs.getCharBox())
                     lengthParams.push_back(charBox->getLen());
-                  else if (fir::isDerivedWithLengthParameters(rhs))
+                  else if (fir::isDerivedWithLenParameters(rhs))
                     TODO(loc, "assignment to derived type allocatable with "
                               "length parameters");
                   lhsRealloc = fir::factory::genReallocIfNeeded(
                       *builder, loc, *lhsMutableBox,
                       /*shape=*/llvm::None, lengthParams);
                   return lhsRealloc->newValue;
                 }
                 return genExprAddr(assign.lhs, stmtCtx);
std::visit(
               Fortran::lower::createSubroutineCall(
                   *this, procRef, explicitIterSpace, implicitIterSpace,
                   localSymbols, ctx, /*isUserDefAssignment=*/true);
             },
 
             // [3] Pointer assignment with possibly empty bounds-spec. R1035: a
             // bounds-spec is a lower bound value.
             [&](const Fortran::evaluate::Assignment::BoundsSpec &lbExprs) {
-              if (IsProcedure(assign.rhs))
+              if (Fortran::evaluate::IsProcedure(assign.rhs))
                 TODO(loc, "procedure pointer assignment");
               std::optional<Fortran::evaluate::DynamicType> lhsType =
                   assign.lhs.GetType();
               std::optional<Fortran::evaluate::DynamicType> rhsType =
                   assign.rhs.GetType();
               // Polymorphic lhs/rhs may need more care. See F2018 10.2.2.3.
               if ((lhsType && lhsType->IsPolymorphic()) ||
                   (rhsType && rhsType->IsPolymorphic()))
                 TODO(loc, "pointer assignment involving polymorphic entity");
 
-              // FIXME: in the explicit space context, we want to use
-              // ScalarArrayExprLowering here.
-              fir::MutableBoxValue lhs = genExprMutableBox(loc, assign.lhs);
               llvm::SmallVector<mlir::Value> lbounds;
               for (const Fortran::evaluate::ExtentExpr &lbExpr : lbExprs)
                 lbounds.push_back(
                     fir::getBase(genExprValue(toEvExpr(lbExpr), stmtCtx)));
-              Fortran::lower::associateMutableBox(*this, loc, lhs, assign.rhs,
-                                                  lbounds, stmtCtx);
               if (explicitIterationSpace()) {
-                mlir::ValueRange inners = explicitIterSpace.getInnerArgs();
-                if (!inners.empty()) {
-                  // TODO: should force a copy-in/copy-out here.
-                  // e.g., obj%ptr(i+1) => obj%ptr(i)
-                  builder->create<fir::ResultOp>(loc, inners);
-                }
+                // Pointer assignment in FORALL context. Copy the rhs box value
+                // into the lhs box variable.
+                genArrayAssignment(assign, stmtCtx, lbounds);
+                return;
               }
+              fir::MutableBoxValue lhs = genExprMutableBox(loc, assign.lhs);
+              Fortran::lower::associateMutableBox(*this, loc, lhs, assign.rhs,
+                                                  lbounds, stmtCtx);
             },
 
             // [4] Pointer assignment with bounds-remapping. R1036: a
             // bounds-remapping is a pair, lower bound and upper bound.
             [&](const Fortran::evaluate::Assignment::BoundsRemapping
                     &boundExprs) {
               std::optional<Fortran::evaluate::DynamicType> lhsType =
                   assign.lhs.GetType();
               std::optional<Fortran::evaluate::DynamicType> rhsType =
                   assign.rhs.GetType();
               // Polymorphic lhs/rhs may need more care. See F2018 10.2.2.3.
               if ((lhsType && lhsType->IsPolymorphic()) ||
                   (rhsType && rhsType->IsPolymorphic()))
                 TODO(loc, "pointer assignment involving polymorphic entity");
 
-              // FIXME: in the explicit space context, we want to use
-              // ScalarArrayExprLowering here.
-              fir::MutableBoxValue lhs = genExprMutableBox(loc, assign.lhs);
-              if (Fortran::evaluate::UnwrapExpr<Fortran::evaluate::NullPointer>(
-                      assign.rhs)) {
-                fir::factory::disassociateMutableBox(*builder, loc, lhs);
-                return;
-              }
               llvm::SmallVector<mlir::Value> lbounds;
               llvm::SmallVector<mlir::Value> ubounds;
               for (const std::pair<Fortran::evaluate::ExtentExpr,
                                    Fortran::evaluate::ExtentExpr> &pair :
                    boundExprs) {
                 const Fortran::evaluate::ExtentExpr &lbExpr = pair.first;
                 const Fortran::evaluate::ExtentExpr &ubExpr = pair.second;
                 lbounds.push_back(
                     fir::getBase(genExprValue(toEvExpr(lbExpr), stmtCtx)));
                 ubounds.push_back(
                     fir::getBase(genExprValue(toEvExpr(ubExpr), stmtCtx)));
               }
+              if (explicitIterationSpace()) {
+                // Pointer assignment in FORALL context. Copy the rhs box value
+                // into the lhs box variable.
+                genArrayAssignment(assign, stmtCtx, lbounds, ubounds);
+                return;
+              }
+              fir::MutableBoxValue lhs = genExprMutableBox(loc, assign.lhs);
+              if (Fortran::evaluate::UnwrapExpr<Fortran::evaluate::NullPointer>(
+                      assign.rhs)) {
+                fir::factory::disassociateMutableBox(*builder, loc, lhs);
+                return;
+              }
               // Do not generate a temp in case rhs is an array section.
               fir::ExtendedValue rhs =
-                  isArraySectionWithoutVectorSubscript(assign.rhs)
+                  Fortran::lower::isArraySectionWithoutVectorSubscript(
+                      assign.rhs)
                       ? Fortran::lower::createSomeArrayBox(
                             *this, assign.rhs, localSymbols, stmtCtx)
                       : genExprAddr(assign.rhs, stmtCtx);
               fir::factory::associateMutableBoxWithRemap(*builder, loc, lhs,
                                                          rhs, lbounds, ubounds);
               if (explicitIterationSpace()) {
                 mlir::ValueRange inners = explicitIterSpace.getInnerArgs();
-                if (!inners.empty()) {
-                  // TODO: should force a copy-in/copy-out here.
-                  // e.g., obj%ptr(i+1) => obj%ptr(i)
+                if (!inners.empty())
                   builder->create<fir::ResultOp>(loc, inners);
-                }
-              }
             },
         },
         assign.u);
     if (explicitIterationSpace())
       Fortran::lower::createArrayMergeStores(*this, explicitIterSpace);
   }
 
   void genFIR(const Fortran::parser::WhereConstruct &c) {
#endif
 
   /// Map mlir function block arguments to the corresponding Fortran dummy
   /// variables. When the result is passed as a hidden argument, the Fortran
   /// result is also mapped. The symbol map is used to hold this mapping.
   void mapDummiesAndResults(Fortran::lower::pft::FunctionLikeUnit &funit,
                             const Fortran::lower::CalleeInterface &callee) {
     assert(builder && "require a builder object at this point");
     using PassBy = Fortran::lower::CalleeInterface::PassEntityBy;
-    auto mapPassedEntity = [&](const auto arg) -> void {
+    auto mapPassedEntity = [&](const auto arg) {
       if (arg.passBy == PassBy::AddressAndLength) {
         // TODO: now that fir call has some attributes regarding character
         // return, PassBy::AddressAndLength should be retired.
         mlir::Location loc = toLocation();
         fir::factory::CharacterExprHelper charHelp{*builder, loc};
         mlir::Value box =
             charHelp.createEmboxChar(arg.firArgument, arg.firLength);
         addSymbol(arg.entity->get(), box);

flang/lib/Lower/ComponentPath.cpp

if (std::visit(
                   return e.value().Rank() > 0;
                 }},
             sub.u))
       return true;
   }
   return false;
 }
 
+void Fortran::lower::ComponentPath::resetPC() { pc = getIdentityFunc(); }
+
 void Fortran::lower::ComponentPath::setPC(bool isImplicit) {
   pc = isImplicit ? getIdentityFunc() : getNullaryFunc();
+  resetExtendCoorRef();
+}
+
+Fortran::lower::ComponentPath::ExtendRefFunc
+Fortran::lower::ComponentPath::getExtendCoorRef() const {
+  return hasExtendCoorRef() ? extendCoorRef.getValue()
+                            : [](mlir::Value v) { return v; };
 }

flang/lib/Lower/ConvertExpr.cpp

 #include "flang/Optimizer/Dialect/FIRDialect.h"
 #include "flang/Optimizer/Dialect/FIROpsSupport.h"
 #include "flang/Optimizer/Support/FatalError.h"
 #include "flang/Semantics/expression.h"
 #include "flang/Semantics/symbol.h"
 #include "flang/Semantics/tools.h"
 #include "flang/Semantics/type.h"
 #include "mlir/Dialect/Func/IR/FuncOps.h"
+#include "llvm/ADT/TypeSwitch.h"
 #include "llvm/Support/CommandLine.h"
 #include "llvm/Support/Debug.h"
 #include "llvm/Support/ErrorHandling.h"
 #include "llvm/Support/raw_ostream.h"
 #include <algorithm>
 
 #define DEBUG_TYPE "flang-lower-expr"
 

 /// Convert the array_load, `load`, to an extended value. If `path` is not
 /// empty, then traverse through the components designated. The base value is
 /// `newBase`. This does not accept an array_load with a slice operand.
 static fir::ExtendedValue
 arrayLoadExtValue(fir::FirOpBuilder &builder, mlir::Location loc,
                   fir::ArrayLoadOp load, llvm::ArrayRef<mlir::Value> path,
                   mlir::Value newBase, mlir::Value newLen = {}) {
   // Recover the extended value from the load.
-  assert(!load.getSlice() && "slice is not allowed");
+  if (load.getSlice())
+    fir::emitFatalError(loc, "array_load with slice is not allowed");
   mlir::Type arrTy = load.getType();
   if (!path.empty()) {
     mlir::Type ty = fir::applyPathToType(arrTy, path);
     if (!ty)
       fir::emitFatalError(loc, "path does not apply to type");
     if (!ty.isa<fir::SequenceType>()) {
       if (fir::isa_char(ty)) {
         mlir::Value len = newLen;
         if (!len)
           len = fir::factory::CharacterExprHelper{builder, loc}.getLength(
               load.getMemref());
         if (!len) {
           assert(load.getTypeparams().size() == 1 &&
                  "length must be in array_load");
           len = load.getTypeparams()[0];
         }
         return fir::CharBoxValue{newBase, len};
       }
       return newBase;
     }
     arrTy = ty.cast<fir::SequenceType>();
   }
 
-  // Use the shape op, if there is one.
-  mlir::Value shapeVal = load.getShape();
-  if (shapeVal) {
-    if (!mlir::isa<fir::ShiftOp>(shapeVal.getDefiningOp())) {
-      mlir::Type eleTy = fir::unwrapSequenceType(arrTy);
-      std::vector<mlir::Value> extents = fir::factory::getExtents(shapeVal);
-      std::vector<mlir::Value> origins = fir::factory::getOrigins(shapeVal);
-      if (fir::isa_char(eleTy)) {
-        mlir::Value len = newLen;
-        if (!len)
-          len = fir::factory::CharacterExprHelper{builder, loc}.getLength(
-              load.getMemref());
-        if (!len) {
-          assert(load.getTypeparams().size() == 1 &&
-                 "length must be in array_load");
-          len = load.getTypeparams()[0];
-        }
-        return fir::CharArrayBoxValue(newBase, len, extents, origins);
-      }
-      return fir::ArrayBoxValue(newBase, extents, origins);
+  auto arrayToExtendedValue =
+      [&](const llvm::SmallVector<mlir::Value> &extents,
+          const llvm::SmallVector<mlir::Value> &origins) -> fir::ExtendedValue {
+  };
+  // Use the shape op, if there is one.
+  mlir::Value shapeVal = load.getShape();
+  if (shapeVal) {
+    if (!mlir::isa<fir::ShiftOp>(shapeVal.getDefiningOp())) {
+      auto extents = fir::factory::getExtents(shapeVal);
+      auto origins = fir::factory::getOrigins(shapeVal);
+      return arrayToExtendedValue(extents, origins);
     }
     if (!fir::isa_box_type(load.getMemref().getType()))
       fir::emitFatalError(loc, "shift op is invalid in this context");
   }
 
-  // There is no shape or the array is in a box. Extents and lower bounds must
-  // be read at runtime.
-  if (path.empty() && !shapeVal) {
-    fir::ExtendedValue exv =
-        fir::factory::readBoxValue(builder, loc, load.getMemref());
-    return fir::substBase(exv, newBase);
-  }
-  TODO(loc, "component is boxed, retreive its type parameters");
+  // If we're dealing with the array_load op (not a subobject) and the load does
+  // not have any type parameters, then read the extents from the original box.
+  // The origin may be either from the box or a shift operation. Create and
+  // return the array extended value.
+  if (path.empty() && load.getTypeparams().empty()) {
+    auto oldBox = load.getMemref();
+    fir::ExtendedValue exv = fir::factory::readBoxValue(builder, loc, oldBox);
+    auto extents = fir::factory::getExtents(loc, builder, exv);
+    auto origins = fir::factory::getNonDefaultLowerBounds(builder, loc, exv);
+    if (shapeVal) {
+      // shapeVal is a ShiftOp and load.memref() is a boxed value.
+      newBase = builder.create<fir::ReboxOp>(loc, oldBox.getType(), oldBox,
+                                             shapeVal, /*slice=*/mlir::Value{});
+      origins = fir::factory::getOrigins(shapeVal);
+    }
+    return fir::substBase(arrayToExtendedValue(extents, origins), newBase);
+  }
+  TODO(loc, "path to a POINTER, ALLOCATABLE, or other component that requires "
+            "dereferencing; generating the type parameters is a hard "
+            "requirement for correctness.");
 }
 
 /// Place \p exv in memory if it is not already a memory reference. If
 /// \p forceValueType is provided, the value is first casted to the provided
 /// type before being stored (this is mainly intended for logicals whose value
 /// may be `i1` but needed to be stored as Fortran logicals).
 static fir::ExtendedValue
 placeScalarValueInMemory(fir::FirOpBuilder &builder, mlir::Location loc,

 
 // Copy a copy of scalar \p exv in a new temporary.
 static fir::ExtendedValue
 createInMemoryScalarCopy(fir::FirOpBuilder &builder, mlir::Location loc,
                          const fir::ExtendedValue &exv) {
   assert(exv.rank() == 0 && "input to scalar memory copy must be a scalar");
   if (exv.getCharBox() != nullptr)
     return fir::factory::CharacterExprHelper{builder, loc}.createTempFrom(exv);
-  if (fir::isDerivedWithLengthParameters(exv))
+  if (fir::isDerivedWithLenParameters(exv))
     TODO(loc, "copy derived type with length parameters");
   mlir::Type type = fir::unwrapPassByRefType(fir::getBase(exv).getType());
   fir::ExtendedValue temp = builder.createTemporary(loc, type);
   fir::factory::genScalarAssignment(builder, loc, temp, exv);
   return temp;
 }
 
 // An expression with non-zero rank is an array expression.

   /// length parameters and type as mold. It is up to the caller to deallocate
   /// the temporary.
   ExtValue genArrayTempFromMold(const ExtValue &mold,
                                 llvm::StringRef tempName) {
     mlir::Type type = fir::dyn_cast_ptrOrBoxEleTy(fir::getBase(mold).getType());
     assert(type && "expected descriptor or memory type");
     mlir::Location loc = getLoc();
     llvm::SmallVector<mlir::Value> extents =
-        fir::factory::getExtents(builder, loc, mold);
+        fir::factory::getExtents(loc, builder, mold);
     llvm::SmallVector<mlir::Value> allocMemTypeParams =
         fir::getTypeParams(mold);
     mlir::Value charLen;
     mlir::Type elementType = fir::unwrapSequenceType(type);
     if (auto charType = elementType.dyn_cast<fir::CharacterType>()) {
       charLen = allocMemTypeParams.empty()
                     ? fir::factory::readCharLen(builder, loc, mold)
                     : allocMemTypeParams[0];
return genExtValue(expr).match(
             value = builder.create<fir::LoadOp>(loc, value);
           mlir::Value temp = builder.createTemporary(loc, value.getType());
           builder.create<fir::StoreOp>(loc, value, temp);
           return temp;
         },
         [&](const fir::BoxValue &x) -> ExtValue {
           // Derived type scalar that may be polymorphic.
           assert(!x.hasRank() && x.isDerived());
-          if (x.isDerivedWithLengthParameters())
+          if (x.isDerivedWithLenParameters())
             fir::emitFatalError(
                 loc, "making temps for derived type with length parameters");
           // TODO: polymorphic aspects should be kept but for now the temp
           // created always has the declared type.
           mlir::Value var =
               fir::getBase(fir::factory::readBoxValue(builder, loc, x));
           auto value = builder.create<fir::LoadOp>(loc, var);
           mlir::Value temp = builder.createTemporary(loc, value.getType());
builder.genIfThen(loc, *copyOutPair.restrictCopyAndFreeAtRuntime)
         .genThen([&]() {
           if (copyOutPair.argMayBeModifiedByCall)
             genArrayCopy(copyOutPair.var, copyOutPair.temp);
           builder.create<fir::FreeMemOp>(loc, fir::getBase(copyOutPair.temp));
         })
         .end();
   }
 
+  /// Lower a designator to a variable that may be absent at runtime into an
+  /// ExtendedValue where all the properties (base address, shape and length
+  /// parameters) can be safely read (set to zero if not present). It also
+  /// returns a boolean mlir::Value telling if the variable is present at
+  /// runtime.
+  /// This is useful to later be able to do conditional copy-in/copy-out
+  /// or to retrieve the base address without having to deal with the case
+  /// where the actual may be an absent fir.box.
+  std::pair<ExtValue, mlir::Value>
+  prepareActualThatMayBeAbsent(const Fortran::lower::SomeExpr &expr) {
+    mlir::Location loc = getLoc();
+    if (Fortran::evaluate::IsAllocatableOrPointerObject(
+            expr, converter.getFoldingContext())) {
+      // Fortran 2018 15.5.2.12 point 1: If unallocated/disassociated,
+      // it is as if the argument was absent. The main care here is to
+      // not do a copy-in/copy-out because the temp address, even though
+      // pointing to a null size storage, would not be a nullptr and
+      // therefore the argument would not be considered absent on the
+      // callee side. Note: if wholeSymbol is optional, it cannot be
+      // absent as per 15.5.2.12 point 7. and 8. We rely on this to
+      // un-conditionally read the allocatable/pointer descriptor here.
+      fir::MutableBoxValue mutableBox = genMutableBoxValue(expr);
+      mlir::Value isPresent = fir::factory::genIsAllocatedOrAssociatedTest(
+          builder, loc, mutableBox);
+      fir::ExtendedValue actualArg =
+          fir::factory::genMutableBoxRead(builder, loc, mutableBox);
+      return {actualArg, isPresent};
+    }
+    // Absent descriptor cannot be read. To avoid any issue in
+    // copy-in/copy-out, and when retrieving the address/length
+    // create an descriptor pointing to a null address here if the
+    // fir.box is absent.
+    ExtValue actualArg = gen(expr);
+    mlir::Value actualArgBase = fir::getBase(actualArg);
+    mlir::Value isPresent = builder.create<fir::IsPresentOp>(
+        loc, builder.getI1Type(), actualArgBase);
+    if (!actualArgBase.getType().isa<fir::BoxType>())
+      return {actualArg, isPresent};
+    ExtValue safeToReadBox;
+    return {safeToReadBox, isPresent};
+  }
+
+  /// Create a temp on the stack for scalar actual arguments that may be absent
+  /// at runtime, but must be passed via a temp if they are presents.
+  fir::ExtendedValue
+  createScalarTempForArgThatMayBeAbsent(ExtValue actualArg,
+                                        mlir::Value isPresent) {
+    mlir::Location loc = getLoc();
+    mlir::Type type = fir::unwrapRefType(fir::getBase(actualArg).getType());
+    if (fir::isDerivedWithLenParameters(actualArg))
+      TODO(loc, "parametrized derived type optional scalar argument copy-in");
+    if (const fir::CharBoxValue *charBox = actualArg.getCharBox()) {
+      mlir::Value len = charBox->getLen();
+      mlir::Value zero = builder.createIntegerConstant(loc, len.getType(), 0);
+      len = builder.create<mlir::arith::SelectOp>(loc, isPresent, len, zero);
+      mlir::Value temp = builder.createTemporary(
+          loc, type, /*name=*/{}, /*shape=*/{}, mlir::ValueRange{len},
+          llvm::ArrayRef<mlir::NamedAttribute>{
+              Fortran::lower::getAdaptToByRefAttr(builder)});
+      return fir::CharBoxValue{temp, len};
+    }
+    assert((fir::isa_trivial(type) || type.isa<fir::RecordType>()) &&
+           "must be simple scalar");
+    return builder.createTemporary(
+        loc, type,
+        llvm::ArrayRef<mlir::NamedAttribute>{
+            Fortran::lower::getAdaptToByRefAttr(builder)});
+  }
+
+  /// Lower an actual argument that must be passed via an address.
+  /// This generates of the copy-in/copy-out if the actual is not contiguous, or
+  /// the creation of the temp if the actual is a variable and \p byValue is
+  /// true. It handles the cases where the actual may be absent, and all of the
+  /// copying has to be conditional at runtime.
+  ExtValue prepareActualToBaseAddressLike(
+      const Fortran::lower::SomeExpr &expr,
+      const Fortran::lower::CallerInterface::PassedEntity &arg,
+      CopyOutPairs &copyOutPairs, bool byValue) {
+    mlir::Location loc = getLoc();
+    const bool isArray = expr.Rank() > 0;
+    const bool actualArgIsVariable = Fortran::evaluate::IsVariable(expr);
+    // It must be possible to modify VALUE arguments on the callee side, even
+    // if the actual argument is a literal or named constant. Hence, the
+    // address of static storage must not be passed in that case, and a copy
+    // must be made even if this is not a variable.
+    // Note: isArray should be used here, but genBoxArg already creates copies
+    // for it, so do not duplicate the copy until genBoxArg behavior is changed.
+    const bool isStaticConstantByValue =
+        byValue && Fortran::evaluate::IsActuallyConstant(expr) &&
+        (isCharacterType(expr));
+    const bool variableNeedsCopy =
+        actualArgIsVariable &&
+        (byValue || (isArray && !Fortran::evaluate::IsSimplyContiguous(
+                                    expr, converter.getFoldingContext())));
+    const bool needsCopy = isStaticConstantByValue || variableNeedsCopy;
+    auto argAddr = [&]() -> ExtValue {
+      if (!actualArgIsVariable && !needsCopy)
+        // Actual argument is not a variable. Make sure a variable address is
+        // not passed.
+        return genTempExtAddr(expr);
+      ExtValue baseAddr;
+      if (arg.isOptional() && Fortran::evaluate::MayBePassedAsAbsentOptional(
+                                  expr, converter.getFoldingContext())) {
+        auto [actualArgBind, isPresent] = prepareActualThatMayBeAbsent(expr);
+        const ExtValue &actualArg = actualArgBind;
+        if (!needsCopy)
+          return actualArg;
+
+        if (isArray)
+          return genCopyIn(actualArg, arg, copyOutPairs,
+                           isPresent /*, byValue*/);
+        // Scalars, create a temp, and use it conditionally at runtime if
+        // the argument is present.
+        ExtValue temp =
+            createScalarTempForArgThatMayBeAbsent(actualArg, isPresent);
+        mlir::Type tempAddrTy = fir::getBase(temp).getType();
+        mlir::Value selectAddr =
+            builder
+                .genIfOp(loc, {tempAddrTy}, isPresent,
+                         /*withElseRegion=*/true)
+                .genThen([&]() {
+                  fir::factory::genScalarAssignment(builder, loc, temp,
+                                                    actualArg);
+                  builder.create<fir::ResultOp>(loc, fir::getBase(temp));
+                })
+                .genElse([&]() {
+                  mlir::Value absent =
+                      builder.create<fir::AbsentOp>(loc, tempAddrTy);
+                  builder.create<fir::ResultOp>(loc, absent);
+                })
+                .getResults()[0];
+        return fir::substBase(temp, selectAddr);
+      }
+      // Actual cannot be absent, the actual argument can safely be
+      // copied-in/copied-out without any care if needed.
+      if (isArray) {
+        ExtValue box = genBoxArg(expr);
+        if (needsCopy)
+          return genCopyIn(box, arg, copyOutPairs,
+                           /*restrictCopyAtRuntime=*/llvm::None /*, byValue*/);
+        // Contiguous: just use the box we created above!
+        // This gets "unboxed" below, if needed.
+        return box;
+      }
+      // Actual argument is a non-optional, non-pointer, non-allocatable
+      // scalar.
+      ExtValue actualArg = genExtAddr(expr);
+      if (needsCopy)
+        return createInMemoryScalarCopy(builder, loc, actualArg);
+      return actualArg;
+    }();
+    // Scalar and contiguous expressions may be lowered to a fir.box,
+    // either to account for potential polymorphism, or because lowering
+    // did not account for some contiguity hints.
+    // Here, polymorphism does not matter (an entity of the declared type
+    // is passed, not one of the dynamic type), and the expr is known to
+    // be simply contiguous, so it is safe to unbox it and pass the
+    // address without making a copy.
+    return readIfBoxValue(argAddr);
+  }
+
   /// Lower a non-elemental procedure reference.
   ExtValue genRawProcedureRef(const Fortran::evaluate::ProcedureRef &procRef,
                               llvm::Optional<mlir::Type> resultType) {
     mlir::Location loc = getLoc();
     if (isElementalProcWithArrayArgs(procRef))
       fir::emitFatalError(loc, "trying to lower elemental procedure with array "
                                "arguments as normal procedure");
     if (const Fortran::evaluate::SpecificIntrinsic *intrinsic =
for (const Fortran::lower::CallInterface<
           // argument to it.
           mlir::Value irBox =
               builder.createTemporary(loc, fir::unwrapRefType(argTy));
           // Non deferred parameters will be evaluated on the callee side.
           fir::MutableBoxValue pointer(irBox,
                                        /*nonDeferredParams=*/mlir::ValueRange{},
                                        /*mutableProperties=*/{});
           Fortran::lower::associateMutableBox(converter, loc, pointer, *expr,
-                                              /*lbounds*/ mlir::ValueRange{},
-                                              stmtCtx);
+                                              /*lbounds=*/llvm::None, stmtCtx);
           caller.placeInput(arg, irBox);
           continue;
         }
         // Passing a POINTER to a POINTER, or an ALLOCATABLE to an ALLOCATABLE.
         fir::MutableBoxValue mutableBox = genMutableBoxValue(*expr);
         mlir::Value irBox =
             fir::factory::getMutableIRBox(builder, loc, mutableBox);
         caller.placeInput(arg, irBox);
public:
 
   /// Entry point for array assignments. Both the left-hand and right-hand sides
   /// can either be ExtendedValue or evaluate::Expr.
   template <typename TL, typename TR>
   static void lowerArrayAssignment(Fortran::lower::AbstractConverter &converter,
                                    Fortran::lower::SymMap &symMap,
                                    Fortran::lower::StatementContext &stmtCtx,
                                    const TL &lhs, const TR &rhs) {
-    ArrayExprLowering ael{converter, stmtCtx, symMap,
-                          ConstituentSemantics::CopyInCopyOut};
+    ArrayExprLowering ael(converter, stmtCtx, symMap,
+                          ConstituentSemantics::CopyInCopyOut);
     ael.lowerArrayAssignment(lhs, rhs);
   }
 
   template <typename TL, typename TR>
   void lowerArrayAssignment(const TL &lhs, const TR &rhs) {
     mlir::Location loc = getLoc();
     /// Here the target subspace is not necessarily contiguous. The ArrayUpdate
     /// continuation is implicitly returned in `ccStoreToDest` and the ArrayLoad
static void lowerAnyMaskedArrayAssignment(
     // Array assignment expression in a FORALL and/or WHERE context.
     ArrayExprLowering ael(converter, stmtCtx, symMap,
                           ConstituentSemantics::CopyInCopyOut, &explicitSpace,
                           &implicitSpace);
     ael.lowerArrayAssignment(lhs, rhs);
   }
 
   //===--------------------------------------------------------------------===//
+  // Array assignment to array of pointer box values.
+  //===--------------------------------------------------------------------===//
+
+  /// Entry point for assignment to pointer in an array of pointers.
+  static void lowerArrayOfPointerAssignment(
+      Fortran::lower::AbstractConverter &converter,
+      Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx,
+      const Fortran::lower::SomeExpr &lhs, const Fortran::lower::SomeExpr &rhs,
+      Fortran::lower::ExplicitIterSpace &explicitSpace,
+      Fortran::lower::ImplicitIterSpace &implicitSpace,
+      const llvm::SmallVector<mlir::Value> &lbounds,
+      llvm::Optional<llvm::SmallVector<mlir::Value>> ubounds) {
+    ArrayExprLowering ael(converter, stmtCtx, symMap,
+                          ConstituentSemantics::CopyInCopyOut, &explicitSpace,
+                          &implicitSpace);
+    ael.lowerArrayOfPointerAssignment(lhs, rhs, lbounds, ubounds);
+  }
+
+  /// Scalar pointer assignment in an explicit iteration space.
+  ///
+  /// Pointers may be bound to targets in a FORALL context. This is a scalar
+  /// assignment in the sense there is never an implied iteration space, even if
+  /// the pointer is to a target with non-zero rank. Since the pointer
+  /// assignment must appear in a FORALL construct, correctness may require that
+  /// the array of pointers follow copy-in/copy-out semantics. The pointer
+  /// assignment may include a bounds-spec (lower bounds), a bounds-remapping
+  /// (lower and upper bounds), or neither.
+  void lowerArrayOfPointerAssignment(
+      const Fortran::lower::SomeExpr &lhs, const Fortran::lower::SomeExpr &rhs,
+      const llvm::SmallVector<mlir::Value> &lbounds,
+      llvm::Optional<llvm::SmallVector<mlir::Value>> ubounds) {
+    setPointerAssignmentBounds(lbounds, ubounds);
+    if (rhs.Rank() == 0 ||
+        (Fortran::evaluate::UnwrapWholeSymbolOrComponentDataRef(rhs) &&
+         Fortran::evaluate::IsAllocatableOrPointerObject(
+             rhs, converter.getFoldingContext()))) {
+      lowerScalarAssignment(lhs, rhs);
+      return;
+    }
+    TODO(getLoc(),
+         "auto boxing of a ranked expression on RHS for pointer assignment");
+  }
+
+  //===--------------------------------------------------------------------===//
   // Array assignment to allocatable array
   //===--------------------------------------------------------------------===//
 
   /// Entry point for assignment to allocatable array.
   static void lowerAllocatableArrayAssignment(
       Fortran::lower::AbstractConverter &converter,
       Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx,
       const Fortran::lower::SomeExpr &lhs, const Fortran::lower::SomeExpr &rhs,
void lowerAllocatableArrayAssignment(const Fortran::lower::SomeExpr &lhs,
                                        const Fortran::lower::SomeExpr &rhs) {
     // With assignment to allocatable, we want to lower the rhs first and use
     // its shape to determine if we need to reallocate, etc.
     mlir::Location loc = getLoc();
     // FIXME: If the lhs is in an explicit iteration space, the assignment may
     // be to an array of allocatable arrays rather than a single allocatable
     // array.
     fir::MutableBoxValue mutableBox =
-        createMutableBox(loc, converter, lhs, symMap);
+        Fortran::lower::createMutableBox(loc, converter, lhs, symMap);
     mlir::Type resultTy = converter.genType(rhs);
     if (rhs.Rank() > 0)
       determineShapeOfDest(rhs);
     auto rhsCC = [&]() {
       PushSemantics(ConstituentSemantics::RefTransparent);
       return genarr(rhs);
     }();
 
     llvm::SmallVector<mlir::Value> lengthParams;
     // Currently no safe way to gather length from rhs (at least for
     // character, it cannot be taken from array_loads since it may be
     // changed by concatenations).
     if ((mutableBox.isCharacter() && !mutableBox.hasNonDeferredLenParams()) ||
-        mutableBox.isDerivedWithLengthParameters())
+        mutableBox.isDerivedWithLenParameters())
       TODO(loc, "gather rhs length parameters in assignment to allocatable");
 
     // The allocatable must take lower bounds from the expr if it is
     // reallocated and the right hand side is not a scalar.
     const bool takeLboundsIfRealloc = rhs.Rank() > 0;
     llvm::SmallVector<mlir::Value> lbounds;
     // When the reallocated LHS takes its lower bounds from the RHS,
     // they will be non default only if the RHS is a whole array
     // variable. Otherwise, lbounds is left empty and default lower bounds
     // will be used.
     if (takeLboundsIfRealloc &&
         Fortran::evaluate::UnwrapWholeSymbolOrComponentDataRef(rhs)) {
       assert(arrayOperands.size() == 1 &&
              "lbounds can only come from one array");
-      std::vector<mlir::Value> lbs =
-          fir::factory::getOrigins(arrayOperands[0].shape);
+      auto lbs = fir::factory::getOrigins(arrayOperands[0].shape);
       lbounds.append(lbs.begin(), lbs.end());
     }
     fir::factory::MutableBoxReallocation realloc =
         fir::factory::genReallocIfNeeded(builder, loc, mutableBox, destShape,
                                          lengthParams);
     // Create ArrayLoad for the mutable box and save it into `destination`.
     PushSemantics(ConstituentSemantics::ProjectedCopyInCopyOut);
     ccStoreToDest = genarr(realloc.newValue);
lowerBoxedArrayExpression(Fortran::lower::AbstractConverter &converter,
                             Fortran::lower::StatementContext &stmtCtx,
                             const Fortran::lower::SomeExpr &expr) {
     ArrayExprLowering ael{converter, stmtCtx, symMap,
                           ConstituentSemantics::BoxValue};
     return ael.lowerBoxedArrayExpr(expr);
   }
 
   ExtValue lowerBoxedArrayExpr(const Fortran::lower::SomeExpr &exp) {
+    PushSemantics(ConstituentSemantics::BoxValue);
     return std::visit(
         [&](const auto &e) {
           auto f = genarr(e);
           ExtValue exv = f(IterationSpace{});
           if (fir::getBase(exv).getType().template isa<fir::BoxType>())
             return exv;
           fir::emitFatalError(getLoc(), "array must be emboxed");
         },
void lowerElementalSubroutine(const Fortran::lower::SomeExpr &call) {
     auto f = genarr(call);
     llvm::SmallVector<mlir::Value> shape = genIterationShape();
     auto [iterSpace, insPt] = genImplicitLoops(shape, /*innerArg=*/{});
     f(iterSpace);
     finalizeElementCtx();
     builder.restoreInsertionPoint(insPt);
   }
 
-  template <typename A, typename B>
-  ExtValue lowerScalarAssignment(const A &lhs, const B &rhs) {
+  ExtValue lowerScalarAssignment(const Fortran::lower::SomeExpr &lhs,
+                                 const Fortran::lower::SomeExpr &rhs) {
+    PushSemantics(ConstituentSemantics::RefTransparent);
     // 1) Lower the rhs expression with array_fetch op(s).
     IterationSpace iters;
     iters.setElement(genarr(rhs)(iters));
-    fir::ExtendedValue elementalExv = iters.elementExv();
     // 2) Lower the lhs expression to an array_update.
     semant = ConstituentSemantics::ProjectedCopyInCopyOut;
     auto lexv = genarr(lhs)(iters);
     // 3) Finalize the inner context.
     explicitSpace->finalizeContext();
     // 4) Thread the array value updated forward. Note: the lhs might be
     // ill-formed (performing scalar assignment in an array context),
     // in which case there is no array to thread.
     auto createResult = [&](auto op) {
       mlir::Value oldInnerArg = op.getSequence();
       std::size_t offset = explicitSpace->argPosition(oldInnerArg);
       explicitSpace->setInnerArg(offset, fir::getBase(lexv));
       builder.create<fir::ResultOp>(getLoc(), fir::getBase(lexv));
     };
-    if (auto updateOp = mlir::dyn_cast<fir::ArrayUpdateOp>(
-            fir::getBase(lexv).getDefiningOp()))
-      createResult(updateOp);
-    else if (auto amend = mlir::dyn_cast<fir::ArrayAmendOp>(
-                 fir::getBase(lexv).getDefiningOp()))
-      createResult(amend);
-    else if (auto modifyOp = mlir::dyn_cast<fir::ArrayModifyOp>(
-                 fir::getBase(lexv).getDefiningOp()))
-      createResult(modifyOp);
+    llvm::TypeSwitch<mlir::Operation *, void>(
+        fir::getBase(lexv).getDefiningOp())
+        .Case([&](fir::ArrayUpdateOp op) { createResult(op); })
+        .Case([&](fir::ArrayAmendOp op) { createResult(op); })
+        .Case([&](fir::ArrayModifyOp op) { createResult(op); })
+        .Default([&](mlir::Operation *) {});
     return lexv;
   }
 
   static ExtValue lowerScalarUserAssignment(
       Fortran::lower::AbstractConverter &converter,
       Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx,
       Fortran::lower::ExplicitIterSpace &explicitIterSpace,
       mlir::func::FuncOp userAssignmentFunction,
ExtValue lowerScalarUserAssignment(mlir::func::FuncOp userAssignment,
     // 5). Thread the array value updated forward.
     if (!isIllFormedLHS)
       builder.create<fir::ResultOp>(getLoc(), fir::getBase(lexv));
     return lexv;
   }
 
 private:
   void determineShapeOfDest(const fir::ExtendedValue &lhs) {
-    destShape = fir::factory::getExtents(builder, getLoc(), lhs);
+    destShape = fir::factory::getExtents(getLoc(), builder, lhs);
   }
 
   void determineShapeOfDest(const Fortran::lower::SomeExpr &lhs) {
     if (!destShape.empty())
       return;
     if (explicitSpaceIsActive() && determineShapeWithSlice(lhs))
       return;
     mlir::Type idxTy = builder.getIndexType();
if (x.base().Rank() > 0)
       if (genShapeFromDataRef(x.base()))
         return true;
     // x has rank and x.base did not produce a shape.
     ExtValue exv = x.base().IsSymbol() ? asScalarRef(getFirstSym(x.base()))
                                        : asScalarRef(x.base().GetComponent());
     mlir::Location loc = getLoc();
     mlir::IndexType idxTy = builder.getIndexType();
     llvm::SmallVector<mlir::Value> definedShape =
-        fir::factory::getExtents(builder, loc, exv);
+        fir::factory::getExtents(loc, builder, exv);
     mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1);
     for (auto ss : llvm::enumerate(x.subscript())) {
       std::visit(Fortran::common::visitors{
                      [&](const Fortran::evaluate::Triplet &trip) {
                        // For a subscript of triple notation, we compute the
                        // range of this dimension of the iteration space.
                        auto lo = [&]() {
                          if (auto optLo = trip.lower())
void populateBounds(llvm::SmallVectorImpl<mlir::Value> &bounds,
                       const Fortran::evaluate::Substring *substring) {
     if (!substring)
       return;
     bounds.push_back(fir::getBase(asScalar(substring->lower())));
     if (auto upper = substring->upper())
       bounds.push_back(fir::getBase(asScalar(*upper)));
   }
 
+  /// Convert the original value, \p origVal, to type \p eleTy. When in a
+  /// pointer assignment context, generate an appropriate `fir.rebox` for
+  /// dealing with any bounds parameters on the pointer assignment.
+  mlir::Value convertElementForUpdate(mlir::Location loc, mlir::Type eleTy,
+                                      mlir::Value origVal) {
+    mlir::Value val = builder.createConvert(loc, eleTy, origVal);
+    if (isBoundsSpec()) {
+      auto lbs = lbounds.getValue();
+      if (lbs.size() > 0) {
+        // Rebox the value with user-specified shift.
+        auto shiftTy = fir::ShiftType::get(eleTy.getContext(), lbs.size());
+        mlir::Value shiftOp = builder.create<fir::ShiftOp>(loc, shiftTy, lbs);
+        val = builder.create<fir::ReboxOp>(loc, eleTy, val, shiftOp,
+                                           mlir::Value{});
+      }
+    } else if (isBoundsRemap()) {
+      auto lbs = lbounds.getValue();
+      if (lbs.size() > 0) {
+        // Rebox the value with user-specified shift and shape.
+        auto shapeShiftArgs = flatZip(lbs, ubounds.getValue());
+        auto shapeTy = fir::ShapeShiftType::get(eleTy.getContext(), lbs.size());
+        mlir::Value shapeShift =
+            builder.create<fir::ShapeShiftOp>(loc, shapeTy, shapeShiftArgs);
+        val = builder.create<fir::ReboxOp>(loc, eleTy, val, shapeShift,
+                                           mlir::Value{});
+      }
+    }
+    return val;
+  }
+
   /// Default store to destination implementation.
   /// This implements the default case, which is to assign the value in
   /// `iters.element` into the destination array, `iters.innerArgument`. Handles
   /// by value and by reference assignment.
   CC defaultStoreToDestination(const Fortran::evaluate::Substring *substring) {
     return [=](IterSpace iterSpace) -> ExtValue {
       mlir::Location loc = getLoc();
       mlir::Value innerArg = iterSpace.innerArgument();
return [=](IterSpace iterSpace) -> ExtValue {
           fir::ArrayAmendOp amend = createDerivedArrayAmend(
               loc, destination, builder, arrayOp, exv, eleTy, innerArg);
           return abstractArrayExtValue(amend /*FIXME: typeparams?*/);
         }
         assert(eleTy.isa<fir::SequenceType>() && "must be an array");
         TODO(loc, "array (as element) assignment");
       }
       // By value semantics. The element is being assigned by value.
-      mlir::Value ele = builder.createConvert(loc, eleTy, fir::getBase(exv));
+      auto ele = convertElementForUpdate(loc, eleTy, fir::getBase(exv));
       auto update = builder.create<fir::ArrayUpdateOp>(
           loc, arrTy, innerArg, ele, iterSpace.iterVec(),
           destination.getTypeparams());
       return abstractArrayExtValue(update);
     };
   }
 
   /// For an elemental array expression.
private:
   /// Get the shape from an ArrayOperand. The shape of the array is adjusted if
   /// the array was sliced.
   llvm::SmallVector<mlir::Value> getShape(ArrayOperand array) {
     if (array.slice)
       return computeSliceShape(array.slice);
     if (array.memref.getType().isa<fir::BoxType>())
       return fir::factory::readExtents(builder, getLoc(),
                                        fir::BoxValue{array.memref});
-    std::vector<mlir::Value, std::allocator<mlir::Value>> extents =
-        fir::factory::getExtents(array.shape);
-    return {extents.begin(), extents.end()};
+    return fir::factory::getExtents(array.shape);
   }
 
   /// Get the shape from an ArrayLoad.
   llvm::SmallVector<mlir::Value> getShape(fir::ArrayLoadOp arrayLoad) {
     return getShape(ArrayOperand{arrayLoad.getMemref(), arrayLoad.getShape(),
                                  arrayLoad.getSlice()});
   }
 
genImplicitLoops(mlir::ValueRange shape, mlir::Value innerArg) {
     // Put the implicit loop variables in row to column order to match FIR's
     // Ops. (The loops were constructed from outermost column to innermost
     // row.)
     mlir::Value outerRes = loops[0].getResult(0);
     return {IterationSpace(innerArg, outerRes, llvm::reverse(ivars)),
             afterLoopNest};
   }
 
-  /// Build the iteration space into which the array expression will be
-  /// lowered. The resultType is used to create a temporary, if needed.
+  /// Build the iteration space into which the array expression will be lowered.
+  /// The resultType is used to create a temporary, if needed.
   std::pair<IterationSpace, mlir::OpBuilder::InsertPoint>
   genIterSpace(mlir::Type resultType) {
     mlir::Location loc = getLoc();
     llvm::SmallVector<mlir::Value> shape = genIterationShape();
     if (!destination) {
       // Allocate storage for the result if it is not already provided.
       destination = createAndLoadSomeArrayTemp(resultType, shape);
     }
private:
   }
 
   /// Lower the expression, \p x, in a scalar context. If this is an explicit
   /// space, the expression may be scalar and refer to an array. We want to
   /// raise the array access to array operations in FIR to analyze potential
   /// conflicts even when the result is a scalar element.
   template <typename A>
   ExtValue asScalarArray(const A &x) {
-    return explicitSpaceIsActive() ? genarr(x)(IterationSpace{}) : asScalar(x);
+    return explicitSpaceIsActive() && !isPointerAssignment()
+               ? genarr(x)(IterationSpace{})
+               : asScalar(x);
   }
 
   /// Lower the expression in a scalar context to a memory reference.
   template <typename A>
   ExtValue asScalarRef(const A &x) {
     return ScalarExprLowering{getLoc(), converter, symMap, stmtCtx}.gen(x);
   }
 
for (auto sub : llvm::enumerate(x.subscript())) {
                   // This is a vector subscript. Use the index values as read
                   // from a vector to determine the temporary array value.
                   // Note: 9.5.3.3.3(3) specifies undefined behavior for
                   // multiple updates to any specific array element through a
                   // vector subscript with replicated values.
                   assert(!isBoxValue() &&
                          "fir.box cannot be created with vector subscripts");
                   auto arrExpr = ignoreEvConvert(e);
-                  if (createDestShape) {
-                    destShape.push_back(fir::getExtentAtDimension(
-                        arrayExv, builder, loc, subsIndex));
-                  }
+                  if (createDestShape)
+                    destShape.push_back(fir::factory::getExtentAtDimension(
+                        loc, builder, arrayExv, subsIndex));
                   auto genArrFetch =
                       genVectorSubscriptArrayFetch(arrExpr, shapeIndex);
                   auto currentPC = pc;
                   pc = [=](IterSpace iters) {
                     IterationSpace newIters = currentPC(iters);
                     auto val = genAccessByVector(loc, genArrFetch, newIters,
                                                  subsIndex);
                     // Value read from vector subscript array and normalized

   /// Is the path component rank > 0?
   static bool ranked(const PathComponent &x) {
     return std::visit(Fortran::common::visitors{
                           [](const ImplicitSubscripts &) { return false; },
                           [](const auto *v) { return v->Rank() > 0; }},
                       x);
   }
 
+  void extendComponent(Fortran::lower::ComponentPath &component,
+                       mlir::Type coorTy, mlir::ValueRange vals) {
+    auto *bldr = &converter.getFirOpBuilder();
+    llvm::SmallVector<mlir::Value> offsets(vals.begin(), vals.end());
+    auto currentFunc = component.getExtendCoorRef();
+    auto loc = getLoc();
+    auto newCoorRef = [bldr, coorTy, offsets, currentFunc,
+                       loc](mlir::Value val) -> mlir::Value {
+      return bldr->create<fir::CoordinateOp>(loc, bldr->getRefType(coorTy),
+                                             currentFunc(val), offsets);
+    };
+    component.extendCoorRef = newCoorRef;
+  }
+
   //===-------------------------------------------------------------------===//
   // Array data references in an explicit iteration space.
   //
   // Use the base array that was loaded before the loop nest.
   //===-------------------------------------------------------------------===//
 
   /// Lower the path (`revPath`, in reverse) to be appended to an array_fetch or
   /// array_update op. \p ty is the initial type of the array
   /// (reference). Returns the type of the element after application of the
   /// path in \p components.
   ///
   /// TODO: This needs to deal with array's with initial bounds other than 1.
   /// TODO: Thread type parameters correctly.
   mlir::Type lowerPath(const ExtValue &arrayExv, ComponentPath &components) {
     mlir::Location loc = getLoc();
     mlir::Type ty = fir::getBase(arrayExv).getType();
     auto &revPath = components.reversePath;
     ty = fir::unwrapPassByRefType(ty);
     bool prefix = true;
-    auto addComponent = [&](mlir::Value v) {
-      if (prefix)
+    bool deref = false;
+    auto addComponentList = [&](mlir::Type ty, mlir::ValueRange vals) {
+      if (deref) {
+        extendComponent(components, ty, vals);
+      } else if (prefix) {
+        for (auto v : vals)
           components.prefixComponents.push_back(v);
-      else
+      } else {
+        for (auto v : vals)
           components.suffixComponents.push_back(v);
+      }
     };
     mlir::IndexType idxTy = builder.getIndexType();
     mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1);
     bool atBase = true;
     auto saveSemant = semant;
     if (isProjectedCopyInCopyOut())
       semant = ConstituentSemantics::RefTransparent;
+    unsigned index = 0;
     for (const auto &v : llvm::reverse(revPath)) {
       std::visit(
           Fortran::common::visitors{
               [&](const ImplicitSubscripts &) {
                 prefix = false;
                 ty = fir::unwrapSequenceType(ty);
               },
               [&](const Fortran::evaluate::ComplexPart *x) {
                 assert(!prefix && "complex part must be at end");
                 mlir::Value offset = builder.createIntegerConstant(
                     loc, builder.getI32Type(),
                     x->part() == Fortran::evaluate::ComplexPart::Part::RE ? 0
                                                                           : 1);
                 components.suffixComponents.push_back(offset);
                 ty = fir::applyPathToType(ty, mlir::ValueRange{offset});
               },
               [&](const Fortran::evaluate::ArrayRef *x) {
                 if (Fortran::lower::isRankedArrayAccess(*x)) {
                   genSliceIndices(components, arrayExv, *x, atBase);
+                  ty = fir::unwrapSeqOrBoxedSeqType(ty);
                 } else {
                   // Array access where the expressions are scalar and cannot
                   // depend upon the implied iteration space.
                   unsigned ssIndex = 0u;
+                  llvm::SmallVector<mlir::Value> componentsToAdd;
                   for (const auto &ss : x->subscript()) {
                     std::visit(
                         Fortran::common::visitors{
                             [&](const Fortran::evaluate::
                                     IndirectSubscriptIntegerExpr &ie) {
                               const auto &e = ie.value();
                               if (isArray(e))
                                 fir::emitFatalError(
for (const auto &v : llvm::reverse(revPath)) {
                                                builder, loc, arrayExv, ssIndex,
                                                one)
                                          : one;
                               mlir::Value val = builder.createConvert(
                                   loc, idxTy, subscriptVal);
                               mlir::Value ivAdj =
                                   builder.create<mlir::arith::SubIOp>(
                                       loc, idxTy, val, lb);
-                              addComponent(
+                              componentsToAdd.push_back(
                                   builder.createConvert(loc, idxTy, ivAdj));
                             },
                             [&](const auto &) {
                               fir::emitFatalError(
                                   loc, "multiple components along single path "
                                        "generating array subexpressions");
                             }},
                         ss.u);
                     ssIndex++;
                   }
+                  ty = fir::unwrapSeqOrBoxedSeqType(ty);
+                  addComponentList(ty, componentsToAdd);
                 }
-                ty = fir::unwrapSequenceType(ty);
               },
               [&](const Fortran::evaluate::Component *x) {
                 auto fieldTy = fir::FieldType::get(builder.getContext());
                 llvm::StringRef name = toStringRef(getLastSym(*x).name());
+                if (auto recTy = ty.dyn_cast<fir::RecordType>()) {
+                  ty = recTy.getType(name);
+                  auto fld = builder.create<fir::FieldIndexOp>(
+                      loc, fieldTy, name, recTy, fir::getTypeParams(arrayExv));
+                  addComponentList(ty, {fld});
+                  if (index != revPath.size() - 1 || !isPointerAssignment()) {
+                    // Need an intermediate  dereference if the boxed value
+                    // appears in the middle of the component path or if it is
+                    // on the right and this is not a pointer assignment.
+                    if (auto boxTy = ty.dyn_cast<fir::BoxType>()) {
+                      auto currentFunc = components.getExtendCoorRef();
+                      auto loc = getLoc();
+                      auto *bldr = &converter.getFirOpBuilder();
+                      auto newCoorRef = [=](mlir::Value val) -> mlir::Value {
+                        return bldr->create<fir::LoadOp>(loc, currentFunc(val));
+                      };
+                      components.extendCoorRef = newCoorRef;
+                      deref = true;
+                    }
+                  }
+                } else if (auto boxTy = ty.dyn_cast<fir::BoxType>()) {
+                  ty = fir::unwrapRefType(boxTy.getEleTy());
                   auto recTy = ty.cast<fir::RecordType>();
                   ty = recTy.getType(name);
                   auto fld = builder.create<fir::FieldIndexOp>(
                       loc, fieldTy, name, recTy, fir::getTypeParams(arrayExv));
-                addComponent(fld);
+                  extendComponent(components, ty, {fld});
+                } else {
+                  TODO(loc, "other component type");
+                }
               }},
           v);
       atBase = false;
+      ++index;
     }
     semant = saveSemant;
     ty = fir::unwrapSequenceType(ty);
     components.applied = true;
     return ty;
   }
 
   llvm::SmallVector<mlir::Value> genSubstringBounds(ComponentPath &components) {
     llvm::SmallVector<mlir::Value> result;
     if (components.substring)
       populateBounds(result, components.substring);
     return result;
   }
 
   CC applyPathToArrayLoad(fir::ArrayLoadOp load, ComponentPath &components) {
     mlir::Location loc = getLoc();
     auto revPath = components.reversePath;
     fir::ExtendedValue arrayExv =
         arrayLoadExtValue(builder, loc, load, {}, load);
     mlir::Type eleTy = lowerPath(arrayExv, components);
     auto currentPC = components.pc;
     auto pc = [=, prefix = components.prefixComponents,
                suffix = components.suffixComponents](IterSpace iters) {
-      IterationSpace newIters = currentPC(iters);
       // Add path prefix and suffix.
-      IterationSpace addIters(newIters, prefix, suffix);
-      return addIters;
+      return IterationSpace(currentPC(iters), prefix, suffix);
     };
-    components.pc = [=](IterSpace iters) { return iters; };
+    components.resetPC();
     llvm::SmallVector<mlir::Value> substringBounds =
         genSubstringBounds(components);
     if (isProjectedCopyInCopyOut()) {
       destination = load;
       auto lambda = [=, esp = this->explicitSpace](IterSpace iters) mutable {
         mlir::Value innerArg = esp->findArgumentOfLoad(load);
         if (isAdjustedArrayElementType(eleTy)) {
           mlir::Type eleRefTy = builder.getRefType(eleTy);
           auto arrayOp = builder.create<fir::ArrayAccessOp>(
               loc, eleRefTy, innerArg, iters.iterVec(), load.getTypeparams());
           if (auto charTy = eleTy.dyn_cast<fir::CharacterType>()) {
             mlir::Value dstLen = fir::factory::genLenOfCharacter(
                 builder, loc, load, iters.iterVec(), substringBounds);
             fir::ArrayAmendOp amend = createCharArrayAmend(
                 loc, builder, arrayOp, dstLen, iters.elementExv(), innerArg,
                 substringBounds);
             return arrayLoadExtValue(builder, loc, load, iters.iterVec(), amend,
                                      dstLen);
-          } else if (fir::isa_derived(eleTy)) {
+          }
+          if (fir::isa_derived(eleTy)) {
             fir::ArrayAmendOp amend =
                 createDerivedArrayAmend(loc, load, builder, arrayOp,
                                         iters.elementExv(), eleTy, innerArg);
             return arrayLoadExtValue(builder, loc, load, iters.iterVec(),
                                      amend);
           }
           assert(eleTy.isa<fir::SequenceType>());
           TODO(loc, "array (as element) assignment");
         }
-        mlir::Value castedElement =
-            builder.createConvert(loc, eleTy, iters.getElement());
+        if (components.hasExtendCoorRef()) {
+          auto eleBoxTy =
+              fir::applyPathToType(innerArg.getType(), iters.iterVec());
+          assert(eleBoxTy && eleBoxTy.isa<fir::BoxType>());
+          auto arrayOp = builder.create<fir::ArrayAccessOp>(
+              loc, builder.getRefType(eleBoxTy), innerArg, iters.iterVec(),
+              fir::factory::getTypeParams(loc, builder, load));
+          mlir::Value addr = components.getExtendCoorRef()(arrayOp);
+          components.resetExtendCoorRef();
+          // When the lhs is a boxed value and the context is not a pointer
+          // assignment, then insert the dereference of the box before any
+          // conversion and store.
+          if (!isPointerAssignment()) {
+            if (auto boxTy = eleTy.dyn_cast<fir::BoxType>()) {
+              eleTy = boxTy.getEleTy();
+              if (!(eleTy.isa<fir::PointerType>() ||
+                    eleTy.isa<fir::HeapType>()))
+                eleTy = builder.getRefType(eleTy);
+              addr = builder.create<fir::BoxAddrOp>(loc, eleTy, addr);
+              eleTy = fir::unwrapRefType(eleTy);
+            }
+          }
+          auto ele = convertElementForUpdate(loc, eleTy, iters.getElement());
+          builder.create<fir::StoreOp>(loc, ele, addr);
+          auto amend = builder.create<fir::ArrayAmendOp>(
+              loc, innerArg.getType(), innerArg, arrayOp);
+          return arrayLoadExtValue(builder, loc, load, iters.iterVec(), amend);
+        }
+        auto ele = convertElementForUpdate(loc, eleTy, iters.getElement());
         auto update = builder.create<fir::ArrayUpdateOp>(
-            loc, innerArg.getType(), innerArg, castedElement, iters.iterVec(),
-            load.getTypeparams());
+            loc, innerArg.getType(), innerArg, ele, iters.iterVec(),
+            fir::factory::getTypeParams(loc, builder, load));
         return arrayLoadExtValue(builder, loc, load, iters.iterVec(), update);
       };
       return [=](IterSpace iters) mutable { return lambda(pc(iters)); };
     }
     if (isCustomCopyInCopyOut()) {
       // Create an array_modify to get the LHS element address and indicate
       // the assignment, and create the call to the user defined assignment.
       destination = load;
auto lambda = [=, semant = this->semant](IterSpace iters) mutable {
             charDst = helper.createSubstring(charDst, substringBounds);
             newBase = charDst.getAddr();
           }
           return arrayLoadExtValue(builder, loc, load, iters.iterVec(), newBase,
                                    dstLen);
         }
         return arrayLoadExtValue(builder, loc, load, iters.iterVec(), newBase);
       }
+      if (components.hasExtendCoorRef()) {
+        auto eleBoxTy = fir::applyPathToType(load.getType(), iters.iterVec());
+        assert(eleBoxTy && eleBoxTy.isa<fir::BoxType>());
+        auto access = builder.create<fir::ArrayAccessOp>(
+            loc, builder.getRefType(eleBoxTy), load, iters.iterVec(),
+            fir::factory::getTypeParams(loc, builder, load));
+        mlir::Value addr = components.getExtendCoorRef()(access);
+        components.resetExtendCoorRef();
+        return arrayLoadExtValue(builder, loc, load, iters.iterVec(), addr);
+      }
+      if (isPointerAssignment()) {
+        auto eleTy = fir::applyPathToType(load.getType(), iters.iterVec());
+        if (!eleTy.isa<fir::BoxType>()) {
+          // Rhs is a regular expression that will need to be boxed before
+          // assigning to the boxed variable.
+          auto typeParams = fir::factory::getTypeParams(loc, builder, load);
+          auto access = builder.create<fir::ArrayAccessOp>(
+              loc, builder.getRefType(eleTy), load, iters.iterVec(),
+              typeParams);
+          auto addr = components.getExtendCoorRef()(access);
+          components.resetExtendCoorRef();
+          auto ptrEleTy = fir::PointerType::get(eleTy);
+          auto ptrAddr = builder.createConvert(loc, ptrEleTy, addr);
+          auto boxTy = fir::BoxType::get(ptrEleTy);
+          // FIXME: The typeparams to the load may be different than those of
+          // the subobject.
+          if (components.hasExtendCoorRef())
+            TODO(loc, "need to adjust typeparameter(s) to reflect the final "
+                      "component");
+          mlir::Value embox = builder.create<fir::EmboxOp>(
+              loc, boxTy, ptrAddr, /*shape=*/mlir::Value{},
+              /*slice=*/mlir::Value{}, typeParams);
+          return arrayLoadExtValue(builder, loc, load, iters.iterVec(), embox);
+        }
+      }
       auto fetch = builder.create<fir::ArrayFetchOp>(
           loc, eleTy, load, iters.iterVec(), load.getTypeparams());
       return arrayLoadExtValue(builder, loc, load, iters.iterVec(), fetch);
     };
-    return [=](IterSpace iters) mutable {
-      auto newIters = pc(iters);
-      return lambda(newIters);
-    };
+    return [=](IterSpace iters) mutable { return lambda(pc(iters)); };
   }
 
   template <typename A>
   CC genImplicitArrayAccess(const A &x, ComponentPath &components) {
     components.reversePath.push_back(ImplicitSubscripts{});
     ExtValue exv = asScalarRef(x);
     lowerPath(exv, components);
     auto lambda = genarr(exv, components);
if (isProjectedCopyInCopyOut()) {
           builder->create<fir::StoreOp>(loc, iters.getElement(), val);
         }
         return exv;
       };
     }
     return [=, &x](IterSpace) { return asScalar(x); };
   }
 
+  bool tailIsPointerInPointerAssignment(const Fortran::semantics::Symbol &x,
+                                        ComponentPath &components) {
+    return isPointerAssignment() && Fortran::semantics::IsPointer(x) &&
+           !components.hasComponents();
+  }
+  bool tailIsPointerInPointerAssignment(const Fortran::evaluate::Component &x,
+                                        ComponentPath &components) {
+    return tailIsPointerInPointerAssignment(getLastSym(x), components);
+  }
+
   CC genarr(const Fortran::semantics::Symbol &x, ComponentPath &components) {
     if (explicitSpaceIsActive()) {
-      if (x.Rank() > 0)
+      if (x.Rank() > 0 && !tailIsPointerInPointerAssignment(x, components))
         components.reversePath.push_back(ImplicitSubscripts{});
       if (fir::ArrayLoadOp load = explicitSpace->findBinding(&x))
         return applyPathToArrayLoad(load, components);
     } else {
       return genImplicitArrayAccess(x, components);
     }
     if (pathIsEmpty(components))
       return genAsScalar(x);
     mlir::Location loc = getLoc();
     return [=](IterSpace) -> ExtValue {
       fir::emitFatalError(loc, "reached symbol with path");
     };
   }
 
   /// Lower a component path with or without rank.
   /// Example: <code>array%baz%qux%waldo</code>
   CC genarr(const Fortran::evaluate::Component &x, ComponentPath &components) {
     if (explicitSpaceIsActive()) {
-      if (x.base().Rank() == 0 && x.Rank() > 0)
+      if (x.base().Rank() == 0 && x.Rank() > 0 &&
+          !tailIsPointerInPointerAssignment(x, components))
         components.reversePath.push_back(ImplicitSubscripts{});
       if (fir::ArrayLoadOp load = explicitSpace->findBinding(&x))
         return applyPathToArrayLoad(load, components);
     } else {
       if (x.base().Rank() == 0)
         return genImplicitArrayAccess(x, components);
     }
     bool atEnd = pathIsEmpty(components);
inline bool isValueAttribute() {
     return semant == ConstituentSemantics::ByValueArg;
   }
 
   /// Can the loops over the expression be unordered?
   inline bool isUnordered() const { return unordered; }
 
   void setUnordered(bool b) { unordered = b; }
 
+  inline bool isPointerAssignment() const { return lbounds.hasValue(); }
+
+  inline bool isBoundsSpec() const {
+    return isPointerAssignment() && !ubounds.hasValue();
+  }
+
+  inline bool isBoundsRemap() const {
+    return isPointerAssignment() && ubounds.hasValue();
+  }
+
+  void setPointerAssignmentBounds(
+      const llvm::SmallVector<mlir::Value> &lbs,
+      llvm::Optional<llvm::SmallVector<mlir::Value>> ubs) {
+    lbounds = lbs;
+    ubounds = ubs;
+  }
+
   Fortran::lower::AbstractConverter &converter;
   fir::FirOpBuilder &builder;
   Fortran::lower::StatementContext &stmtCtx;
   bool elementCtx = false;
   Fortran::lower::SymMap &symMap;
   /// The continuation to generate code to update the destination.
   llvm::Optional<CC> ccStoreToDest;
   llvm::Optional<std::function<void(llvm::ArrayRef<mlir::Value>)>> ccPrelude;
   llvm::Optional<std::function<fir::ArrayLoadOp(llvm::ArrayRef<mlir::Value>)>>
       ccLoadDest;
   /// The destination is the loaded array into which the results will be
   /// merged.
   fir::ArrayLoadOp destination;
   /// The shape of the destination.
   llvm::SmallVector<mlir::Value> destShape;
   /// List of arrays in the expression that have been loaded.
   llvm::SmallVector<ArrayOperand> arrayOperands;
   /// If there is a user-defined iteration space, explicitShape will hold the
   /// information from the front end.
   Fortran::lower::ExplicitIterSpace *explicitSpace = nullptr;
   Fortran::lower::ImplicitIterSpace *implicitSpace = nullptr;
   ConstituentSemantics semant = ConstituentSemantics::RefTransparent;
+  /// `lbounds`, `ubounds` are used in POINTER value assignments, which may only
+  /// occur in an explicit iteration space.
+  llvm::Optional<llvm::SmallVector<mlir::Value>> lbounds;
+  llvm::Optional<llvm::SmallVector<mlir::Value>> ubounds;
   // Can the array expression be evaluated in any order?
   // Will be set to false if any of the expression parts prevent this.
   bool unordered = true;
 };
 } // namespace
 
 fir::ExtendedValue Fortran::lower::createSomeExtendedExpression(
     mlir::Location loc, Fortran::lower::AbstractConverter &converter,
LLVM_DEBUG(lhs.AsFortran(llvm::dbgs() << "defining array: ") << '\n';
              rhs.AsFortran(llvm::dbgs() << "assign expression: ")
              << " given the explicit iteration space:\n"
              << explicitSpace << "\n and implied mask conditions:\n"
              << implicitSpace << '\n';);
   ArrayExprLowering::lowerAllocatableArrayAssignment(
       converter, symMap, stmtCtx, lhs, rhs, explicitSpace, implicitSpace);
 }
 
+void Fortran::lower::createArrayOfPointerAssignment(
+    Fortran::lower::AbstractConverter &converter,
+    const Fortran::lower::SomeExpr &lhs, const Fortran::lower::SomeExpr &rhs,
+    Fortran::lower::ExplicitIterSpace &explicitSpace,
+    Fortran::lower::ImplicitIterSpace &implicitSpace,
+    const llvm::SmallVector<mlir::Value> &lbounds,
+    llvm::Optional<llvm::SmallVector<mlir::Value>> ubounds,
+    Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx) {
+  LLVM_DEBUG(lhs.AsFortran(llvm::dbgs() << "defining pointer: ") << '\n';
+             rhs.AsFortran(llvm::dbgs() << "assign expression: ")
+             << " given the explicit iteration space:\n"
+             << explicitSpace << "\n and implied mask conditions:\n"
+             << implicitSpace << '\n';);
+  assert(explicitSpace.isActive() && "must be in FORALL construct");
+  ArrayExprLowering::lowerArrayOfPointerAssignment(
+      converter, symMap, stmtCtx, lhs, rhs, explicitSpace, implicitSpace,
+      lbounds, ubounds);
+}
+
 fir::ExtendedValue Fortran::lower::createSomeArrayTempValue(
     Fortran::lower::AbstractConverter &converter,
     const Fortran::lower::SomeExpr &expr, Fortran::lower::SymMap &symMap,
     Fortran::lower::StatementContext &stmtCtx) {
   LLVM_DEBUG(expr.AsFortran(llvm::dbgs() << "array value: ") << '\n');
   return ArrayExprLowering::lowerNewArrayExpression(converter, symMap, stmtCtx,
                                                     expr);
 }

flang/lib/Lower/IO.cpp

 #include "flang/Optimizer/Builder/Complex.h"
 #include "flang/Optimizer/Builder/FIRBuilder.h"
 #include "flang/Optimizer/Builder/Runtime/RTBuilder.h"
 #include "flang/Optimizer/Support/FIRContext.h"
 #include "flang/Parser/parse-tree.h"
 #include "flang/Runtime/io-api.h"
 #include "flang/Semantics/tools.h"
 #include "mlir/Dialect/ControlFlow/IR/ControlFlowOps.h"
+#include "llvm/Support/Debug.h"
 
 #define DEBUG_TYPE "flang-lower-io"
 
 // Define additional runtime type models specific to IO.
 namespace fir::runtime {
 template <>
 constexpr TypeBuilderFunc getModel<Fortran::runtime::io::IoStatementState *>() {
   return getModel<char *>();
static constexpr std::tuple<
     mkIOKey(BeginExternalListInput), mkIOKey(BeginExternalFormattedOutput),
     mkIOKey(BeginExternalFormattedInput), mkIOKey(BeginUnformattedOutput),
     mkIOKey(BeginUnformattedInput), mkIOKey(BeginAsynchronousOutput),
     mkIOKey(BeginAsynchronousInput), mkIOKey(BeginWait), mkIOKey(BeginWaitAll),
     mkIOKey(BeginClose), mkIOKey(BeginFlush), mkIOKey(BeginBackspace),
     mkIOKey(BeginEndfile), mkIOKey(BeginRewind), mkIOKey(BeginOpenUnit),
     mkIOKey(BeginOpenNewUnit), mkIOKey(BeginInquireUnit),
     mkIOKey(BeginInquireFile), mkIOKey(BeginInquireIoLength),
+    mkIOKey(CheckUnitNumberInRange64), mkIOKey(CheckUnitNumberInRange128),
     mkIOKey(EnableHandlers), mkIOKey(SetAdvance), mkIOKey(SetBlank),
     mkIOKey(SetDecimal), mkIOKey(SetDelim), mkIOKey(SetPad), mkIOKey(SetPos),
     mkIOKey(SetRec), mkIOKey(SetRound), mkIOKey(SetSign),
     mkIOKey(OutputNamelist), mkIOKey(InputNamelist), mkIOKey(OutputDescriptor),
     mkIOKey(InputDescriptor), mkIOKey(OutputUnformattedBlock),
     mkIOKey(InputUnformattedBlock), mkIOKey(OutputInteger8),
     mkIOKey(OutputInteger16), mkIOKey(OutputInteger32),
-    mkIOKey(OutputInteger64),
-#ifdef __SIZEOF_INT128__
-    mkIOKey(OutputInteger128),
-#endif
-    mkIOKey(InputInteger), mkIOKey(OutputReal32), mkIOKey(InputReal32),
-    mkIOKey(OutputReal64), mkIOKey(InputReal64), mkIOKey(OutputComplex32),
-    mkIOKey(InputComplex32), mkIOKey(OutputComplex64), mkIOKey(InputComplex64),
-    mkIOKey(OutputAscii), mkIOKey(InputAscii), mkIOKey(OutputLogical),
-    mkIOKey(InputLogical), mkIOKey(SetAccess), mkIOKey(SetAction),
-    mkIOKey(SetAsynchronous), mkIOKey(SetCarriagecontrol), mkIOKey(SetEncoding),
-    mkIOKey(SetForm), mkIOKey(SetPosition), mkIOKey(SetRecl),
-    mkIOKey(SetStatus), mkIOKey(SetFile), mkIOKey(GetNewUnit), mkIOKey(GetSize),
+    mkIOKey(OutputInteger64), mkIOKey(OutputInteger128), mkIOKey(InputInteger),
+    mkIOKey(OutputReal32), mkIOKey(InputReal32), mkIOKey(OutputReal64),
+    mkIOKey(InputReal64), mkIOKey(OutputComplex32), mkIOKey(InputComplex32),
+    mkIOKey(OutputComplex64), mkIOKey(InputComplex64), mkIOKey(OutputAscii),
+    mkIOKey(InputAscii), mkIOKey(OutputLogical), mkIOKey(InputLogical),
+    mkIOKey(SetAccess), mkIOKey(SetAction), mkIOKey(SetAsynchronous),
+    mkIOKey(SetCarriagecontrol), mkIOKey(SetEncoding), mkIOKey(SetForm),
+    mkIOKey(SetPosition), mkIOKey(SetRecl), mkIOKey(SetStatus),
+    mkIOKey(SetFile), mkIOKey(GetNewUnit), mkIOKey(GetSize),
     mkIOKey(GetIoLength), mkIOKey(GetIoMsg), mkIOKey(InquireCharacter),
     mkIOKey(InquireLogical), mkIOKey(InquirePendingId),
     mkIOKey(InquireInteger64), mkIOKey(EndIoStatement)>
     newIOTable;
 } // namespace Fortran::lower
 
 namespace {
 /// IO statements may require exceptional condition handling.  A statement that
 /// encounters an exceptional condition may branch to a label given on an ERR
 /// (error), END (end-of-file), or EOR (end-of-record) specifier.  An IOSTAT
 /// specifier variable may be set to a value that indicates some condition,
 /// and an IOMSG specifier variable may be set to a description of a condition.
 struct ConditionSpecInfo {
   const Fortran::lower::SomeExpr *ioStatExpr{};
-  const Fortran::lower::SomeExpr *ioMsgExpr{};
+  llvm::Optional<fir::ExtendedValue> ioMsg;
   bool hasErr{};
   bool hasEnd{};
   bool hasEor{};
+  fir::IfOp bigUnitIfOp;
 
   /// Check for any condition specifier that applies to specifier processing.
   bool hasErrorConditionSpec() const { return ioStatExpr != nullptr || hasErr; }
 
   /// Check for any condition specifier that applies to data transfer items
   /// in a PRINT, READ, WRITE, or WAIT statement.  (WAIT may be irrelevant.)
   bool hasTransferConditionSpec() const {
     return hasErrorConditionSpec() || hasEnd || hasEor;
   }
 
   /// Check for any condition specifier, including IOMSG.
   bool hasAnyConditionSpec() const {
-    return hasTransferConditionSpec() || ioMsgExpr != nullptr;
+    return hasTransferConditionSpec() || ioMsg;
   }
 };
 } // namespace
 
 template <typename D>
 static void genIoLoop(Fortran::lower::AbstractConverter &converter,
                       mlir::Value cookie, const D &ioImpliedDo,
                       bool isFormatted, bool checkResult, mlir::Value &ok,
-                      bool inLoop, Fortran::lower::StatementContext &stmtCtx);
+                      bool inLoop);
 
 /// Helper function to retrieve the name of the IO function given the key `A`
 template <typename A>
 static constexpr const char *getName() {
   return std::get<A>(Fortran::lower::newIOTable).name;
 }
 
 /// Helper function to retrieve the type model signature builder of the IO
 /// function as defined by the key `A`
 template <typename A>
 static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
   return std::get<A>(Fortran::lower::newIOTable).getTypeModel();
 }
 
 inline int64_t getLength(mlir::Type argTy) {
   return argTy.cast<fir::SequenceType>().getShape()[0];
 }
 
 /// Get (or generate) the MLIR FuncOp for a given IO runtime function.
 template <typename E>
 static mlir::func::FuncOp getIORuntimeFunc(mlir::Location loc,
                                            fir::FirOpBuilder &builder) {
   llvm::StringRef name = getName<E>();
-  mlir::func::FuncOp func = builder.getNamedFunction(name);
+  auto func = builder.getNamedFunction(name);
   if (func)
     return func;
   auto funTy = getTypeModel<E>()(builder.getContext());
   func = builder.createFunction(loc, name, funTy);
   func->setAttr("fir.runtime", builder.getUnitAttr());
   func->setAttr("fir.io", builder.getUnitAttr());
   return func;
 }
 
 /// Generate calls to end an IO statement.  Return the IOSTAT value, if any.
 /// It is the caller's responsibility to generate branches on that value.
 static mlir::Value genEndIO(Fortran::lower::AbstractConverter &converter,
                             mlir::Location loc, mlir::Value cookie,
-                            const ConditionSpecInfo &csi,
+                            ConditionSpecInfo &csi,
                             Fortran::lower::StatementContext &stmtCtx) {
   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
-  if (csi.ioMsgExpr) {
-    mlir::func::FuncOp getIoMsg =
-        getIORuntimeFunc<mkIOKey(GetIoMsg)>(loc, builder);
-    fir::ExtendedValue ioMsgVar =
-        converter.genExprAddr(csi.ioMsgExpr, stmtCtx, loc);
+  if (csi.ioMsg) {
+    auto getIoMsg = getIORuntimeFunc<mkIOKey(GetIoMsg)>(loc, builder);
     builder.create<fir::CallOp>(
         loc, getIoMsg,
         mlir::ValueRange{
             cookie,
             builder.createConvert(loc, getIoMsg.getFunctionType().getInput(1),
-                                  fir::getBase(ioMsgVar)),
+                                  fir::getBase(*csi.ioMsg)),
             builder.createConvert(loc, getIoMsg.getFunctionType().getInput(2),
-                                  fir::getLen(ioMsgVar))});
+                                  fir::getLen(*csi.ioMsg))});
   }
-  mlir::func::FuncOp endIoStatement =
-      getIORuntimeFunc<mkIOKey(EndIoStatement)>(loc, builder);
+  auto endIoStatement = getIORuntimeFunc<mkIOKey(EndIoStatement)>(loc, builder);
   auto call = builder.create<fir::CallOp>(loc, endIoStatement,
                                           mlir::ValueRange{cookie});
+  mlir::Value iostat = call.getResult(0);
+  if (csi.bigUnitIfOp) {
+    stmtCtx.finalize(/*popScope=*/true);
+    builder.create<fir::ResultOp>(loc, iostat);
+    builder.setInsertionPointAfter(csi.bigUnitIfOp);
+    iostat = csi.bigUnitIfOp.getResult(0);
+  }
   if (csi.ioStatExpr) {
     mlir::Value ioStatVar =
-        fir::getBase(converter.genExprAddr(csi.ioStatExpr, stmtCtx, loc));
-    mlir::Value ioStatResult = builder.createConvert(
-        loc, converter.genType(*csi.ioStatExpr), call.getResult(0));
+        fir::getBase(converter.genExprAddr(loc, csi.ioStatExpr, stmtCtx));
+    mlir::Value ioStatResult =
+        builder.createConvert(loc, converter.genType(*csi.ioStatExpr), iostat);
     builder.create<fir::StoreOp>(loc, ioStatResult, ioStatVar);
   }
-  return csi.hasTransferConditionSpec() ? call.getResult(0) : mlir::Value{};
+  return csi.hasTransferConditionSpec() ? iostat : mlir::Value{};
 }
 
 /// Make the next call in the IO statement conditional on runtime result `ok`.
 /// If a call returns `ok==false`, further suboperation calls for an IO
 /// statement will be skipped.  This may generate branch heavy, deeply nested
 /// conditionals for IO statements with a large number of suboperations.
 static void makeNextConditionalOn(fir::FirOpBuilder &builder,
                                   mlir::Location loc, bool checkResult,
if (auto ty = type.dyn_cast<mlir::IntegerType>()) {
     case 8:
       return getIORuntimeFunc<mkIOKey(OutputInteger8)>(loc, builder);
     case 16:
       return getIORuntimeFunc<mkIOKey(OutputInteger16)>(loc, builder);
     case 32:
       return getIORuntimeFunc<mkIOKey(OutputInteger32)>(loc, builder);
     case 64:
       return getIORuntimeFunc<mkIOKey(OutputInteger64)>(loc, builder);
-#ifdef __SIZEOF_INT128__
     case 128:
       return getIORuntimeFunc<mkIOKey(OutputInteger128)>(loc, builder);
-#endif
     }
     llvm_unreachable("unknown OutputInteger kind");
   }
   if (auto ty = type.dyn_cast<mlir::FloatType>()) {
     if (auto width = ty.getWidth(); width == 32)
       return getIORuntimeFunc<mkIOKey(OutputReal32)>(loc, builder);
     else if (width == 64)
       return getIORuntimeFunc<mkIOKey(OutputReal64)>(loc, builder);
if (fir::factory::CharacterExprHelper::isCharacterScalar(type)) {
     if (kindMap.getCharacterBitsize(asciiKind) == 8 &&
         fir::factory::CharacterExprHelper::getCharacterKind(type) == asciiKind)
       return getIORuntimeFunc<mkIOKey(OutputAscii)>(loc, builder);
   }
   return getIORuntimeFunc<mkIOKey(OutputDescriptor)>(loc, builder);
 }
 
 /// Generate a sequence of output data transfer calls.
-static void
-genOutputItemList(Fortran::lower::AbstractConverter &converter,
-                  mlir::Value cookie,
-                  const std::list<Fortran::parser::OutputItem> &items,
-                  bool isFormatted, bool checkResult, mlir::Value &ok,
-                  bool inLoop, Fortran::lower::StatementContext &stmtCtx) {
+static void genOutputItemList(
+    Fortran::lower::AbstractConverter &converter, mlir::Value cookie,
+    const std::list<Fortran::parser::OutputItem> &items, bool isFormatted,
+    bool checkResult, mlir::Value &ok, bool inLoop) {
   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
   for (const Fortran::parser::OutputItem &item : items) {
     if (const auto &impliedDo = std::get_if<1>(&item.u)) {
       genIoLoop(converter, cookie, impliedDo->value(), isFormatted, checkResult,
-                ok, inLoop, stmtCtx);
+                ok, inLoop);
       continue;
     }
     auto &pExpr = std::get<Fortran::parser::Expr>(item.u);
     mlir::Location loc = converter.genLocation(pExpr.source);
     makeNextConditionalOn(builder, loc, checkResult, ok, inLoop);
+    Fortran::lower::StatementContext stmtCtx;
 
     const auto *expr = Fortran::semantics::GetExpr(pExpr);
     if (!expr)
       fir::emitFatalError(loc, "internal error: could not get evaluate::Expr");
     mlir::Type itemTy = converter.genType(*expr);
-    mlir::func::FuncOp outputFunc =
-        getOutputFunc(loc, builder, itemTy, isFormatted);
+    auto outputFunc = getOutputFunc(loc, builder, itemTy, isFormatted);
     mlir::Type argType = outputFunc.getFunctionType().getInput(1);
     assert((isFormatted || argType.isa<fir::BoxType>()) &&
            "expect descriptor for unformatted IO runtime");
     llvm::SmallVector<mlir::Value> outputFuncArgs = {cookie};
     fir::factory::CharacterExprHelper helper{builder, loc};
     if (argType.isa<fir::BoxType>()) {
-      mlir::Value box = fir::getBase(converter.genExprBox(*expr, stmtCtx, loc));
+      mlir::Value box = fir::getBase(converter.genExprBox(loc, *expr, stmtCtx));
       outputFuncArgs.push_back(builder.createConvert(loc, argType, box));
     } else if (helper.isCharacterScalar(itemTy)) {
-      fir::ExtendedValue exv = converter.genExprAddr(expr, stmtCtx, loc);
+      fir::ExtendedValue exv = converter.genExprAddr(loc, expr, stmtCtx);
       // scalar allocatable/pointer may also get here, not clear if
       // genExprAddr will lower them as CharBoxValue or BoxValue.
       if (!exv.getCharBox())
         llvm::report_fatal_error(
             "internal error: scalar character not in CharBox");
       outputFuncArgs.push_back(builder.createConvert(
           loc, outputFunc.getFunctionType().getInput(1), fir::getBase(exv)));
       outputFuncArgs.push_back(builder.createConvert(
           loc, outputFunc.getFunctionType().getInput(2), fir::getLen(exv)));
     } else {
-      fir::ExtendedValue itemBox = converter.genExprValue(expr, stmtCtx, loc);
+      fir::ExtendedValue itemBox = converter.genExprValue(loc, expr, stmtCtx);
       mlir::Value itemValue = fir::getBase(itemBox);
       if (fir::isa_complex(itemTy)) {
         auto parts =
             fir::factory::Complex{builder, loc}.extractParts(itemValue);
         outputFuncArgs.push_back(parts.first);
         outputFuncArgs.push_back(parts.second);
       } else {
         itemValue = builder.createConvert(loc, argType, itemValue);
static mlir::Value createIoRuntimeCallForItem(mlir::Location loc,
   return call.getResult(0);
 }
 
 /// Generate a sequence of input data transfer calls.
 static void genInputItemList(Fortran::lower::AbstractConverter &converter,
                              mlir::Value cookie,
                              const std::list<Fortran::parser::InputItem> &items,
                              bool isFormatted, bool checkResult,
-                             mlir::Value &ok, bool inLoop,
-                             Fortran::lower::StatementContext &stmtCtx) {
+                             mlir::Value &ok, bool inLoop) {
   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
   for (const Fortran::parser::InputItem &item : items) {
     if (const auto &impliedDo = std::get_if<1>(&item.u)) {
       genIoLoop(converter, cookie, impliedDo->value(), isFormatted, checkResult,
-                ok, inLoop, stmtCtx);
+                ok, inLoop);
       continue;
     }
     auto &pVar = std::get<Fortran::parser::Variable>(item.u);
     mlir::Location loc = converter.genLocation(pVar.GetSource());
     makeNextConditionalOn(builder, loc, checkResult, ok, inLoop);
+    Fortran::lower::StatementContext stmtCtx;
     const auto *expr = Fortran::semantics::GetExpr(pVar);
     if (!expr)
       fir::emitFatalError(loc, "internal error: could not get evaluate::Expr");
     if (Fortran::evaluate::HasVectorSubscript(*expr)) {
       auto vectorSubscriptBox =
           Fortran::lower::genVectorSubscriptBox(loc, converter, stmtCtx, *expr);
-      mlir::func::FuncOp inputFunc = getInputFunc(
+      auto inputFunc = getInputFunc(
           loc, builder, vectorSubscriptBox.getElementType(), isFormatted);
       const bool mustBox =
           inputFunc.getFunctionType().getInput(1).isa<fir::BoxType>();
       if (!checkResult) {
         auto elementalGenerator = [&](const fir::ExtendedValue &element) {
           createIoRuntimeCallForItem(loc, builder, inputFunc, cookie,
                                      mustBox ? builder.createBox(loc, element)
                                              : element);
if (Fortran::evaluate::HasVectorSubscript(*expr)) {
         if (!ok)
           ok = builder.createBool(loc, true);
         ok = vectorSubscriptBox.loopOverElementsWhile(builder, loc,
                                                       elementalGenerator, ok);
       }
       continue;
     }
     mlir::Type itemTy = converter.genType(*expr);
-    mlir::func::FuncOp inputFunc =
-        getInputFunc(loc, builder, itemTy, isFormatted);
+    auto inputFunc = getInputFunc(loc, builder, itemTy, isFormatted);
     auto itemExv = inputFunc.getFunctionType().getInput(1).isa<fir::BoxType>()
-                       ? converter.genExprBox(*expr, stmtCtx, loc)
-                       : converter.genExprAddr(expr, stmtCtx, loc);
+                       ? converter.genExprBox(loc, *expr, stmtCtx)
+                       : converter.genExprAddr(loc, expr, stmtCtx);
     ok = createIoRuntimeCallForItem(loc, builder, inputFunc, cookie, itemExv);
   }
 }
 
 /// Generate an io-implied-do loop.
 template <typename D>
 static void genIoLoop(Fortran::lower::AbstractConverter &converter,
                       mlir::Value cookie, const D &ioImpliedDo,
                       bool isFormatted, bool checkResult, mlir::Value &ok,
-                      bool inLoop, Fortran::lower::StatementContext &stmtCtx) {
+                      bool inLoop) {
+  Fortran::lower::StatementContext stmtCtx;
   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
   mlir::Location loc = converter.getCurrentLocation();
   makeNextConditionalOn(builder, loc, checkResult, ok, inLoop);
   const auto &itemList = std::get<0>(ioImpliedDo.t);
   const auto &control = std::get<1>(ioImpliedDo.t);
   const auto &loopSym = *control.name.thing.thing.symbol;
-  mlir::Value loopVar = converter.getSymbolAddress(loopSym);
+  mlir::Value loopVar = fir::getBase(converter.genExprAddr(
+      Fortran::evaluate::AsGenericExpr(loopSym).value(), stmtCtx));
   auto genControlValue = [&](const Fortran::parser::ScalarIntExpr &expr) {
     mlir::Value v = fir::getBase(
         converter.genExprValue(*Fortran::semantics::GetExpr(expr), stmtCtx));
     return builder.createConvert(loc, builder.getIndexType(), v);
   };
   mlir::Value lowerValue = genControlValue(control.lower);
   mlir::Value upperValue = genControlValue(control.upper);
   mlir::Value stepValue =
       control.step.has_value()
           ? genControlValue(*control.step)
           : builder.create<mlir::arith::ConstantIndexOp>(loc, 1);
   auto genItemList = [&](const D &ioImpliedDo) {
-    Fortran::lower::StatementContext loopCtx;
     if constexpr (std::is_same_v<D, Fortran::parser::InputImpliedDo>)
       genInputItemList(converter, cookie, itemList, isFormatted, checkResult,
-                       ok, /*inLoop=*/true, loopCtx);
+                       ok, /*inLoop=*/true);
     else
       genOutputItemList(converter, cookie, itemList, isFormatted, checkResult,
-                        ok, /*inLoop=*/true, loopCtx);
+                        ok, /*inLoop=*/true);
   };
   if (!checkResult) {
     // No IO call result checks - the loop is a fir.do_loop op.
     auto doLoopOp = builder.create<fir::DoLoopOp>(
         loc, lowerValue, upperValue, stepValue, /*unordered=*/false,
         /*finalCountValue=*/true);
     builder.setInsertionPointToStart(doLoopOp.getBody());
-    mlir::Value lcv = builder.createConvert(loc, converter.genType(loopSym),
-                                            doLoopOp.getInductionVar());
+    mlir::Value lcv = builder.createConvert(
+        loc, fir::unwrapRefType(loopVar.getType()), doLoopOp.getInductionVar());
     builder.create<fir::StoreOp>(loc, lcv, loopVar);
     genItemList(ioImpliedDo);
     builder.setInsertionPointToEnd(doLoopOp.getBody());
     mlir::Value result = builder.create<mlir::arith::AddIOp>(
         loc, doLoopOp.getInductionVar(), doLoopOp.getStep());
     builder.create<fir::ResultOp>(loc, result);
     builder.setInsertionPointAfter(doLoopOp);
     // The loop control variable may be used after the loop.
-    lcv = builder.createConvert(loc, converter.genType(loopSym),
+    lcv = builder.createConvert(loc, fir::unwrapRefType(loopVar.getType()),
                                 doLoopOp.getResult(0));
     builder.create<fir::StoreOp>(loc, lcv, loopVar);
     return;
   }
   // Check IO call results - the loop is a fir.iterate_while op.
   if (!ok)
     ok = builder.createBool(loc, true);
   auto iterWhileOp = builder.create<fir::IterWhileOp>(
       loc, lowerValue, upperValue, stepValue, ok, /*finalCountValue*/ true);
   builder.setInsertionPointToStart(iterWhileOp.getBody());
-  mlir::Value lcv = builder.createConvert(loc, converter.genType(loopSym),
-                                          iterWhileOp.getInductionVar());
+  mlir::Value lcv =
+      builder.createConvert(loc, fir::unwrapRefType(loopVar.getType()),
   builder.create<fir::StoreOp>(loc, lcv, loopVar);
   ok = iterWhileOp.getIterateVar();
   mlir::Value falseValue =
       builder.createIntegerConstant(loc, builder.getI1Type(), 0);
   genItemList(ioImpliedDo);
   // Unwind nested IO call scopes, filling in true and false ResultOp's.
   for (mlir::Operation *op = builder.getBlock()->getParentOp();
        mlir::isa<fir::IfOp>(op); op = op->getBlock()->getParentOp()) {
auto inductionResult1 = builder.create<mlir::arith::AddIOp>(
       loc, inductionResult0, iterWhileOp.getStep());
   auto inductionResult = builder.create<mlir::arith::SelectOp>(
       loc, iterateResult, inductionResult1, inductionResult0);
   llvm::SmallVector<mlir::Value> results = {inductionResult, iterateResult};
   builder.create<fir::ResultOp>(loc, results);
   ok = iterWhileOp.getResult(1);
   builder.setInsertionPointAfter(iterWhileOp);
   // The loop control variable may be used after the loop.
-  lcv = builder.createConvert(loc, converter.genType(loopSym),
+  lcv = builder.createConvert(loc, fir::unwrapRefType(loopVar.getType()),
                               iterWhileOp.getResult(0));
   builder.create<fir::StoreOp>(loc, lcv, loopVar);
 }
 
 //===----------------------------------------------------------------------===//
 // Default argument generation.
 //===----------------------------------------------------------------------===//
 

 
 /// Generic to build an integral argument to the runtime.
 template <typename A, typename B>
 mlir::Value genIntIOOption(Fortran::lower::AbstractConverter &converter,
                            mlir::Location loc, mlir::Value cookie,
                            const B &spec) {
   Fortran::lower::StatementContext localStatementCtx;
   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
-  mlir::func::FuncOp ioFunc = getIORuntimeFunc<A>(loc, builder);
+  auto ioFunc = getIORuntimeFunc<A>(loc, builder);
   mlir::FunctionType ioFuncTy = ioFunc.getFunctionType();
   mlir::Value expr = fir::getBase(converter.genExprValue(
-      Fortran::semantics::GetExpr(spec.v), localStatementCtx, loc));
+      loc, Fortran::semantics::GetExpr(spec.v), localStatementCtx));
   mlir::Value val = builder.createConvert(loc, ioFuncTy.getInput(1), expr);
   llvm::SmallVector<mlir::Value> ioArgs = {cookie, val};
   return builder.create<fir::CallOp>(loc, ioFunc, ioArgs).getResult(0);
 }
 
 /// Generic to build a string argument to the runtime. This passes a CHARACTER
 /// as a pointer to the buffer and a LEN parameter.
 template <typename A, typename B>
 mlir::Value genCharIOOption(Fortran::lower::AbstractConverter &converter,
                             mlir::Location loc, mlir::Value cookie,
                             const B &spec) {
   Fortran::lower::StatementContext localStatementCtx;
   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
-  mlir::func::FuncOp ioFunc = getIORuntimeFunc<A>(loc, builder);
+  auto ioFunc = getIORuntimeFunc<A>(loc, builder);
   mlir::FunctionType ioFuncTy = ioFunc.getFunctionType();
   std::tuple<mlir::Value, mlir::Value, mlir::Value> tup =
       lowerStringLit(converter, loc, localStatementCtx, spec,
                      ioFuncTy.getInput(1), ioFuncTy.getInput(2));
   llvm::SmallVector<mlir::Value> ioArgs = {cookie, std::get<0>(tup),
                                            std::get<1>(tup)};
   return builder.create<fir::CallOp>(loc, ioFunc, ioArgs).getResult(0);
 }

 
 template <>
 mlir::Value genIOOption<Fortran::parser::FileNameExpr>(
     Fortran::lower::AbstractConverter &converter, mlir::Location loc,
     mlir::Value cookie, const Fortran::parser::FileNameExpr &spec) {
   Fortran::lower::StatementContext localStatementCtx;
   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
   // has an extra KIND argument
-  mlir::func::FuncOp ioFunc = getIORuntimeFunc<mkIOKey(SetFile)>(loc, builder);
+  auto ioFunc = getIORuntimeFunc<mkIOKey(SetFile)>(loc, builder);
   mlir::FunctionType ioFuncTy = ioFunc.getFunctionType();
   std::tuple<mlir::Value, mlir::Value, mlir::Value> tup =
       lowerStringLit(converter, loc, localStatementCtx, spec,
                      ioFuncTy.getInput(1), ioFuncTy.getInput(2));
   llvm::SmallVector<mlir::Value> ioArgs{cookie, std::get<0>(tup),
                                         std::get<1>(tup)};
   return builder.create<fir::CallOp>(loc, ioFunc, ioArgs).getResult(0);
 }
static void genIOReadSize(Fortran::lower::AbstractConverter &converter,
   // needs to be filled even if some error condition (end-of-file...) was met
   // during the input statement (in which case the runtime may return zero for
   // the size read).
   for (const auto &spec : specList)
     if (const auto *size =
             std::get_if<Fortran::parser::IoControlSpec::Size>(&spec.u)) {
 
       fir::FirOpBuilder &builder = converter.getFirOpBuilder();
-      mlir::func::FuncOp ioFunc =
-          getIORuntimeFunc<mkIOKey(GetSize)>(loc, builder);
+      auto ioFunc = getIORuntimeFunc<mkIOKey(GetSize)>(loc, builder);
       auto sizeValue =
           builder.create<fir::CallOp>(loc, ioFunc, mlir::ValueRange{cookie})
               .getResult(0);
       Fortran::lower::StatementContext localStatementCtx;
       fir::ExtendedValue var = converter.genExprAddr(
-          Fortran::semantics::GetExpr(size->v), localStatementCtx, loc);
+          loc, Fortran::semantics::GetExpr(size->v), localStatementCtx);
       mlir::Value varAddr = fir::getBase(var);
       mlir::Type varType = fir::unwrapPassByRefType(varAddr.getType());
       mlir::Value sizeCast = builder.createConvert(loc, varType, sizeValue);
       builder.create<fir::StoreOp>(loc, sizeCast, varAddr);
       break;
     }
 }
 

 }
 
 /// Most IO statements allow one or more of five optional exception condition
 /// handling specifiers: ERR, EOR, END, IOSTAT, and IOMSG. The first three
 /// cause control flow to transfer to another statement. The final two return
 /// information from the runtime, via a variable, about the nature of the
 /// condition that occurred. These condition specifiers are handled here.
 template <typename A>
-static void
-genConditionHandlerCall(Fortran::lower::AbstractConverter &converter,
-                        mlir::Location loc, mlir::Value cookie,
-                        const A &specList, ConditionSpecInfo &csi) {
+ConditionSpecInfo lowerErrorSpec(Fortran::lower::AbstractConverter &converter,
+                                 mlir::Location loc, const A &specList) {
+  ConditionSpecInfo csi;
+  const Fortran::lower::SomeExpr *ioMsgExpr = nullptr;
   for (const auto &spec : specList) {
     std::visit(
         Fortran::common::visitors{
             [&](const Fortran::parser::StatVariable &var) {
               csi.ioStatExpr = Fortran::semantics::GetExpr(var);
             },
             [&](const Fortran::parser::InquireSpec::IntVar &var) {
               if (std::get<Fortran::parser::InquireSpec::IntVar::Kind>(var.t) ==
                   Fortran::parser::InquireSpec::IntVar::Kind::Iostat)
                 csi.ioStatExpr = Fortran::semantics::GetExpr(
                     std::get<Fortran::parser::ScalarIntVariable>(var.t));
             },
             [&](const Fortran::parser::MsgVariable &var) {
-              csi.ioMsgExpr = Fortran::semantics::GetExpr(var);
+              ioMsgExpr = Fortran::semantics::GetExpr(var);
             },
             [&](const Fortran::parser::InquireSpec::CharVar &var) {
               if (std::get<Fortran::parser::InquireSpec::CharVar::Kind>(
                       var.t) ==
                   Fortran::parser::InquireSpec::CharVar::Kind::Iomsg)
-                csi.ioMsgExpr = Fortran::semantics::GetExpr(
+                ioMsgExpr = Fortran::semantics::GetExpr(
                     std::get<Fortran::parser::ScalarDefaultCharVariable>(
                         var.t));
             },
             [&](const Fortran::parser::EndLabel &) { csi.hasEnd = true; },
             [&](const Fortran::parser::EorLabel &) { csi.hasEor = true; },
             [&](const Fortran::parser::ErrLabel &) { csi.hasErr = true; },
             [](const auto &) {}},
         spec.u);
   }
+  if (ioMsgExpr) {
+    // iomsg is a variable, its evaluation may require temps, but it cannot
+    // itself be a temp, and it is ok to us a local statement context here.
+    Fortran::lower::StatementContext stmtCtx;
+    csi.ioMsg = converter.genExprAddr(loc, ioMsgExpr, stmtCtx);
+  }
+
+  return csi;
+}
+template <typename A>
+static void
+genConditionHandlerCall(Fortran::lower::AbstractConverter &converter,
+                        mlir::Location loc, mlir::Value cookie,
+                        const A &specList, ConditionSpecInfo &csi) {
   if (!csi.hasAnyConditionSpec())
     return;
   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
-  mlir::func::FuncOp enableHandlers =
-      getIORuntimeFunc<mkIOKey(EnableHandlers)>(loc, builder);
+  auto enableHandlers = getIORuntimeFunc<mkIOKey(EnableHandlers)>(loc, builder);
   mlir::Type boolType = enableHandlers.getFunctionType().getInput(1);
   auto boolValue = [&](bool specifierIsPresent) {
     return builder.create<mlir::arith::ConstantOp>(
         loc, builder.getIntegerAttr(boolType, specifierIsPresent));
   };
   llvm::SmallVector<mlir::Value> ioArgs = {cookie,
                                            boolValue(csi.ioStatExpr != nullptr),
                                            boolValue(csi.hasErr),
                                            boolValue(csi.hasEnd),
                                            boolValue(csi.hasEor),
-                                           boolValue(csi.ioMsgExpr != nullptr)};
+                                           boolValue(csi.ioMsg.hasValue())};
   builder.create<fir::CallOp>(loc, enableHandlers, ioArgs);
 }
 
 //===----------------------------------------------------------------------===//
 // Data transfer helpers
 //===----------------------------------------------------------------------===//
 
 template <typename SEEK, typename A>
lowerReferenceAsStringSelect(Fortran::lower::AbstractConverter &converter,
   // Crash the program.
   builder.create<fir::UnreachableOp>(loc);
 
   // Add unit case to the select statement.
   blockList.push_back(unitBlock);
 
   // Lower the selectOp.
   builder.setInsertionPointToEnd(startBlock);
-  auto label = fir::getBase(converter.genExprValue(&expr, stmtCtx, loc));
+  auto label = fir::getBase(converter.genExprValue(loc, &expr, stmtCtx));
   builder.create<fir::SelectOp>(loc, label, indexList, blockList);
 
   builder.setInsertionPointToEnd(endBlock);
   endBlock->addArgument(strTy, loc);
   endBlock->addArgument(lenTy, loc);
 
   // Handle and return the string reference and length selected by the selectOp.
   auto buff = endBlock->getArgument(0);
const Fortran::parser::IoUnit *iounit =
       stmt.iounit ? &*stmt.iounit : getIOControl<Fortran::parser::IoUnit>(stmt);
   if (iounit)
     if (auto *var = std::get_if<Fortran::parser::Variable>(&iounit->u))
       if (auto *expr = Fortran::semantics::GetExpr(*var))
         return genBuffer(converter, loc, *expr, strTy, lenTy, stmtCtx);
   llvm::report_fatal_error("failed to get IoUnit expr in lowering");
 }
 
-static mlir::Value genIOUnit(Fortran::lower::AbstractConverter &converter,
+static mlir::Value genIOUnitNumber(Fortran::lower::AbstractConverter &converter,
                                    mlir::Location loc,
-                             const Fortran::parser::IoUnit &iounit,
-                             mlir::Type ty,
+                                   const Fortran::lower::SomeExpr *iounit,
+                                   mlir::Type ty, ConditionSpecInfo &csi,
                                    Fortran::lower::StatementContext &stmtCtx) {
   auto &builder = converter.getFirOpBuilder();
-  if (auto *e = std::get_if<Fortran::parser::FileUnitNumber>(&iounit.u)) {
-    auto ex = fir::getBase(
-        converter.genExprValue(Fortran::semantics::GetExpr(*e), stmtCtx, loc));
-    return builder.createConvert(loc, ty, ex);
+  auto rawUnit = fir::getBase(converter.genExprValue(loc, iounit, stmtCtx));
+  unsigned rawUnitWidth =
+      rawUnit.getType().cast<mlir::IntegerType>().getWidth();
+  unsigned runtimeArgWidth = ty.cast<mlir::IntegerType>().getWidth();
+  // The IO runtime supports `int` unit numbers, if the unit number may
+  // overflow when passed to the IO runtime, check that the unit number is
+  // in range before calling the BeginXXX.
+  if (rawUnitWidth > runtimeArgWidth) {
+    auto check =
+        rawUnitWidth <= 64
+            ? getIORuntimeFunc<mkIOKey(CheckUnitNumberInRange64)>(loc, builder)
+            : getIORuntimeFunc<mkIOKey(CheckUnitNumberInRange128)>(loc,
+                                                                   builder);
+    mlir::FunctionType funcTy = check.getFunctionType();
+    llvm::SmallVector<mlir::Value> args;
+    args.push_back(builder.createConvert(loc, funcTy.getInput(0), rawUnit));
+    args.push_back(builder.createBool(loc, csi.hasErrorConditionSpec()));
+    if (csi.ioMsg) {
+      args.push_back(builder.createConvert(loc, funcTy.getInput(2),
+                                           fir::getBase(*csi.ioMsg)));
+      args.push_back(builder.createConvert(loc, funcTy.getInput(3),
+                                           fir::getLen(*csi.ioMsg)));
+    } else {
+      args.push_back(builder.createNullConstant(loc, funcTy.getInput(2)));
+      args.push_back(
+          fir::factory::createZeroValue(builder, loc, funcTy.getInput(3)));
+    }
+    mlir::Value file = locToFilename(converter, loc, funcTy.getInput(4));
+    mlir::Value line = locToLineNo(converter, loc, funcTy.getInput(5));
+    args.push_back(file);
+    args.push_back(line);
+    auto checkCall = builder.create<fir::CallOp>(loc, check, args);
+    if (csi.hasErrorConditionSpec()) {
+      mlir::Value iostat = checkCall.getResult(0);
+      mlir::Type iostatTy = iostat.getType();
+      mlir::Value zero = fir::factory::createZeroValue(builder, loc, iostatTy);
+      mlir::Value unitIsOK = builder.create<mlir::arith::CmpIOp>(
+          loc, mlir::arith::CmpIPredicate::eq, iostat, zero);
+      auto ifOp = builder.create<fir::IfOp>(loc, iostatTy, unitIsOK,
+                                            /*withElseRegion=*/true);
+      builder.setInsertionPointToStart(&ifOp.getElseRegion().front());
+      builder.create<fir::ResultOp>(loc, iostat);
+      builder.setInsertionPointToStart(&ifOp.getThenRegion().front());
+      stmtCtx.pushScope();
+      csi.bigUnitIfOp = ifOp;
+    }
   }
+  return builder.createConvert(loc, ty, rawUnit);
+}
+
+static mlir::Value genIOUnit(Fortran::lower::AbstractConverter &converter,
+                             mlir::Location loc,
+                             const Fortran::parser::IoUnit *iounit,
+                             mlir::Type ty, ConditionSpecInfo &csi,
+                             Fortran::lower::StatementContext &stmtCtx) {
+  auto &builder = converter.getFirOpBuilder();
+  if (iounit)
+    if (auto *e = std::get_if<Fortran::parser::FileUnitNumber>(&iounit->u))
+      return genIOUnitNumber(converter, loc, Fortran::semantics::GetExpr(*e),
+                             ty, csi, stmtCtx);
   return builder.create<mlir::arith::ConstantOp>(
       loc, builder.getIntegerAttr(ty, Fortran::runtime::io::DefaultUnit));
 }
 
 template <typename A>
-mlir::Value getIOUnit(Fortran::lower::AbstractConverter &converter,
+static mlir::Value getIOUnit(Fortran::lower::AbstractConverter &converter,
                              mlir::Location loc, const A &stmt, mlir::Type ty,
+                             ConditionSpecInfo &csi,
                              Fortran::lower::StatementContext &stmtCtx) {
-  if (stmt.iounit)
-    return genIOUnit(converter, loc, *stmt.iounit, ty, stmtCtx);
-  if (auto *iounit = getIOControl<Fortran::parser::IoUnit>(stmt))
-    return genIOUnit(converter, loc, *iounit, ty, stmtCtx);
-  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
-  return builder.create<mlir::arith::ConstantOp>(
-      loc, builder.getIntegerAttr(ty, Fortran::runtime::io::DefaultUnit));
+  const Fortran::parser::IoUnit *iounit =
+      stmt.iounit ? &*stmt.iounit : getIOControl<Fortran::parser::IoUnit>(stmt);
+  return genIOUnit(converter, loc, iounit, ty, csi, stmtCtx);
 }
-
 //===----------------------------------------------------------------------===//
 // Generators for each IO statement type.
 //===----------------------------------------------------------------------===//
 
 template <typename K, typename S>
 static mlir::Value genBasicIOStmt(Fortran::lower::AbstractConverter &converter,
                                   const S &stmt) {
   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
   Fortran::lower::StatementContext stmtCtx;
   mlir::Location loc = converter.getCurrentLocation();
-  mlir::func::FuncOp beginFunc = getIORuntimeFunc<K>(loc, builder);
+  ConditionSpecInfo csi = lowerErrorSpec(converter, loc, stmt.v);
+  auto beginFunc = getIORuntimeFunc<K>(loc, builder);
   mlir::FunctionType beginFuncTy = beginFunc.getFunctionType();
-  mlir::Value unit = fir::getBase(converter.genExprValue(
-      getExpr<Fortran::parser::FileUnitNumber>(stmt), stmtCtx, loc));
+  mlir::Value unit = genIOUnitNumber(
+      converter, loc, getExpr<Fortran::parser::FileUnitNumber>(stmt),
+      beginFuncTy.getInput(0), csi, stmtCtx);
   mlir::Value un = builder.createConvert(loc, beginFuncTy.getInput(0), unit);
   mlir::Value file = locToFilename(converter, loc, beginFuncTy.getInput(1));
   mlir::Value line = locToLineNo(converter, loc, beginFuncTy.getInput(2));
   auto call = builder.create<fir::CallOp>(loc, beginFunc,
                                           mlir::ValueRange{un, file, line});
   mlir::Value cookie = call.getResult(0);
-  ConditionSpecInfo csi;
   genConditionHandlerCall(converter, loc, cookie, stmt.v, csi);
   mlir::Value ok;
   auto insertPt = builder.saveInsertionPoint();
   threadSpecs(converter, loc, cookie, stmt.v, csi.hasErrorConditionSpec(), ok);
   builder.restoreInsertionPoint(insertPt);
   return genEndIO(converter, converter.getCurrentLocation(), cookie, csi,
                   stmtCtx);
 }

 genNewunitSpec(Fortran::lower::AbstractConverter &converter, mlir::Location loc,
                mlir::Value cookie,
                const std::list<Fortran::parser::ConnectSpec> &specList) {
   for (const auto &spec : specList)
     if (auto *newunit =
             std::get_if<Fortran::parser::ConnectSpec::Newunit>(&spec.u)) {
       Fortran::lower::StatementContext stmtCtx;
       fir::FirOpBuilder &builder = converter.getFirOpBuilder();
-      mlir::func::FuncOp ioFunc =
-          getIORuntimeFunc<mkIOKey(GetNewUnit)>(loc, builder);
+      auto ioFunc = getIORuntimeFunc<mkIOKey(GetNewUnit)>(loc, builder);
       mlir::FunctionType ioFuncTy = ioFunc.getFunctionType();
       const auto *var = Fortran::semantics::GetExpr(newunit->v);
       mlir::Value addr = builder.createConvert(
           loc, ioFuncTy.getInput(1),
-          fir::getBase(converter.genExprAddr(var, stmtCtx, loc)));
+          fir::getBase(converter.genExprAddr(loc, var, stmtCtx)));
       auto kind = builder.createIntegerConstant(loc, ioFuncTy.getInput(2),
                                                 var->GetType().value().kind());
       llvm::SmallVector<mlir::Value> ioArgs = {cookie, addr, kind};
       return builder.create<fir::CallOp>(loc, ioFunc, ioArgs).getResult(0);
     }
   llvm_unreachable("missing Newunit spec");
 }
 
 mlir::Value
 Fortran::lower::genOpenStatement(Fortran::lower::AbstractConverter &converter,
                                  const Fortran::parser::OpenStmt &stmt) {
   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
   Fortran::lower::StatementContext stmtCtx;
   mlir::func::FuncOp beginFunc;
   llvm::SmallVector<mlir::Value> beginArgs;
   mlir::Location loc = converter.getCurrentLocation();
+  ConditionSpecInfo csi = lowerErrorSpec(converter, loc, stmt.v);
   bool hasNewunitSpec = false;
   if (hasSpec<Fortran::parser::FileUnitNumber>(stmt)) {
     beginFunc = getIORuntimeFunc<mkIOKey(BeginOpenUnit)>(loc, builder);
     mlir::FunctionType beginFuncTy = beginFunc.getFunctionType();
-    mlir::Value unit = fir::getBase(converter.genExprValue(
-        getExpr<Fortran::parser::FileUnitNumber>(stmt), stmtCtx, loc));
-    beginArgs.push_back(
-        builder.createConvert(loc, beginFuncTy.getInput(0), unit));
+    mlir::Value unit = genIOUnitNumber(
+        converter, loc, getExpr<Fortran::parser::FileUnitNumber>(stmt),
+        beginFuncTy.getInput(0), csi, stmtCtx);
+    beginArgs.push_back(unit);
     beginArgs.push_back(locToFilename(converter, loc, beginFuncTy.getInput(1)));
     beginArgs.push_back(locToLineNo(converter, loc, beginFuncTy.getInput(2)));
   } else {
     hasNewunitSpec = hasSpec<Fortran::parser::ConnectSpec::Newunit>(stmt);
     assert(hasNewunitSpec && "missing unit specifier");
     beginFunc = getIORuntimeFunc<mkIOKey(BeginOpenNewUnit)>(loc, builder);
     mlir::FunctionType beginFuncTy = beginFunc.getFunctionType();
     beginArgs.push_back(locToFilename(converter, loc, beginFuncTy.getInput(0)));
     beginArgs.push_back(locToLineNo(converter, loc, beginFuncTy.getInput(1)));
   }
   auto cookie =
       builder.create<fir::CallOp>(loc, beginFunc, beginArgs).getResult(0);
-  ConditionSpecInfo csi;
   genConditionHandlerCall(converter, loc, cookie, stmt.v, csi);
   mlir::Value ok;
   auto insertPt = builder.saveInsertionPoint();
   threadSpecs(converter, loc, cookie, stmt.v, csi.hasErrorConditionSpec(), ok);
   if (hasNewunitSpec)
     genNewunitSpec(converter, loc, cookie, stmt.v);
   builder.restoreInsertionPoint(insertPt);
   return genEndIO(converter, loc, cookie, csi, stmtCtx);
 }
 
 mlir::Value
 Fortran::lower::genCloseStatement(Fortran::lower::AbstractConverter &converter,
                                   const Fortran::parser::CloseStmt &stmt) {
   return genBasicIOStmt<mkIOKey(BeginClose)>(converter, stmt);
 }
 
 mlir::Value
 Fortran::lower::genWaitStatement(Fortran::lower::AbstractConverter &converter,
                                  const Fortran::parser::WaitStmt &stmt) {
   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
   Fortran::lower::StatementContext stmtCtx;
   mlir::Location loc = converter.getCurrentLocation();
+  ConditionSpecInfo csi = lowerErrorSpec(converter, loc, stmt.v);
   bool hasId = hasSpec<Fortran::parser::IdExpr>(stmt);
-  mlir::func::FuncOp beginFunc =
-      hasId ? getIORuntimeFunc<mkIOKey(BeginWait)>(loc, builder)
+  auto beginFunc = hasId
+                       ? getIORuntimeFunc<mkIOKey(BeginWait)>(loc, builder)
                        : getIORuntimeFunc<mkIOKey(BeginWaitAll)>(loc, builder);
   mlir::FunctionType beginFuncTy = beginFunc.getFunctionType();
-  mlir::Value unit = fir::getBase(converter.genExprValue(
-      getExpr<Fortran::parser::FileUnitNumber>(stmt), stmtCtx, loc));
-  mlir::Value un = builder.createConvert(loc, beginFuncTy.getInput(0), unit);
-  llvm::SmallVector<mlir::Value> args{un};
+  mlir::Value unit = genIOUnitNumber(
+      converter, loc, getExpr<Fortran::parser::FileUnitNumber>(stmt),
+      beginFuncTy.getInput(0), csi, stmtCtx);
+  llvm::SmallVector<mlir::Value> args{unit};
   if (hasId) {
     mlir::Value id = fir::getBase(converter.genExprValue(
-        getExpr<Fortran::parser::IdExpr>(stmt), stmtCtx, loc));
+        loc, getExpr<Fortran::parser::IdExpr>(stmt), stmtCtx));
     args.push_back(builder.createConvert(loc, beginFuncTy.getInput(1), id));
   }
   auto cookie = builder.create<fir::CallOp>(loc, beginFunc, args).getResult(0);
-  ConditionSpecInfo csi;
   genConditionHandlerCall(converter, loc, cookie, stmt.v, csi);
   return genEndIO(converter, converter.getCurrentLocation(), cookie, csi,
                   stmtCtx);
 }
 
 //===----------------------------------------------------------------------===//
 // Data transfer statements.
 //

 /// Generate the arguments of a begin data transfer statement call.
 template <bool hasIOCtrl, typename A>
 void genBeginDataTransferCallArgs(
     llvm::SmallVectorImpl<mlir::Value> &ioArgs,
     Fortran::lower::AbstractConverter &converter, mlir::Location loc,
     const A &stmt, mlir::FunctionType ioFuncTy, bool isFormatted,
     bool isListOrNml, [[maybe_unused]] bool isInternal,
     [[maybe_unused]] bool isAsync,
-    const llvm::Optional<fir::ExtendedValue> &descRef,
+    const llvm::Optional<fir::ExtendedValue> &descRef, ConditionSpecInfo &csi,
     Fortran::lower::StatementContext &stmtCtx) {
   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
   auto maybeGetFormatArgs = [&]() {
     if (!isFormatted || isListOrNml)
       return;
     auto pair =
         getFormat(converter, loc, stmt, ioFuncTy.getInput(ioArgs.size()),
                   ioFuncTy.getInput(ioArgs.size() + 1), stmtCtx);
if (isInternal) {
       }
       maybeGetFormatArgs();
       ioArgs.push_back( // internal scratch area buffer
           getDefaultScratch(builder, loc, ioFuncTy.getInput(ioArgs.size())));
       ioArgs.push_back( // buffer length
           getDefaultScratchLen(builder, loc, ioFuncTy.getInput(ioArgs.size())));
     } else if (isAsync) { // unit; REC; buffer and length
       ioArgs.push_back(getIOUnit(converter, loc, stmt,
-                                 ioFuncTy.getInput(ioArgs.size()), stmtCtx));
+                                 ioFuncTy.getInput(ioArgs.size()), csi,
+                                 stmtCtx));
       TODO(loc, "asynchronous");
     } else { // external IO - maybe explicit format; unit
       maybeGetFormatArgs();
       ioArgs.push_back(getIOUnit(converter, loc, stmt,
-                                 ioFuncTy.getInput(ioArgs.size()), stmtCtx));
+                                 ioFuncTy.getInput(ioArgs.size()), csi,
+                                 stmtCtx));
     }
   } else { // PRINT - maybe explicit format; default unit
     maybeGetFormatArgs();
     ioArgs.push_back(builder.create<mlir::arith::ConstantOp>(
         loc, builder.getIntegerAttr(ioFuncTy.getInput(ioArgs.size()),
                                     Fortran::runtime::io::DefaultUnit)));
   }
   // File name and line number are always the last two arguments.
genDataTransferStmt(Fortran::lower::AbstractConverter &converter,
   const bool isInternal = isDataTransferInternal(stmt);
   llvm::Optional<fir::ExtendedValue> descRef =
       isInternal ? maybeGetInternalIODescriptor(converter, stmt, stmtCtx)
                  : llvm::None;
   const bool isInternalWithDesc = descRef.hasValue();
   const bool isAsync = isDataTransferAsynchronous(loc, stmt);
   const bool isNml = isDataTransferNamelist(stmt);
 
+  // Generate an EnableHandlers call and remaining specifier calls.
+  ConditionSpecInfo csi;
+  if constexpr (hasIOCtrl) {
+    csi = lowerErrorSpec(converter, loc, stmt.controls);
+  }
+
   // Generate the begin data transfer function call.
-  mlir::func::FuncOp ioFunc = getBeginDataTransferFunc<isInput>(
-      loc, builder, isFormatted, isList || isNml, isInternal,
+  auto ioFunc = getBeginDataTransferFunc<isInput>(loc, builder, isFormatted,
+                                                  isList || isNml, isInternal,
                                                   isInternalWithDesc, isAsync);
   llvm::SmallVector<mlir::Value> ioArgs;
   genBeginDataTransferCallArgs<hasIOCtrl>(
       ioArgs, converter, loc, stmt, ioFunc.getFunctionType(), isFormatted,
-      isList || isNml, isInternal, isAsync, descRef, stmtCtx);
+      isList || isNml, isInternal, isAsync, descRef, csi, stmtCtx);
   mlir::Value cookie =
       builder.create<fir::CallOp>(loc, ioFunc, ioArgs).getResult(0);
 
-  // Generate an EnableHandlers call and remaining specifier calls.
-  ConditionSpecInfo csi;
   auto insertPt = builder.saveInsertionPoint();
   mlir::Value ok;
   if constexpr (hasIOCtrl) {
     genConditionHandlerCall(converter, loc, cookie, stmt.controls, csi);
     threadSpecs(converter, loc, cookie, stmt.controls,
                 csi.hasErrorConditionSpec(), ok);
   }
 
   // Generate data transfer list calls.
   if constexpr (isInput) { // READ
     if (isNml)
       genNamelistIO(converter, cookie,
                     getIORuntimeFunc<mkIOKey(InputNamelist)>(loc, builder),
                     *getIOControl<Fortran::parser::Name>(stmt)->symbol,
                     csi.hasTransferConditionSpec(), ok, stmtCtx);
     else
       genInputItemList(converter, cookie, stmt.items, isFormatted,
-                       csi.hasTransferConditionSpec(), ok, /*inLoop=*/false,
-                       stmtCtx);
+                       csi.hasTransferConditionSpec(), ok, /*inLoop=*/false);
   } else if constexpr (std::is_same_v<A, Fortran::parser::WriteStmt>) {
     if (isNml)
       genNamelistIO(converter, cookie,
                     getIORuntimeFunc<mkIOKey(OutputNamelist)>(loc, builder),
                     *getIOControl<Fortran::parser::Name>(stmt)->symbol,
                     csi.hasTransferConditionSpec(), ok, stmtCtx);
     else
       genOutputItemList(converter, cookie, stmt.items, isFormatted,
                         csi.hasTransferConditionSpec(), ok,
-                        /*inLoop=*/false, stmtCtx);
+                        /*inLoop=*/false);
   } else { // PRINT
     genOutputItemList(converter, cookie, std::get<1>(stmt.t), isFormatted,
                       csi.hasTransferConditionSpec(), ok,
-                      /*inLoop=*/false, stmtCtx);
+                      /*inLoop=*/false);
   }
   stmtCtx.finalize();
 
   builder.restoreInsertionPoint(insertPt);
   if constexpr (hasIOCtrl) {
     genIOReadSize(converter, loc, cookie, stmt.controls,
                   csi.hasErrorConditionSpec());
   }
mlir::Value genInquireSpec<Fortran::parser::InquireSpec::CharVar>(
     mlir::Value cookie, mlir::Value idExpr,
     const Fortran::parser::InquireSpec::CharVar &var,
     Fortran::lower::StatementContext &stmtCtx) {
   // IOMSG is handled with exception conditions
   if (std::get<Fortran::parser::InquireSpec::CharVar::Kind>(var.t) ==
       Fortran::parser::InquireSpec::CharVar::Kind::Iomsg)
     return {};
   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
-  mlir::func::FuncOp specFunc =
-      getIORuntimeFunc<mkIOKey(InquireCharacter)>(loc, builder);
+  auto specFunc = getIORuntimeFunc<mkIOKey(InquireCharacter)>(loc, builder);
   mlir::FunctionType specFuncTy = specFunc.getFunctionType();
   const auto *varExpr = Fortran::semantics::GetExpr(
       std::get<Fortran::parser::ScalarDefaultCharVariable>(var.t));
-  fir::ExtendedValue str = converter.genExprAddr(varExpr, stmtCtx, loc);
+  fir::ExtendedValue str = converter.genExprAddr(loc, varExpr, stmtCtx);
   llvm::SmallVector<mlir::Value> args = {
       builder.createConvert(loc, specFuncTy.getInput(0), cookie),
       builder.createIntegerConstant(
           loc, specFuncTy.getInput(1),
           Fortran::runtime::io::HashInquiryKeyword(
               Fortran::parser::InquireSpec::CharVar::EnumToString(
                   std::get<Fortran::parser::InquireSpec::CharVar::Kind>(var.t))
                   .c_str())),
       builder.createConvert(loc, specFuncTy.getInput(2), fir::getBase(str)),
       builder.createConvert(loc, specFuncTy.getInput(3), fir::getLen(str))};
   return builder.create<fir::CallOp>(loc, specFunc, args).getResult(0);
 }
 /// Specialization for INTEGER.
 template <>
 mlir::Value genInquireSpec<Fortran::parser::InquireSpec::IntVar>(
     Fortran::lower::AbstractConverter &converter, mlir::Location loc,
     mlir::Value cookie, mlir::Value idExpr,
     const Fortran::parser::InquireSpec::IntVar &var,
     Fortran::lower::StatementContext &stmtCtx) {
   // IOSTAT is handled with exception conditions
   if (std::get<Fortran::parser::InquireSpec::IntVar::Kind>(var.t) ==
       Fortran::parser::InquireSpec::IntVar::Kind::Iostat)
     return {};
   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
-  mlir::func::FuncOp specFunc =
-      getIORuntimeFunc<mkIOKey(InquireInteger64)>(loc, builder);
+  auto specFunc = getIORuntimeFunc<mkIOKey(InquireInteger64)>(loc, builder);
   mlir::FunctionType specFuncTy = specFunc.getFunctionType();
   const auto *varExpr = Fortran::semantics::GetExpr(
       std::get<Fortran::parser::ScalarIntVariable>(var.t));
-  mlir::Value addr = fir::getBase(converter.genExprAddr(varExpr, stmtCtx, loc));
+  mlir::Value addr = fir::getBase(converter.genExprAddr(loc, varExpr, stmtCtx));
   mlir::Type eleTy = fir::dyn_cast_ptrEleTy(addr.getType());
   if (!eleTy)
     fir::emitFatalError(loc,
                         "internal error: expected a memory reference type");
   auto width = eleTy.cast<mlir::IntegerType>().getWidth();
   mlir::IndexType idxTy = builder.getIndexType();
   mlir::Value kind = builder.createIntegerConstant(loc, idxTy, width / 8);
   llvm::SmallVector<mlir::Value> args = {
mlir::Value genInquireSpec<Fortran::parser::InquireSpec::LogVar>(
     mlir::Value cookie, mlir::Value idExpr,
     const Fortran::parser::InquireSpec::LogVar &var,
     Fortran::lower::StatementContext &stmtCtx) {
   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
   auto logVarKind = std::get<Fortran::parser::InquireSpec::LogVar::Kind>(var.t);
   bool pendId =
       idExpr &&
       logVarKind == Fortran::parser::InquireSpec::LogVar::Kind::Pending;
-  mlir::func::FuncOp specFunc =
+  auto specFunc =
       pendId ? getIORuntimeFunc<mkIOKey(InquirePendingId)>(loc, builder)
              : getIORuntimeFunc<mkIOKey(InquireLogical)>(loc, builder);
   mlir::FunctionType specFuncTy = specFunc.getFunctionType();
   mlir::Value addr = fir::getBase(converter.genExprAddr(
+      loc,
       Fortran::semantics::GetExpr(
           std::get<Fortran::parser::Scalar<
               Fortran::parser::Logical<Fortran::parser::Variable>>>(var.t)),
-      stmtCtx, loc));
+      stmtCtx));
   llvm::SmallVector<mlir::Value> args = {
       builder.createConvert(loc, specFuncTy.getInput(0), cookie)};
   if (pendId)
     args.push_back(builder.createConvert(loc, specFuncTy.getInput(1), idExpr));
   else
     args.push_back(builder.createIntegerConstant(
         loc, specFuncTy.getInput(1),
         Fortran::runtime::io::HashInquiryKeyword(

 lowerIdExpr(Fortran::lower::AbstractConverter &converter, mlir::Location loc,
             const std::list<Fortran::parser::InquireSpec> &ispecs,
             Fortran::lower::StatementContext &stmtCtx) {
   for (const Fortran::parser::InquireSpec &spec : ispecs)
     if (mlir::Value v = std::visit(
             Fortran::common::visitors{
                 [&](const Fortran::parser::IdExpr &idExpr) {
                   return fir::getBase(converter.genExprValue(
-                      Fortran::semantics::GetExpr(idExpr), stmtCtx, loc));
+                      loc, Fortran::semantics::GetExpr(idExpr), stmtCtx));
                 },
                 [](const auto &) { return mlir::Value{}; }},
             spec.u))
       return v;
   return {};
 }
 
 /// For each inquire-spec, build the appropriate call, threading the cookie.

 
 mlir::Value Fortran::lower::genInquireStatement(
     Fortran::lower::AbstractConverter &converter,
     const Fortran::parser::InquireStmt &stmt) {
   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
   Fortran::lower::StatementContext stmtCtx;
   mlir::Location loc = converter.getCurrentLocation();
   mlir::func::FuncOp beginFunc;
-  ConditionSpecInfo csi;
   llvm::SmallVector<mlir::Value> beginArgs;
   const auto *list =
       std::get_if<std::list<Fortran::parser::InquireSpec>>(&stmt.u);
   auto exprPair = getInquireFileExpr(list);
   auto inquireFileUnit = [&]() -> bool {
     return exprPair.first && !exprPair.second;
   };
   auto inquireFileName = [&]() -> bool {
     return exprPair.first && exprPair.second;
   };
 
+  ConditionSpecInfo csi =
+      list ? lowerErrorSpec(converter, loc, *list) : ConditionSpecInfo{};
+
   // Make one of three BeginInquire calls.
   if (inquireFileUnit()) {
     // Inquire by unit -- [UNIT=]file-unit-number.
     beginFunc = getIORuntimeFunc<mkIOKey(BeginInquireUnit)>(loc, builder);
     mlir::FunctionType beginFuncTy = beginFunc.getFunctionType();
-    beginArgs = {builder.createConvert(loc, beginFuncTy.getInput(0),
-                                       fir::getBase(converter.genExprValue(
-                                           exprPair.first, stmtCtx, loc))),
-                 locToFilename(converter, loc, beginFuncTy.getInput(1)),
+    mlir::Value unit = genIOUnitNumber(converter, loc, exprPair.first,
+                                       beginFuncTy.getInput(0), csi, stmtCtx);
+    beginArgs = {unit, locToFilename(converter, loc, beginFuncTy.getInput(1)),
                  locToLineNo(converter, loc, beginFuncTy.getInput(2))};
   } else if (inquireFileName()) {
     // Inquire by file -- FILE=file-name-expr.
     beginFunc = getIORuntimeFunc<mkIOKey(BeginInquireFile)>(loc, builder);
     mlir::FunctionType beginFuncTy = beginFunc.getFunctionType();
     fir::ExtendedValue file =
-        converter.genExprAddr(exprPair.first, stmtCtx, loc);
+        converter.genExprAddr(loc, exprPair.first, stmtCtx);
     beginArgs = {
         builder.createConvert(loc, beginFuncTy.getInput(0), fir::getBase(file)),
         builder.createConvert(loc, beginFuncTy.getInput(1), fir::getLen(file)),
         locToFilename(converter, loc, beginFuncTy.getInput(2)),
         locToLineNo(converter, loc, beginFuncTy.getInput(3))};
   } else {
     // Inquire by output list -- IOLENGTH=scalar-int-variable.
     const auto *ioLength =
         std::get_if<Fortran::parser::InquireStmt::Iolength>(&stmt.u);
     assert(ioLength && "must have an IOLENGTH specifier");
     beginFunc = getIORuntimeFunc<mkIOKey(BeginInquireIoLength)>(loc, builder);
     mlir::FunctionType beginFuncTy = beginFunc.getFunctionType();
     beginArgs = {locToFilename(converter, loc, beginFuncTy.getInput(0)),
                  locToLineNo(converter, loc, beginFuncTy.getInput(1))};
     auto cookie =
         builder.create<fir::CallOp>(loc, beginFunc, beginArgs).getResult(0);
     mlir::Value ok;
     genOutputItemList(
         converter, cookie,
         std::get<std::list<Fortran::parser::OutputItem>>(ioLength->t),
-        /*isFormatted=*/false, /*checkResult=*/false, ok, /*inLoop=*/false,
-        stmtCtx);
+        /*isFormatted=*/false, /*checkResult=*/false, ok, /*inLoop=*/false);
     auto *ioLengthVar = Fortran::semantics::GetExpr(
         std::get<Fortran::parser::ScalarIntVariable>(ioLength->t));
     mlir::Value ioLengthVarAddr =
-        fir::getBase(converter.genExprAddr(ioLengthVar, stmtCtx, loc));
+        fir::getBase(converter.genExprAddr(loc, ioLengthVar, stmtCtx));
     llvm::SmallVector<mlir::Value> args = {cookie};
     mlir::Value length =
         builder
             .create<fir::CallOp>(
                 loc, getIORuntimeFunc<mkIOKey(GetIoLength)>(loc, builder), args)
             .getResult(0);
     mlir::Value length1 =
         builder.createConvert(loc, converter.genType(*ioLengthVar), length);

flang/lib/Optimizer/Builder/BoxValue.cpp

if (!extents.empty() && extents.size() != rank())
     return false;
   if (isCharacter() && explicitParams.size() > 1)
     return false;
   return true;
 }
 
 /// Get exactly one extent for any array-like extended value, \p exv. If \p exv
 /// is not an array or has rank less then \p dim, the result will be a nullptr.
-mlir::Value fir::getExtentAtDimension(const fir::ExtendedValue &exv,
+mlir::Value fir::factory::getExtentAtDimension(mlir::Location loc,
                                                fir::FirOpBuilder &builder,
-                                      mlir::Location loc, unsigned dim) {
-  auto extents = fir::factory::getExtents(builder, loc, exv);
+                                               const fir::ExtendedValue &exv,
+                                               unsigned dim) {
+  auto extents = fir::factory::getExtents(loc, builder, exv);
   if (dim < extents.size())
     return extents[dim];
   return {};
 }
 
 static inline bool isUndefOp(mlir::Value v) {
   return mlir::isa_and_nonnull<fir::UndefOp>(v.getDefiningOp());
 }

flang/lib/Optimizer/Builder/FIRBuilder.cpp

for (decltype(rank) dim = 0; dim < rank; ++dim) {
     auto dimInfo = builder.create<fir::BoxDimsOp>(loc, idxTy, idxTy, idxTy,
                                                   box.getAddr(), dimVal);
     result.emplace_back(dimInfo.getResult(1));
   }
   return result;
 }
 
 llvm::SmallVector<mlir::Value>
-fir::factory::getExtents(fir::FirOpBuilder &builder, mlir::Location loc,
+fir::factory::getExtents(mlir::Location loc, fir::FirOpBuilder &builder,
                          const fir::ExtendedValue &box) {
   return box.match(
       [&](const fir::ArrayBoxValue &x) -> llvm::SmallVector<mlir::Value> {
         return {x.getExtents().begin(), x.getExtents().end()};
       },
       [&](const fir::CharArrayBoxValue &x) -> llvm::SmallVector<mlir::Value> {
         return {x.getExtents().begin(), x.getExtents().end()};
       },
       [&](const fir::BoxValue &x) -> llvm::SmallVector<mlir::Value> {
         return fir::factory::readExtents(builder, loc, x);
       },
       [&](const fir::MutableBoxValue &x) -> llvm::SmallVector<mlir::Value> {
         auto load = fir::factory::genMutableBoxRead(builder, loc, x);
-        return fir::factory::getExtents(builder, loc, load);
+        return fir::factory::getExtents(loc, builder, load);
       },
       [&](const auto &) -> llvm::SmallVector<mlir::Value> { return {}; });
 }
 
 fir::ExtendedValue fir::factory::readBoxValue(fir::FirOpBuilder &builder,
                                               mlir::Location loc,
                                               const fir::BoxValue &box) {
   assert(!box.isUnlimitedPolymorphic() && !box.hasAssumedRank() &&
          "cannot read unlimited polymorphic or assumed rank fir.box");
   auto addr =
       builder.create<fir::BoxAddrOp>(loc, box.getMemTy(), box.getAddr());
   if (box.isCharacter()) {
     auto len = fir::factory::readCharLen(builder, loc, box);
     if (box.rank() == 0)
       return fir::CharBoxValue(addr, len);
     return fir::CharArrayBoxValue(addr, len,
                                   fir::factory::readExtents(builder, loc, box),
                                   box.getLBounds());
   }
-  if (box.isDerivedWithLengthParameters())
+  if (box.isDerivedWithLenParameters())
     TODO(loc, "read fir.box with length parameters");
   if (box.rank() == 0)
     return addr;
   return fir::ArrayBoxValue(addr, fir::factory::readExtents(builder, loc, box),
                             box.getLBounds());
 }
 
 llvm::SmallVector<mlir::Value>
return exv.match(
       },
       [&](const fir::BoxValue &box) -> llvm::SmallVector<mlir::Value> {
         return {box.getExplicitParameters().begin(),
                 box.getExplicitParameters().end()};
       },
       [&](const auto &) -> llvm::SmallVector<mlir::Value> { return {}; });
 }
 
+// If valTy is a box type, then we need to extract the type parameters from
+// the box value.
+static llvm::SmallVector<mlir::Value> getFromBox(mlir::Location loc,
+                                                 fir::FirOpBuilder &builder,
+                                                 mlir::Type valTy,
+                                                 mlir::Value boxVal) {
+  if (auto boxTy = valTy.dyn_cast<fir::BoxType>()) {
+    auto eleTy = fir::unwrapAllRefAndSeqType(boxTy.getEleTy());
+    if (auto recTy = eleTy.dyn_cast<fir::RecordType>()) {
+      if (recTy.getNumLenParams() > 0) {
+        // Walk each type parameter in the record and get the value.
+        TODO(loc, "generate code to get LEN type parameters");
+      }
+    } else if (auto charTy = eleTy.dyn_cast<fir::CharacterType>()) {
+      if (charTy.hasDynamicLen()) {
+        auto idxTy = builder.getIndexType();
+        auto eleSz = builder.create<fir::BoxEleSizeOp>(loc, idxTy, boxVal);
+        auto kindBytes =
+            builder.getKindMap().getCharacterBitsize(charTy.getFKind()) / 8;
+        mlir::Value charSz =
+            builder.createIntegerConstant(loc, idxTy, kindBytes);
+        mlir::Value len =
+            builder.create<mlir::arith::DivSIOp>(loc, eleSz, charSz);
+        return {len};
+      }
+    }
+  }
+  return {};
+}
+
+// fir::getTypeParams() will get the type parameters from the extended value.
+// When the extended value is a BoxValue or MutableBoxValue, it may be necessary
+// to generate code, so this factory function handles those cases.
+// TODO: fix the inverted type tests, etc.
+llvm::SmallVector<mlir::Value>
+fir::factory::getTypeParams(mlir::Location loc, fir::FirOpBuilder &builder,
+                            const fir::ExtendedValue &exv) {
+  auto handleBoxed = [&](const auto &box) -> llvm::SmallVector<mlir::Value> {
+    if (box.isCharacter())
+      return {fir::factory::readCharLen(builder, loc, exv)};
+    if (box.isDerivedWithLenParameters()) {
+      // This should generate code to read the type parameters from the box.
+      // This requires some consideration however as MutableBoxValues need to be
+      // in a sane state to be provide the correct values.
+      TODO(loc, "derived type with type parameters");
+    }
+    return {};
+  };
+  // Intentionally reuse the original code path to get type parameters for the
+  // cases that were supported rather than introduce a new path.
+  return exv.match(
+      [&](const fir::BoxValue &box) { return handleBoxed(box); },
+      [&](const fir::MutableBoxValue &box) { return handleBoxed(box); },
+      [&](const auto &) { return fir::getTypeParams(exv); });
+}
+
+llvm::SmallVector<mlir::Value>
+fir::factory::getTypeParams(mlir::Location loc, fir::FirOpBuilder &builder,
+                            fir::ArrayLoadOp load) {
+  mlir::Type memTy = load.getMemref().getType();
+  if (auto boxTy = memTy.dyn_cast<fir::BoxType>())
+    return getFromBox(loc, builder, boxTy, load.getMemref());
+  return load.getTypeparams();
+}
+
 std::string fir::factory::uniqueCGIdent(llvm::StringRef prefix,
                                         llvm::StringRef name) {
   // For "long" identifiers use a hash value
   if (name.size() > nameLengthHashSize) {
     llvm::MD5 hash;
     hash.update(name);
     llvm::MD5::MD5Result result;
     hash.final(result);
return array.match(
       [&](const fir::CharArrayBoxValue &bv) -> fir::ExtendedValue {
         return bv.cloneElement(element);
       },
       [&](const fir::BoxValue &box) -> fir::ExtendedValue {
         if (box.isCharacter()) {
           auto len = fir::factory::readCharLen(builder, loc, box);
           return fir::CharBoxValue{element, len};
         }
-        if (box.isDerivedWithLengthParameters())
+        if (box.isDerivedWithLenParameters())
           TODO(loc, "get length parameters from derived type BoxValue");
         return element;
       },
       [&](const auto &) -> fir::ExtendedValue { return element; });
 }
 
 fir::ExtendedValue fir::factory::arraySectionElementToExtendedValue(
     fir::FirOpBuilder &builder, mlir::Location loc,

flang/lib/Optimizer/Builder/MutableBox.cpp

if (auto charTy = box.getEleTy().dyn_cast<fir::CharacterType>()) {
     auto bt = box.getBaseTy();
     auto addrTy = addr.getType();
     auto type = addrTy.isa<fir::HeapType>()      ? fir::HeapType::get(bt)
                 : addrTy.isa<fir::PointerType>() ? fir::PointerType::get(bt)
                                                  : builder.getRefType(bt);
     cleanedAddr = builder.createConvert(loc, type, addr);
     if (charTy.getLen() == fir::CharacterType::unknownLen())
       cleanedLengths.append(lengths.begin(), lengths.end());
-  } else if (box.isDerivedWithLengthParameters()) {
+  } else if (box.isDerivedWithLenParameters()) {
     TODO(loc, "updating mutablebox of derived type with length parameters");
     cleanedLengths = lengths;
   }
   mlir::Value emptySlice;
   return builder.create<fir::EmboxOp>(loc, box.getBoxTy(), cleanedAddr, shape,
                                       emptySlice, cleanedLengths);
 }
 
public:
 
   /// Read all mutable properties. Return the base address.
   mlir::Value read(llvm::SmallVectorImpl<mlir::Value> &lbounds,
                    llvm::SmallVectorImpl<mlir::Value> &extents,
                    llvm::SmallVectorImpl<mlir::Value> &lengths) {
     extents = readShape(&lbounds);
     if (box.isCharacter())
       lengths.emplace_back(readCharacterLength());
-    else if (box.isDerivedWithLengthParameters())
+    else if (box.isDerivedWithLenParameters())
       TODO(loc, "read allocatable or pointer derived type LEN parameters");
     return readBaseAddress();
   }
 
   /// Return the loaded fir.box.
   mlir::Value getIrBox() const {
     assert(irBox);
     return irBox;
void updateMutableProperties(mlir::Value addr, mlir::ValueRange lbounds,
     }
     if (box.isCharacter())
       // llvm::zip account for the fact that the length only needs to be stored
       // when it is specified in the allocation and deferred in the
       // MutableBoxValue.
       for (auto [len, lenVar] :
            llvm::zip(lengths, mutableProperties.deferredParams))
         castAndStore(len, lenVar);
-    else if (box.isDerivedWithLengthParameters())
+    else if (box.isDerivedWithLenParameters())
       TODO(loc, "update allocatable derived type length parameters");
   }
   fir::FirOpBuilder &builder;
   mlir::Location loc;
   fir::MutableBoxValue box;
 };
 
 } // namespace
source.match(
         mlir::ValueRange newLbounds = lbounds.empty()
                                           ? mlir::ValueRange{arr.getLBounds()}
                                           : mlir::ValueRange{lbounds};
         if (box.isDescribedByVariables()) {
           // LHS is a contiguous pointer described by local variables. Open RHS
           // fir.box to update the LHS.
           auto rawAddr = builder.create<fir::BoxAddrOp>(loc, arr.getMemTy(),
                                                         arr.getAddr());
-          auto extents = fir::factory::getExtents(builder, loc, source);
+          auto extents = fir::factory::getExtents(loc, builder, source);
           llvm::SmallVector<mlir::Value> lenParams;
           if (arr.isCharacter()) {
             lenParams.emplace_back(
                 fir::factory::readCharLen(builder, loc, source));
-          } else if (arr.isDerivedWithLengthParameters()) {
+          } else if (arr.isDerivedWithLenParameters()) {
             TODO(loc, "pointer assignment to derived with length parameters");
           }
           writer.updateMutableBox(rawAddr, newLbounds, extents, lenParams);
         } else {
           mlir::Value shift;
           if (!newLbounds.empty()) {
             auto shiftType =
                 fir::ShiftType::get(builder.getContext(), newLbounds.size());
source.match(
           // LHS is a contiguous pointer described by local variables. Open RHS
           // fir.box to update the LHS.
           auto rawAddr = builder.create<fir::BoxAddrOp>(loc, arr.getMemTy(),
                                                         arr.getAddr());
           llvm::SmallVector<mlir::Value> lenParams;
           if (arr.isCharacter()) {
             lenParams.emplace_back(
                 fir::factory::readCharLen(builder, loc, source));
-          } else if (arr.isDerivedWithLengthParameters()) {
+          } else if (arr.isDerivedWithLenParameters()) {
             TODO(loc, "pointer assignment to derived with length parameters");
           }
           writer.updateMutableBox(rawAddr, lbounds, extents, lenParams);
         } else {
           auto shapeType =
               fir::ShapeShiftType::get(builder.getContext(), extents.size());
           llvm::SmallVector<mlir::Value> shapeArgs;
           auto idxTy = builder.getIndexType();
auto ifOp =
 
             if (box.isCharacter() && !box.hasNonDeferredLenParams()) {
               // When the allocatable length is not deferred, it must not be
               // reallocated in case of length mismatch, instead,
               // padding/trimming will occur in later assignment to it.
               assert(!lengthParams.empty() &&
                      "must provide length parameters for character");
               compareProperty(reader.readCharacterLength(), lengthParams[0]);
-            } else if (box.isDerivedWithLengthParameters()) {
+            } else if (box.isDerivedWithLenParameters()) {
               TODO(loc, "automatic allocation of derived type allocatable with "
                         "length parameters");
             }
             auto ifOp =
                 builder
                     .genIfOp(loc, {addrType}, mustReallocate,
                              /*withElseRegion=*/true)
                     .genThen([&]() {
auto newValue = [&]() -> fir::ExtendedValue {
     }
     if (box.isCharacter()) {
       auto len = box.hasNonDeferredLenParams() ? reader.readCharacterLength()
                                                : lengthParams[0];
       if (box.hasRank())
         return fir::CharArrayBoxValue{newAddr, len, extents};
       return fir::CharBoxValue{newAddr, len};
     }
-    if (box.isDerivedWithLengthParameters())
+    if (box.isDerivedWithLenParameters())
       TODO(loc, "reallocation of derived type entities with length parameters");
     if (box.hasRank())
       return fir::ArrayBoxValue{newAddr, extents};
     return newAddr;
   }();
   return {newValue, addr, wasReallocated, isAllocated};
 }
 
builder.genIfThen(loc, realloc.wasReallocated)
         llvm::SmallVector<mlir::Value> previousLbounds;
         if (!takeLboundsIfRealloc && box.hasRank())
           reader.readShape(&previousLbounds);
         auto lbs =
             takeLboundsIfRealloc ? lbounds : mlir::ValueRange{previousLbounds};
         llvm::SmallVector<mlir::Value> lenParams;
         if (box.isCharacter())
           lenParams.push_back(fir::getLen(realloc.newValue));
-        if (box.isDerivedWithLengthParameters())
+        if (box.isDerivedWithLenParameters())
           TODO(loc,
                "reallocation of derived type entities with length parameters");
         auto lengths = getNewLengths(builder, loc, box, lenParams);
         auto heap = fir::getBase(realloc.newValue);
-        auto extents = fir::factory::getExtents(builder, loc, realloc.newValue);
+        auto extents = fir::factory::getExtents(loc, builder, realloc.newValue);
         builder.genIfThen(loc, realloc.oldAddressWasAllocated)
             .genThen(
                 [&]() { genFinalizeAndFree(builder, loc, realloc.oldAddress); })
             .end();
         MutablePropertyWriter{builder, loc, box}.updateMutableBox(
             heap, lbs, extents, lengths);
       })
       .end();

flang/lib/Optimizer/Dialect/FIRType.cpp

 bool isAllocatableType(mlir::Type ty) {
   if (auto refTy = fir::dyn_cast_ptrEleTy(ty))
     ty = refTy;
   if (auto boxTy = ty.dyn_cast<fir::BoxType>())
     return boxTy.getEleTy().isa<fir::HeapType>();
   return false;
 }
 
+bool isUnlimitedPolymorphicType(mlir::Type ty) {
+  if (auto refTy = fir::dyn_cast_ptrEleTy(ty))
+    ty = refTy;
+  if (auto boxTy = ty.dyn_cast<fir::BoxType>())
+    return boxTy.getEleTy().isa<mlir::NoneType>();
+  return false;
+}
+
 bool isRecordWithAllocatableMember(mlir::Type ty) {
   if (auto recTy = ty.dyn_cast<fir::RecordType>())
     for (auto [field, memTy] : recTy.getTypeList()) {
       if (fir::isAllocatableType(memTy))
         return true;
       // A record type cannot recursively include itself as a direct member.
       // There must be an intervening `ptr` type, so recursion is safe here.
       if (memTy.isa<fir::RecordType>() && isRecordWithAllocatableMember(memTy))
         return true;
     }
   return false;
 }
 
+mlir::Type unwrapAllRefAndSeqType(mlir::Type ty) {
+  while (true) {
+    mlir::Type nt = unwrapSequenceType(unwrapRefType(ty));
+    if (auto vecTy = nt.dyn_cast<fir::VectorType>())
+      nt = vecTy.getEleTy();
+    if (nt == ty)
+      return ty;
+    ty = nt;
+  }
+}
+
+mlir::Type unwrapSeqOrBoxedSeqType(mlir::Type ty) {
+  if (auto seqTy = ty.dyn_cast<fir::SequenceType>())
+    return seqTy.getEleTy();
+  if (auto boxTy = ty.dyn_cast<fir::BoxType>()) {
+    auto eleTy = unwrapRefType(boxTy.getEleTy());
+    if (auto seqTy = eleTy.dyn_cast<fir::SequenceType>())
+      return seqTy.getEleTy();
+  }
+  return ty;
+}
+
 } // namespace fir
 
 namespace {
 
 static llvm::SmallPtrSet<detail::RecordTypeStorage const *, 4>
     recordTypeVisited;
 
 } // namespace

flang/test/Lower/forall/array-pointer.f90

+! Test lowering of arrays of POINTER.
+!
+! An array of pointer to T can be constructed by having an array of
+! derived type, where the derived type has a pointer to T
+! component. An entity with both the DIMENSION and POINTER attributes
+! is a pointer to an array of T and never an array of pointer to T in
+! Fortran.
+
+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+module array_of_pointer_test
+  type t
+     integer, POINTER :: ip
+  end type t
+
+  type u
+     integer :: v
+  end type u
+
+  type tu
+     type(u), POINTER :: ip
+  end type tu
+
+  type ta
+     integer, POINTER :: ip(:)
+  end type ta
+
+  type tb
+     integer, POINTER :: ip(:,:)
+  end type tb
+
+  type tv
+     type(tu), POINTER :: jp(:)
+  end type tv
+
+  ! Derived types with type parameters hit a TODO.
+!  type ct(l)
+!     integer, len :: l
+!     character(LEN=l), POINTER :: cp
+!  end type ct
+
+!  type cu(l)
+!     integer, len :: l
+!     character(LEN=l) :: cv
+!  end type cu
+end module array_of_pointer_test
+
+subroutine s1(x,y)
+  use array_of_pointer_test
+  type(t) :: x(:)
+  integer :: y(:)
+
+  forall (i=1:10)
+     ! assign value to pointee variable
+     x(i)%ip = y(i)
+  end forall
+end subroutine s1
+
+! CHECK-LABEL: func @_QPs1(
+! CHECK-SAME:              %[[VAL_0:.*]]: !fir.box<!fir.array<?x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>> {fir.bindc_name = "x"},
+! CHECK-SAME:              %[[VAL_1:.*]]: !fir.box<!fir.array<?xi32>> {fir.bindc_name = "y"}) {
+! CHECK:         %[[VAL_2:.*]] = fir.alloca i32 {adapt.valuebyref, bindc_name = "i"}
+! CHECK:         %[[VAL_3:.*]] = arith.constant 1 : i32
+! CHECK:         %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (i32) -> index
+! CHECK:         %[[VAL_5:.*]] = arith.constant 10 : i32
+! CHECK:         %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (i32) -> index
+! CHECK:         %[[VAL_7:.*]] = arith.constant 1 : index
+! CHECK:         %[[VAL_8:.*]] = fir.array_load %[[VAL_0]] : (!fir.box<!fir.array<?x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>>) -> !fir.array<?x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>
+! CHECK:         %[[VAL_9:.*]] = fir.array_load %[[VAL_1]] : (!fir.box<!fir.array<?xi32>>) -> !fir.array<?xi32>
+! CHECK:         %[[VAL_10:.*]] = fir.do_loop %[[VAL_11:.*]] = %[[VAL_4]] to %[[VAL_6]] step %[[VAL_7]] unordered iter_args(%[[VAL_12:.*]] = %[[VAL_8]]) -> (!fir.array<?x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>) {
+! CHECK:           %[[VAL_13:.*]] = fir.convert %[[VAL_11]] : (index) -> i32
+! CHECK:           fir.store %[[VAL_13]] to %[[VAL_2]] : !fir.ref<i32>
+! CHECK:           %[[VAL_14:.*]] = arith.constant 1 : index
+! CHECK:           %[[VAL_15:.*]] = fir.load %[[VAL_2]] : !fir.ref<i32>
+! CHECK:           %[[VAL_16:.*]] = fir.convert %[[VAL_15]] : (i32) -> i64
+! CHECK:           %[[VAL_17:.*]] = fir.convert %[[VAL_16]] : (i64) -> index
+! CHECK:           %[[VAL_18:.*]] = arith.subi %[[VAL_17]], %[[VAL_14]] : index
+! CHECK:           %[[VAL_19:.*]] = fir.array_fetch %[[VAL_9]], %[[VAL_18]] : (!fir.array<?xi32>, index) -> i32
+! CHECK:           %[[VAL_20:.*]] = arith.constant 1 : index
+! CHECK:           %[[VAL_21:.*]] = fir.load %[[VAL_2]] : !fir.ref<i32>
+! CHECK:           %[[VAL_22:.*]] = fir.convert %[[VAL_21]] : (i32) -> i64
+! CHECK:           %[[VAL_23:.*]] = fir.convert %[[VAL_22]] : (i64) -> index
+! CHECK:           %[[VAL_24:.*]] = arith.subi %[[VAL_23]], %[[VAL_20]] : index
+! CHECK:           %[[VAL_25:.*]] = fir.field_index ip, !fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>
+! CHECK:           %[[VAL_26:.*]] = fir.array_access %[[VAL_12]], %[[VAL_24]], %[[VAL_25]] : (!fir.array<?x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>, index, !fir.field) -> !fir.ref<!fir.box<!fir.ptr<i32>>>
+! CHECK:           %[[VAL_27:.*]] = fir.load %[[VAL_26]] : !fir.ref<!fir.box<!fir.ptr<i32>>>
+! CHECK:           %[[VAL_28:.*]] = fir.box_addr %[[VAL_27]] : (!fir.box<!fir.ptr<i32>>) -> !fir.ptr<i32>
+! CHECK:           fir.store %[[VAL_19]] to %[[VAL_28]] : !fir.ptr<i32>
+! CHECK:           %[[VAL_29:.*]] = fir.array_amend %[[VAL_12]], %[[VAL_26]] : (!fir.array<?x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>, !fir.ref<!fir.box<!fir.ptr<i32>>>) -> !fir.array<?x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>
+! CHECK:           fir.result %[[VAL_29]] : !fir.array<?x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>
+! CHECK:         }
+! CHECK:         fir.array_merge_store %[[VAL_8]], %[[VAL_30:.*]] to %[[VAL_0]] : !fir.array<?x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>, !fir.array<?x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>, !fir.box<!fir.array<?x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>>
+! CHECK:         return
+! CHECK:       }
+
+subroutine s1_1(x,y)
+  use array_of_pointer_test
+  type(t) :: x(10)
+  integer :: y(10)
+
+  forall (i=1:10)
+     ! assign value to pointee variable
+     x(i)%ip = y(i)
+  end forall
+end subroutine s1_1
+
+! CHECK-LABEL: func @_QPs1_1(
+! CHECK-SAME:                %[[VAL_0:.*]]: !fir.ref<!fir.array<10x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>> {fir.bindc_name = "x"},
+! CHECK-SAME:                %[[VAL_1:.*]]: !fir.ref<!fir.array<10xi32>> {fir.bindc_name = "y"}) {
+! CHECK:         %[[VAL_2:.*]] = fir.alloca i32 {adapt.valuebyref, bindc_name = "i"}
+! CHECK:         %[[VAL_3:.*]] = arith.constant 10 : index
+! CHECK:         %[[VAL_4:.*]] = arith.constant 10 : index
+! CHECK:         %[[VAL_5:.*]] = arith.constant 1 : i32
+! CHECK:         %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (i32) -> index
+! CHECK:         %[[VAL_7:.*]] = arith.constant 10 : i32
+! CHECK:         %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (i32) -> index
+! CHECK:         %[[VAL_9:.*]] = arith.constant 1 : index
+! CHECK:         %[[VAL_10:.*]] = fir.shape %[[VAL_3]] : (index) -> !fir.shape<1>
+! CHECK:         %[[VAL_11:.*]] = fir.array_load %[[VAL_0]](%[[VAL_10]]) : (!fir.ref<!fir.array<10x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>>, !fir.shape<1>) -> !fir.array<10x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>
+! CHECK:         %[[VAL_12:.*]] = fir.shape %[[VAL_4]] : (index) -> !fir.shape<1>
+! CHECK:         %[[VAL_13:.*]] = fir.array_load %[[VAL_1]](%[[VAL_12]]) : (!fir.ref<!fir.array<10xi32>>, !fir.shape<1>) -> !fir.array<10xi32>
+! CHECK:         %[[VAL_14:.*]] = fir.do_loop %[[VAL_15:.*]] = %[[VAL_6]] to %[[VAL_8]] step %[[VAL_9]] unordered iter_args(%[[VAL_16:.*]] = %[[VAL_11]]) -> (!fir.array<10x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>) {
+! CHECK:           %[[VAL_17:.*]] = fir.convert %[[VAL_15]] : (index) -> i32
+! CHECK:           fir.store %[[VAL_17]] to %[[VAL_2]] : !fir.ref<i32>
+! CHECK:           %[[VAL_18:.*]] = arith.constant 1 : index
+! CHECK:           %[[VAL_19:.*]] = fir.load %[[VAL_2]] : !fir.ref<i32>
+! CHECK:           %[[VAL_20:.*]] = fir.convert %[[VAL_19]] : (i32) -> i64
+! CHECK:           %[[VAL_21:.*]] = fir.convert %[[VAL_20]] : (i64) -> index
+! CHECK:           %[[VAL_22:.*]] = arith.subi %[[VAL_21]], %[[VAL_18]] : index
+! CHECK:           %[[VAL_23:.*]] = fir.array_fetch %[[VAL_13]], %[[VAL_22]] : (!fir.array<10xi32>, index) -> i32
+! CHECK:           %[[VAL_24:.*]] = arith.constant 1 : index
+! CHECK:           %[[VAL_25:.*]] = fir.load %[[VAL_2]] : !fir.ref<i32>
+! CHECK:           %[[VAL_26:.*]] = fir.convert %[[VAL_25]] : (i32) -> i64
+! CHECK:           %[[VAL_27:.*]] = fir.convert %[[VAL_26]] : (i64) -> index
+! CHECK:           %[[VAL_28:.*]] = arith.subi %[[VAL_27]], %[[VAL_24]] : index
+! CHECK:           %[[VAL_29:.*]] = fir.field_index ip, !fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>
+! CHECK:           %[[VAL_30:.*]] = fir.array_access %[[VAL_16]], %[[VAL_28]], %[[VAL_29]] : (!fir.array<10x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>, index, !fir.field) -> !fir.ref<!fir.box<!fir.ptr<i32>>>
+! CHECK:           %[[VAL_31:.*]] = fir.load %[[VAL_30]] : !fir.ref<!fir.box<!fir.ptr<i32>>>
+! CHECK:           %[[VAL_32:.*]] = fir.box_addr %[[VAL_31]] : (!fir.box<!fir.ptr<i32>>) -> !fir.ptr<i32>
+! CHECK:           fir.store %[[VAL_23]] to %[[VAL_32]] : !fir.ptr<i32>
+! CHECK:           %[[VAL_33:.*]] = fir.array_amend %[[VAL_16]], %[[VAL_30]] : (!fir.array<10x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>, !fir.ref<!fir.box<!fir.ptr<i32>>>) -> !fir.array<10x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>
+! CHECK:           fir.result %[[VAL_33]] : !fir.array<10x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>
+! CHECK:         }
+! CHECK:         fir.array_merge_store %[[VAL_11]], %[[VAL_34:.*]] to %[[VAL_0]] : !fir.array<10x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>, !fir.array<10x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>, !fir.ref<!fir.array<10x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>>
+! CHECK:         return
+! CHECK:       }
+
+! Dependent type assignment, TODO
+!subroutine s1_2(x,y,l)
+!  use array_of_pointer_test
+!  type(ct(l)) :: x(10)
+!  character(l) :: y(10)
+
+!  forall (i=1:10)
+     ! assign value to pointee variable
+!     x(i)%cp = y(i)
+!  end forall
+!end subroutine s1_2
+
+subroutine s2(x,y)
+  use array_of_pointer_test
+  type(t) :: x(:)
+  integer, TARGET :: y(:)
+
+  forall (i=1:10)
+     ! assign address to POINTER
+     x(i)%ip => y(i)
+  end forall
+end subroutine s2
+
+! CHECK-LABEL: func @_QPs2(
+! CHECK-SAME:              %[[VAL_0:.*]]: !fir.box<!fir.array<?x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>> {fir.bindc_name = "x"},
+! CHECK-SAME:              %[[VAL_1:.*]]: !fir.box<!fir.array<?xi32>> {fir.bindc_name = "y", fir.target}) {
+! CHECK:         %[[VAL_2:.*]] = fir.alloca i32 {adapt.valuebyref, bindc_name = "i"}
+! CHECK:         %[[VAL_3:.*]] = arith.constant 1 : i32
+! CHECK:         %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (i32) -> index
+! CHECK:         %[[VAL_5:.*]] = arith.constant 10 : i32
+! CHECK:         %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (i32) -> index
+! CHECK:         %[[VAL_7:.*]] = arith.constant 1 : index
+! CHECK:         %[[VAL_8:.*]] = fir.array_load %[[VAL_0]] : (!fir.box<!fir.array<?x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>>) -> !fir.array<?x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>
+! CHECK:         %[[VAL_9:.*]] = fir.array_load %[[VAL_1]] : (!fir.box<!fir.array<?xi32>>) -> !fir.array<?xi32>
+! CHECK:         %[[VAL_10:.*]] = fir.do_loop %[[VAL_11:.*]] = %[[VAL_4]] to %[[VAL_6]] step %[[VAL_7]] unordered iter_args(%[[VAL_12:.*]] = %[[VAL_8]]) -> (!fir.array<?x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>) {
+! CHECK:           %[[VAL_13:.*]] = fir.convert %[[VAL_11]] : (index) -> i32
+! CHECK:           fir.store %[[VAL_13]] to %[[VAL_2]] : !fir.ref<i32>
+! CHECK:           %[[VAL_14:.*]] = arith.constant 1 : index
+! CHECK:           %[[VAL_15:.*]] = fir.load %[[VAL_2]] : !fir.ref<i32>
+! CHECK:           %[[VAL_16:.*]] = fir.convert %[[VAL_15]] : (i32) -> i64
+! CHECK:           %[[VAL_17:.*]] = fir.convert %[[VAL_16]] : (i64) -> index
+! CHECK:           %[[VAL_18:.*]] = arith.subi %[[VAL_17]], %[[VAL_14]] : index
+! CHECK:           %[[VAL_19:.*]] = fir.array_access %[[VAL_9]], %[[VAL_18]] : (!fir.array<?xi32>, index) -> !fir.ref<i32>
+! CHECK:           %[[VAL_20:.*]] = fir.convert %[[VAL_19]] : (!fir.ref<i32>) -> !fir.ptr<i32>
+! CHECK:           %[[VAL_21:.*]] = fir.embox %[[VAL_20]] : (!fir.ptr<i32>) -> !fir.box<!fir.ptr<i32>>
+! CHECK:           %[[VAL_22:.*]] = arith.constant 1 : index
+! CHECK:           %[[VAL_23:.*]] = fir.load %[[VAL_2]] : !fir.ref<i32>
+! CHECK:           %[[VAL_24:.*]] = fir.convert %[[VAL_23]] : (i32) -> i64
+! CHECK:           %[[VAL_25:.*]] = fir.convert %[[VAL_24]] : (i64) -> index
+! CHECK:           %[[VAL_26:.*]] = arith.subi %[[VAL_25]], %[[VAL_22]] : index
+! CHECK:           %[[VAL_27:.*]] = fir.field_index ip, !fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>
+! CHECK:           %[[VAL_28:.*]] = fir.array_update %[[VAL_12]], %[[VAL_21]], %[[VAL_26]], %[[VAL_27]] : (!fir.array<?x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>, !fir.box<!fir.ptr<i32>>, index, !fir.field) -> !fir.array<?x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>
+! CHECK:           fir.result %[[VAL_28]] : !fir.array<?x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>
+! CHECK:         }
+! CHECK:         fir.array_merge_store %[[VAL_8]], %[[VAL_29:.*]] to %[[VAL_0]] : !fir.array<?x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>, !fir.array<?x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>, !fir.box<!fir.array<?x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>>
+! CHECK:         return
+! CHECK:       }
+
+subroutine s2_1(x,y)
+  use array_of_pointer_test
+  type(t) :: x(:)
+  integer, POINTER :: y(:)
+
+  forall (i=1:10)
+     ! assign address to POINTER
+     x(i)%ip => y(i)
+  end forall
+end subroutine s2_1
+
+! CHECK-LABEL: func @_QPs2_1(
+! CHECK-SAME:                %[[VAL_0:.*]]: !fir.box<!fir.array<?x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>> {fir.bindc_name = "x"},
+! CHECK-SAME:                %[[VAL_1:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>> {fir.bindc_name = "y"}) {
+! CHECK:         %[[VAL_2:.*]] = fir.alloca i32 {adapt.valuebyref, bindc_name = "i"}
+! CHECK:         %[[VAL_3:.*]] = arith.constant 1 : i32
+! CHECK:         %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (i32) -> index
+! CHECK:         %[[VAL_5:.*]] = arith.constant 10 : i32
+! CHECK:         %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (i32) -> index
+! CHECK:         %[[VAL_7:.*]] = arith.constant 1 : index
+! CHECK:         %[[VAL_8:.*]] = fir.array_load %[[VAL_0]] : (!fir.box<!fir.array<?x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>>) -> !fir.array<?x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>
+! CHECK:         %[[VAL_9:.*]] = fir.load %[[VAL_1]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>
+! CHECK:         %[[VAL_10:.*]] = arith.constant 0 : index
+! CHECK:         %[[VAL_11:.*]]:3 = fir.box_dims %[[VAL_9]], %[[VAL_10]] : (!fir.box<!fir.ptr<!fir.array<?xi32>>>, index) -> (index, index, index)
+! CHECK:         %[[VAL_12:.*]] = fir.shift %[[VAL_11]]#0 : (index) -> !fir.shift<1>
+! CHECK:         %[[VAL_13:.*]] = fir.array_load %[[VAL_9]](%[[VAL_12]]) : (!fir.box<!fir.ptr<!fir.array<?xi32>>>, !fir.shift<1>) -> !fir.array<?xi32>
+! CHECK:         %[[VAL_14:.*]] = fir.do_loop %[[VAL_15:.*]] = %[[VAL_4]] to %[[VAL_6]] step %[[VAL_7]] unordered iter_args(%[[VAL_16:.*]] = %[[VAL_8]]) -> (!fir.array<?x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>) {
+! CHECK:           %[[VAL_17:.*]] = fir.convert %[[VAL_15]] : (index) -> i32
+! CHECK:           fir.store %[[VAL_17]] to %[[VAL_2]] : !fir.ref<i32>
+! CHECK:           %[[VAL_18:.*]] = fir.load %[[VAL_2]] : !fir.ref<i32>
+! CHECK:           %[[VAL_19:.*]] = fir.convert %[[VAL_18]] : (i32) -> i64
+! CHECK:           %[[VAL_20:.*]] = fir.convert %[[VAL_19]] : (i64) -> index
+! CHECK:           %[[VAL_21:.*]] = arith.subi %[[VAL_20]], %[[VAL_11]]#0 : index
+! CHECK:           %[[VAL_22:.*]] = fir.array_access %[[VAL_13]], %[[VAL_21]] : (!fir.array<?xi32>, index) -> !fir.ref<i32>
+! CHECK:           %[[VAL_23:.*]] = fir.convert %[[VAL_22]] : (!fir.ref<i32>) -> !fir.ptr<i32>
+! CHECK:           %[[VAL_24:.*]] = fir.embox %[[VAL_23]] : (!fir.ptr<i32>) -> !fir.box<!fir.ptr<i32>>
+! CHECK:           %[[VAL_25:.*]] = arith.constant 1 : index
+! CHECK:           %[[VAL_26:.*]] = fir.load %[[VAL_2]] : !fir.ref<i32>
+! CHECK:           %[[VAL_27:.*]] = fir.convert %[[VAL_26]] : (i32) -> i64
+! CHECK:           %[[VAL_28:.*]] = fir.convert %[[VAL_27]] : (i64) -> index
+! CHECK:           %[[VAL_29:.*]] = arith.subi %[[VAL_28]], %[[VAL_25]] : index
+! CHECK:           %[[VAL_30:.*]] = fir.field_index ip, !fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>
+! CHECK:           %[[VAL_31:.*]] = fir.array_update %[[VAL_16]], %[[VAL_24]], %[[VAL_29]], %[[VAL_30]] : (!fir.array<?x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>, !fir.box<!fir.ptr<i32>>, index, !fir.field) -> !fir.array<?x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>
+! CHECK:           fir.result %[[VAL_31]] : !fir.array<?x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>
+! CHECK:         }
+! CHECK:         fir.array_merge_store %[[VAL_8]], %[[VAL_32:.*]] to %[[VAL_0]] : !fir.array<?x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>, !fir.array<?x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>, !fir.box<!fir.array<?x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>>
+! CHECK:         return
+! CHECK:       }
+
+subroutine s2_2(x,y)
+  use array_of_pointer_test
+  type(t) :: x(:)
+  integer, ALLOCATABLE, TARGET :: y(:)
+
+  forall (i=1:10)
+     ! assign address to POINTER
+     x(i)%ip => y(i)
+  end forall
+end subroutine s2_2
+
+! CHECK-LABEL: func @_QPs2_2(
+! CHECK-SAME:                %[[VAL_0:.*]]: !fir.box<!fir.array<?x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>> {fir.bindc_name = "x"},
+! CHECK-SAME:                %[[VAL_1:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>> {fir.bindc_name = "y", fir.target}) {
+! CHECK:         %[[VAL_2:.*]] = fir.alloca i32 {adapt.valuebyref, bindc_name = "i"}
+! CHECK:         %[[VAL_3:.*]] = arith.constant 1 : i32
+! CHECK:         %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (i32) -> index
+! CHECK:         %[[VAL_5:.*]] = arith.constant 10 : i32
+! CHECK:         %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (i32) -> index
+! CHECK:         %[[VAL_7:.*]] = arith.constant 1 : index
+! CHECK:         %[[VAL_8:.*]] = fir.array_load %[[VAL_0]] : (!fir.box<!fir.array<?x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>>) -> !fir.array<?x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>
+! CHECK:         %[[VAL_9:.*]] = fir.load %[[VAL_1]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
+! CHECK:         %[[VAL_10:.*]] = arith.constant 0 : index
+! CHECK:         %[[VAL_11:.*]]:3 = fir.box_dims %[[VAL_9]], %[[VAL_10]] : (!fir.box<!fir.heap<!fir.array<?xi32>>>, index) -> (index, index, index)
+! CHECK:         %[[VAL_12:.*]] = fir.box_addr %[[VAL_9]] : (!fir.box<!fir.heap<!fir.array<?xi32>>>) -> !fir.heap<!fir.array<?xi32>>
+! CHECK:         %[[VAL_13:.*]] = fir.shape_shift %[[VAL_11]]#0, %[[VAL_11]]#1 : (index, index) -> !fir.shapeshift<1>
+! CHECK:         %[[VAL_14:.*]] = fir.array_load %[[VAL_12]](%[[VAL_13]]) : (!fir.heap<!fir.array<?xi32>>, !fir.shapeshift<1>) -> !fir.array<?xi32>
+! CHECK:         %[[VAL_15:.*]] = fir.do_loop %[[VAL_16:.*]] = %[[VAL_4]] to %[[VAL_6]] step %[[VAL_7]] unordered iter_args(%[[VAL_17:.*]] = %[[VAL_8]]) -> (!fir.array<?x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>) {
+! CHECK:           %[[VAL_18:.*]] = fir.convert %[[VAL_16]] : (index) -> i32
+! CHECK:           fir.store %[[VAL_18]] to %[[VAL_2]] : !fir.ref<i32>
+! CHECK:           %[[VAL_19:.*]] = fir.load %[[VAL_2]] : !fir.ref<i32>
+! CHECK:           %[[VAL_20:.*]] = fir.convert %[[VAL_19]] : (i32) -> i64
+! CHECK:           %[[VAL_21:.*]] = fir.convert %[[VAL_20]] : (i64) -> index
+! CHECK:           %[[VAL_22:.*]] = arith.subi %[[VAL_21]], %[[VAL_11]]#0 : index
+! CHECK:           %[[VAL_23:.*]] = fir.array_access %[[VAL_14]], %[[VAL_22]] : (!fir.array<?xi32>, index) -> !fir.ref<i32>
+! CHECK:           %[[VAL_24:.*]] = fir.convert %[[VAL_23]] : (!fir.ref<i32>) -> !fir.ptr<i32>
+! CHECK:           %[[VAL_25:.*]] = fir.embox %[[VAL_24]] : (!fir.ptr<i32>) -> !fir.box<!fir.ptr<i32>>
+! CHECK:           %[[VAL_26:.*]] = arith.constant 1 : index
+! CHECK:           %[[VAL_27:.*]] = fir.load %[[VAL_2]] : !fir.ref<i32>
+! CHECK:           %[[VAL_28:.*]] = fir.convert %[[VAL_27]] : (i32) -> i64
+! CHECK:           %[[VAL_29:.*]] = fir.convert %[[VAL_28]] : (i64) -> index
+! CHECK:           %[[VAL_30:.*]] = arith.subi %[[VAL_29]], %[[VAL_26]] : index
+! CHECK:           %[[VAL_31:.*]] = fir.field_index ip, !fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>
+! CHECK:           %[[VAL_32:.*]] = fir.array_update %[[VAL_17]], %[[VAL_25]], %[[VAL_30]], %[[VAL_31]] : (!fir.array<?x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>, !fir.box<!fir.ptr<i32>>, index, !fir.field) -> !fir.array<?x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>
+! CHECK:           fir.result %[[VAL_32]] : !fir.array<?x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>
+! CHECK:         }
+! CHECK:         fir.array_merge_store %[[VAL_8]], %[[VAL_33:.*]] to %[[VAL_0]] : !fir.array<?x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>, !fir.array<?x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>, !fir.box<!fir.array<?x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>>
+! CHECK:         return
+! CHECK:       }
+
+subroutine s2_3(x)
+  use array_of_pointer_test
+  type(t) :: x(:)
+  ! This is legal, but a bad idea.
+  integer, ALLOCATABLE, TARGET :: y(:)
+
+  forall (i=1:10)
+     ! assign address to POINTER
+     x(i)%ip => y(i)
+  end forall
+  ! x's pointers will remain associated, and may point to deallocated y.
+end subroutine s2_3
+
+! CHECK-LABEL: func @_QPs2_3(
+! CHECK-SAME:                %[[VAL_0:.*]]: !fir.box<!fir.array<?x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>> {fir.bindc_name = "x"}) {
+! CHECK:         %[[VAL_1:.*]] = fir.alloca i32 {adapt.valuebyref, bindc_name = "i"}
+! CHECK:         %[[VAL_2:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?xi32>>> {bindc_name = "y", fir.target, uniq_name = "_QFs2_3Ey"}
+! CHECK:         %[[VAL_3:.*]] = fir.alloca !fir.heap<!fir.array<?xi32>> {uniq_name = "_QFs2_3Ey.addr"}
+! CHECK:         %[[VAL_4:.*]] = fir.alloca index {uniq_name = "_QFs2_3Ey.lb0"}
+! CHECK:         %[[VAL_5:.*]] = fir.alloca index {uniq_name = "_QFs2_3Ey.ext0"}
+! CHECK:         %[[VAL_6:.*]] = fir.zero_bits !fir.heap<!fir.array<?xi32>>
+! CHECK:         fir.store %[[VAL_6]] to %[[VAL_3]] : !fir.ref<!fir.heap<!fir.array<?xi32>>>
+! CHECK:         %[[VAL_7:.*]] = arith.constant 1 : i32
+! CHECK:         %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (i32) -> index
+! CHECK:         %[[VAL_9:.*]] = arith.constant 10 : i32
+! CHECK:         %[[VAL_10:.*]] = fir.convert %[[VAL_9]] : (i32) -> index
+! CHECK:         %[[VAL_11:.*]] = arith.constant 1 : index
+! CHECK:         %[[VAL_12:.*]] = fir.array_load %[[VAL_0]] : (!fir.box<!fir.array<?x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>>) -> !fir.array<?x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>
+! CHECK:         %[[VAL_13:.*]] = fir.load %[[VAL_4]] : !fir.ref<index>
+! CHECK:         %[[VAL_14:.*]] = fir.load %[[VAL_5]] : !fir.ref<index>
+! CHECK:         %[[VAL_15:.*]] = fir.load %[[VAL_3]] : !fir.ref<!fir.heap<!fir.array<?xi32>>>
+! CHECK:         %[[VAL_16:.*]] = fir.shape_shift %[[VAL_13]], %[[VAL_14]] : (index, index) -> !fir.shapeshift<1>
+! CHECK:         %[[VAL_17:.*]] = fir.array_load %[[VAL_15]](%[[VAL_16]]) : (!fir.heap<!fir.array<?xi32>>, !fir.shapeshift<1>) -> !fir.array<?xi32>
+! CHECK:         %[[VAL_18:.*]] = fir.do_loop %[[VAL_19:.*]] = %[[VAL_8]] to %[[VAL_10]] step %[[VAL_11]] unordered iter_args(%[[VAL_20:.*]] = %[[VAL_12]]) -> (!fir.array<?x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>) {
+! CHECK:           %[[VAL_21:.*]] = fir.convert %[[VAL_19]] : (index) -> i32
+! CHECK:           fir.store %[[VAL_21]] to %[[VAL_1]] : !fir.ref<i32>
+! CHECK:           %[[VAL_22:.*]] = fir.load %[[VAL_1]] : !fir.ref<i32>
+! CHECK:           %[[VAL_23:.*]] = fir.convert %[[VAL_22]] : (i32) -> i64
+! CHECK:           %[[VAL_24:.*]] = fir.convert %[[VAL_23]] : (i64) -> index
+! CHECK:           %[[VAL_25:.*]] = arith.subi %[[VAL_24]], %[[VAL_13]] : index
+! CHECK:           %[[VAL_26:.*]] = fir.array_access %[[VAL_17]], %[[VAL_25]] : (!fir.array<?xi32>, index) -> !fir.ref<i32>
+! CHECK:           %[[VAL_27:.*]] = fir.convert %[[VAL_26]] : (!fir.ref<i32>) -> !fir.ptr<i32>
+! CHECK:           %[[VAL_28:.*]] = fir.embox %[[VAL_27]] : (!fir.ptr<i32>) -> !fir.box<!fir.ptr<i32>>
+! CHECK:           %[[VAL_29:.*]] = arith.constant 1 : index
+! CHECK:           %[[VAL_30:.*]] = fir.load %[[VAL_1]] : !fir.ref<i32>
+! CHECK:           %[[VAL_31:.*]] = fir.convert %[[VAL_30]] : (i32) -> i64
+! CHECK:           %[[VAL_32:.*]] = fir.convert %[[VAL_31]] : (i64) -> index
+! CHECK:           %[[VAL_33:.*]] = arith.subi %[[VAL_32]], %[[VAL_29]] : index
+! CHECK:           %[[VAL_34:.*]] = fir.field_index ip, !fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>
+! CHECK:           %[[VAL_35:.*]] = fir.array_update %[[VAL_20]], %[[VAL_28]], %[[VAL_33]], %[[VAL_34]] : (!fir.array<?x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>, !fir.box<!fir.ptr<i32>>, index, !fir.field) -> !fir.array<?x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>
+! CHECK:           fir.result %[[VAL_35]] : !fir.array<?x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>
+! CHECK:         }
+! CHECK:         fir.array_merge_store %[[VAL_12]], %[[VAL_36:.*]] to %[[VAL_0]] : !fir.array<?x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>, !fir.array<?x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>, !fir.box<!fir.array<?x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>>
+! CHECK:         return
+! CHECK:       }
+
+! Dependent type - TODO
+!subroutine s2_4(x,y,l)
+!  use array_of_pointer_test
+!  type(ct(l)) :: x(:)
+!  character(l), TARGET :: y(:)
+
+!  forall (i=1:10)
+     ! assign address to POINTER
+!     x(i)%cp => y(i)
+!  end forall
+!end subroutine s2_4
+
+subroutine s3(x,y)
+  use array_of_pointer_test
+  type(tu) :: x(:)
+  integer :: y(:)
+
+  forall (i=1:10)
+     ! assign value to variable, indirecting through box
+     x(i)%ip%v = y(i)
+  end forall
+end subroutine s3
+
+! CHECK-LABEL: func @_QPs3(
+! CHECK-SAME:              %[[VAL_0:.*]]: !fir.box<!fir.array<?x!fir.type<_QMarray_of_pointer_testTtu{ip:!fir.box<!fir.ptr<!fir.type<_QMarray_of_pointer_testTu{v:i32}>>>}>>> {fir.bindc_name = "x"},
+! CHECK-SAME:              %[[VAL_1:.*]]: !fir.box<!fir.array<?xi32>> {fir.bindc_name = "y"}) {
+! CHECK:         %[[VAL_2:.*]] = fir.alloca i32 {adapt.valuebyref, bindc_name = "i"}
+! CHECK:         %[[VAL_3:.*]] = arith.constant 1 : i32
+! CHECK:         %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (i32) -> index
+! CHECK:         %[[VAL_5:.*]] = arith.constant 10 : i32
+! CHECK:         %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (i32) -> index
+! CHECK:         %[[VAL_7:.*]] = arith.constant 1 : index
+! CHECK:         %[[VAL_8:.*]] = fir.array_load %[[VAL_0]] : (!fir.box<!fir.array<?x!fir.type<_QMarray_of_pointer_testTtu{ip:!fir.box<!fir.ptr<!fir.type<_QMarray_of_pointer_testTu{v:i32}>>>}>>>) -> !fir.array<?x!fir.type<_QMarray_of_pointer_testTtu{ip:!fir.box<!fir.ptr<!fir.type<_QMarray_of_pointer_testTu{v:i32}>>>}>>
+! CHECK:         %[[VAL_9:.*]] = fir.array_load %[[VAL_1]] : (!fir.box<!fir.array<?xi32>>) -> !fir.array<?xi32>
+! CHECK:         %[[VAL_10:.*]] = fir.do_loop %[[VAL_11:.*]] = %[[VAL_4]] to %[[VAL_6]] step %[[VAL_7]] unordered iter_args(%[[VAL_12:.*]] = %[[VAL_8]]) -> (!fir.array<?x!fir.type<_QMarray_of_pointer_testTtu{ip:!fir.box<!fir.ptr<!fir.type<_QMarray_of_pointer_testTu{v:i32}>>>}>>) {
+! CHECK:           %[[VAL_13:.*]] = fir.convert %[[VAL_11]] : (index) -> i32
+! CHECK:           fir.store %[[VAL_13]] to %[[VAL_2]] : !fir.ref<i32>
+! CHECK:           %[[VAL_14:.*]] = arith.constant 1 : index
+! CHECK:           %[[VAL_15:.*]] = fir.load %[[VAL_2]] : !fir.ref<i32>
+! CHECK:           %[[VAL_16:.*]] = fir.convert %[[VAL_15]] : (i32) -> i64
+! CHECK:           %[[VAL_17:.*]] = fir.convert %[[VAL_16]] : (i64) -> index
+! CHECK:           %[[VAL_18:.*]] = arith.subi %[[VAL_17]], %[[VAL_14]] : index
+! CHECK:           %[[VAL_19:.*]] = fir.array_fetch %[[VAL_9]], %[[VAL_18]] : (!fir.array<?xi32>, index) -> i32
+! CHECK:           %[[VAL_20:.*]] = arith.constant 1 : index
+! CHECK:           %[[VAL_21:.*]] = fir.load %[[VAL_2]] : !fir.ref<i32>
+! CHECK:           %[[VAL_22:.*]] = fir.convert %[[VAL_21]] : (i32) -> i64
+! CHECK:           %[[VAL_23:.*]] = fir.convert %[[VAL_22]] : (i64) -> index
+! CHECK:           %[[VAL_24:.*]] = arith.subi %[[VAL_23]], %[[VAL_20]] : index
+! CHECK:           %[[VAL_25:.*]] = fir.field_index ip, !fir.type<_QMarray_of_pointer_testTtu{ip:!fir.box<!fir.ptr<!fir.type<_QMarray_of_pointer_testTu{v:i32}>>>}>
+! CHECK:           %[[VAL_26:.*]] = fir.field_index v, !fir.type<_QMarray_of_pointer_testTu{v:i32}>
+! CHECK:           %[[VAL_27:.*]] = fir.array_access %[[VAL_12]], %[[VAL_24]], %[[VAL_25]] : (!fir.array<?x!fir.type<_QMarray_of_pointer_testTtu{ip:!fir.box<!fir.ptr<!fir.type<_QMarray_of_pointer_testTu{v:i32}>>>}>>, index, !fir.field) -> !fir.ref<!fir.box<!fir.ptr<!fir.type<_QMarray_of_pointer_testTu{v:i32}>>>>
+! CHECK:           %[[VAL_28:.*]] = fir.load %[[VAL_27]] : !fir.ref<!fir.box<!fir.ptr<!fir.type<_QMarray_of_pointer_testTu{v:i32}>>>>
+! CHECK:           %[[VAL_29:.*]] = fir.coordinate_of %[[VAL_28]], %[[VAL_26]] : (!fir.box<!fir.ptr<!fir.type<_QMarray_of_pointer_testTu{v:i32}>>>, !fir.field) -> !fir.ref<i32>
+! CHECK:           fir.store %[[VAL_19]] to %[[VAL_29]] : !fir.ref<i32>
+! CHECK:           %[[VAL_30:.*]] = fir.array_amend %[[VAL_12]], %[[VAL_27]] : (!fir.array<?x!fir.type<_QMarray_of_pointer_testTtu{ip:!fir.box<!fir.ptr<!fir.type<_QMarray_of_pointer_testTu{v:i32}>>>}>>, !fir.ref<!fir.box<!fir.ptr<!fir.type<_QMarray_of_pointer_testTu{v:i32}>>>>) -> !fir.array<?x!fir.type<_QMarray_of_pointer_testTtu{ip:!fir.box<!fir.ptr<!fir.type<_QMarray_of_pointer_testTu{v:i32}>>>}>>
+! CHECK:           fir.result %[[VAL_30]] : !fir.array<?x!fir.type<_QMarray_of_pointer_testTtu{ip:!fir.box<!fir.ptr<!fir.type<_QMarray_of_pointer_testTu{v:i32}>>>}>>
+! CHECK:         }
+! CHECK:         fir.array_merge_store %[[VAL_8]], %[[VAL_31:.*]] to %[[VAL_0]] : !fir.array<?x!fir.type<_QMarray_of_pointer_testTtu{ip:!fir.box<!fir.ptr<!fir.type<_QMarray_of_pointer_testTu{v:i32}>>>}>>, !fir.array<?x!fir.type<_QMarray_of_pointer_testTtu{ip:!fir.box<!fir.ptr<!fir.type<_QMarray_of_pointer_testTu{v:i32}>>>}>>, !fir.box<!fir.array<?x!fir.type<_QMarray_of_pointer_testTtu{ip:!fir.box<!fir.ptr<!fir.type<_QMarray_of_pointer_testTu{v:i32}>>>}>>>
+! CHECK:         return
+! CHECK:       }
+
+subroutine s3_1(x,y)
+  use array_of_pointer_test
+  type(tu) :: x(:)
+  integer :: y(:)
+
+  forall (i=1:10)
+     ! assign value to variable, indirecting through box
+     x(i)%ip%v = y(i)
+  end forall
+end subroutine s3_1
+
+! CHECK-LABEL: func @_QPs3_1(
+! CHECK-SAME:                %[[VAL_0:.*]]: !fir.box<!fir.array<?x!fir.type<_QMarray_of_pointer_testTtu{ip:!fir.box<!fir.ptr<!fir.type<_QMarray_of_pointer_testTu{v:i32}>>>}>>> {fir.bindc_name = "x"},
+! CHECK-SAME:                %[[VAL_1:.*]]: !fir.box<!fir.array<?xi32>> {fir.bindc_name = "y"}) {
+! CHECK:         %[[VAL_2:.*]] = fir.alloca i32 {adapt.valuebyref, bindc_name = "i"}
+! CHECK:         %[[VAL_3:.*]] = arith.constant 1 : i32
+! CHECK:         %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (i32) -> index
+! CHECK:         %[[VAL_5:.*]] = arith.constant 10 : i32
+! CHECK:         %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (i32) -> index
+! CHECK:         %[[VAL_7:.*]] = arith.constant 1 : index
+! CHECK:         %[[VAL_8:.*]] = fir.array_load %[[VAL_0]] : (!fir.box<!fir.array<?x!fir.type<_QMarray_of_pointer_testTtu{ip:!fir.box<!fir.ptr<!fir.type<_QMarray_of_pointer_testTu{v:i32}>>>}>>>) -> !fir.array<?x!fir.type<_QMarray_of_pointer_testTtu{ip:!fir.box<!fir.ptr<!fir.type<_QMarray_of_pointer_testTu{v:i32}>>>}>>
+! CHECK:         %[[VAL_9:.*]] = fir.array_load %[[VAL_1]] : (!fir.box<!fir.array<?xi32>>) -> !fir.array<?xi32>
+! CHECK:         %[[VAL_10:.*]] = fir.do_loop %[[VAL_11:.*]] = %[[VAL_4]] to %[[VAL_6]] step %[[VAL_7]] unordered iter_args(%[[VAL_12:.*]] = %[[VAL_8]]) -> (!fir.array<?x!fir.type<_QMarray_of_pointer_testTtu{ip:!fir.box<!fir.ptr<!fir.type<_QMarray_of_pointer_testTu{v:i32}>>>}>>) {
+! CHECK:           %[[VAL_13:.*]] = fir.convert %[[VAL_11]] : (index) -> i32
+! CHECK:           fir.store %[[VAL_13]] to %[[VAL_2]] : !fir.ref<i32>
+! CHECK:           %[[VAL_14:.*]] = arith.constant 1 : index
+! CHECK:           %[[VAL_15:.*]] = fir.load %[[VAL_2]] : !fir.ref<i32>
+! CHECK:           %[[VAL_16:.*]] = fir.convert %[[VAL_15]] : (i32) -> i64
+! CHECK:           %[[VAL_17:.*]] = fir.convert %[[VAL_16]] : (i64) -> index
+! CHECK:           %[[VAL_18:.*]] = arith.subi %[[VAL_17]], %[[VAL_14]] : index
+! CHECK:           %[[VAL_19:.*]] = fir.array_fetch %[[VAL_9]], %[[VAL_18]] : (!fir.array<?xi32>, index) -> i32
+! CHECK:           %[[VAL_20:.*]] = arith.constant 1 : index
+! CHECK:           %[[VAL_21:.*]] = fir.load %[[VAL_2]] : !fir.ref<i32>
+! CHECK:           %[[VAL_22:.*]] = fir.convert %[[VAL_21]] : (i32) -> i64
+! CHECK:           %[[VAL_23:.*]] = fir.convert %[[VAL_22]] : (i64) -> index
+! CHECK:           %[[VAL_24:.*]] = arith.subi %[[VAL_23]], %[[VAL_20]] : index
+! CHECK:           %[[VAL_25:.*]] = fir.field_index ip, !fir.type<_QMarray_of_pointer_testTtu{ip:!fir.box<!fir.ptr<!fir.type<_QMarray_of_pointer_testTu{v:i32}>>>}>
+! CHECK:           %[[VAL_26:.*]] = fir.field_index v, !fir.type<_QMarray_of_pointer_testTu{v:i32}>
+! CHECK:           %[[VAL_27:.*]] = fir.array_access %[[VAL_12]], %[[VAL_24]], %[[VAL_25]] : (!fir.array<?x!fir.type<_QMarray_of_pointer_testTtu{ip:!fir.box<!fir.ptr<!fir.type<_QMarray_of_pointer_testTu{v:i32}>>>}>>, index, !fir.field) -> !fir.ref<!fir.box<!fir.ptr<!fir.type<_QMarray_of_pointer_testTu{v:i32}>>>>
+! CHECK:           %[[VAL_28:.*]] = fir.load %[[VAL_27]] : !fir.ref<!fir.box<!fir.ptr<!fir.type<_QMarray_of_pointer_testTu{v:i32}>>>>
+! CHECK:           %[[VAL_29:.*]] = fir.coordinate_of %[[VAL_28]], %[[VAL_26]] : (!fir.box<!fir.ptr<!fir.type<_QMarray_of_pointer_testTu{v:i32}>>>, !fir.field) -> !fir.ref<i32>
+! CHECK:           fir.store %[[VAL_19]] to %[[VAL_29]] : !fir.ref<i32>
+! CHECK:           %[[VAL_30:.*]] = fir.array_amend %[[VAL_12]], %[[VAL_27]] : (!fir.array<?x!fir.type<_QMarray_of_pointer_testTtu{ip:!fir.box<!fir.ptr<!fir.type<_QMarray_of_pointer_testTu{v:i32}>>>}>>, !fir.ref<!fir.box<!fir.ptr<!fir.type<_QMarray_of_pointer_testTu{v:i32}>>>>) -> !fir.array<?x!fir.type<_QMarray_of_pointer_testTtu{ip:!fir.box<!fir.ptr<!fir.type<_QMarray_of_pointer_testTu{v:i32}>>>}>>
+! CHECK:           fir.result %[[VAL_30]] : !fir.array<?x!fir.type<_QMarray_of_pointer_testTtu{ip:!fir.box<!fir.ptr<!fir.type<_QMarray_of_pointer_testTu{v:i32}>>>}>>
+! CHECK:         }
+! CHECK:         fir.array_merge_store %[[VAL_8]], %[[VAL_31:.*]] to %[[VAL_0]] : !fir.array<?x!fir.type<_QMarray_of_pointer_testTtu{ip:!fir.box<!fir.ptr<!fir.type<_QMarray_of_pointer_testTu{v:i32}>>>}>>, !fir.array<?x!fir.type<_QMarray_of_pointer_testTtu{ip:!fir.box<!fir.ptr<!fir.type<_QMarray_of_pointer_testTu{v:i32}>>>}>>, !fir.box<!fir.array<?x!fir.type<_QMarray_of_pointer_testTtu{ip:!fir.box<!fir.ptr<!fir.type<_QMarray_of_pointer_testTu{v:i32}>>>}>>>
+! CHECK:         return
+! CHECK:       }
+
+! Slice a target array and assign the box to a pointer of rank-1 field.
+! RHS is an array section. Hits a TODO.
+subroutine s4(x,y)
+  use array_of_pointer_test
+  type(ta) :: x(:)
+  integer, TARGET :: y(:)
+
+  forall (i=1:10)
+     ! TODO: auto boxing of ranked RHS
+!    x(i)%ip => y(i:i+1)
+  end forall
+end subroutine s4
+
+! Most other Fortran implementations cannot compile the following 2 cases, s5
+! and s5_1.
+subroutine s5(x,y,z,n1,n2)
+  use array_of_pointer_test
+  type(ta) :: x(:)
+  type(tb) :: y(:)
+  type(ta), TARGET :: z(:)
+
+  forall (i=1:10)
+     ! Convert the rank-1 array to a rank-2 array on assignment
+     y(i)%ip(1:n1,1:n2) => z(i)%ip
+  end forall
+end subroutine s5
+
+! CHECK-LABEL: func @_QPs5(
+! CHECK-SAME:              %[[VAL_0:.*]]: !fir.box<!fir.array<?x!fir.type<_QMarray_of_pointer_testTta{ip:!fir.box<!fir.ptr<!fir.array<?xi32>>>}>>> {fir.bindc_name = "x"},
+! CHECK-SAME:              %[[VAL_1:.*]]: !fir.box<!fir.array<?x!fir.type<_QMarray_of_pointer_testTtb{ip:!fir.box<!fir.ptr<!fir.array<?x?xi32>>>}>>> {fir.bindc_name = "y"},
+! CHECK-SAME:              %[[VAL_2:.*]]: !fir.box<!fir.array<?x!fir.type<_QMarray_of_pointer_testTta{ip:!fir.box<!fir.ptr<!fir.array<?xi32>>>}>>> {fir.bindc_name = "z", fir.target},
+! CHECK-SAME:              %[[VAL_3:.*]]: !fir.ref<i32> {fir.bindc_name = "n1"},
+! CHECK-SAME:              %[[VAL_4:.*]]: !fir.ref<i32> {fir.bindc_name = "n2"}) {
+! CHECK:         %[[VAL_5:.*]] = fir.alloca i32 {adapt.valuebyref, bindc_name = "i"}
+! CHECK:         %[[VAL_6:.*]] = arith.constant 1 : i32
+! CHECK:         %[[VAL_7:.*]] = fir.convert %[[VAL_6]] : (i32) -> index
+! CHECK:         %[[VAL_8:.*]] = arith.constant 10 : i32
+! CHECK:         %[[VAL_9:.*]] = fir.convert %[[VAL_8]] : (i32) -> index
+! CHECK:         %[[VAL_10:.*]] = arith.constant 1 : index
+! CHECK:         %[[VAL_11:.*]] = fir.array_load %[[VAL_1]] : (!fir.box<!fir.array<?x!fir.type<_QMarray_of_pointer_testTtb{ip:!fir.box<!fir.ptr<!fir.array<?x?xi32>>>}>>>) -> !fir.array<?x!fir.type<_QMarray_of_pointer_testTtb{ip:!fir.box<!fir.ptr<!fir.array<?x?xi32>>>}>>
+! CHECK:         %[[VAL_12:.*]] = fir.array_load %[[VAL_2]] : (!fir.box<!fir.array<?x!fir.type<_QMarray_of_pointer_testTta{ip:!fir.box<!fir.ptr<!fir.array<?xi32>>>}>>>) -> !fir.array<?x!fir.type<_QMarray_of_pointer_testTta{ip:!fir.box<!fir.ptr<!fir.array<?xi32>>>}>>
+! CHECK:         %[[VAL_13:.*]] = fir.do_loop %[[VAL_14:.*]] = %[[VAL_7]] to %[[VAL_9]] step %[[VAL_10]] unordered iter_args(%[[VAL_15:.*]] = %[[VAL_11]]) -> (!fir.array<?x!fir.type<_QMarray_of_pointer_testTtb{ip:!fir.box<!fir.ptr<!fir.array<?x?xi32>>>}>>) {
+! CHECK:           %[[VAL_16:.*]] = fir.convert %[[VAL_14]] : (index) -> i32
+! CHECK:           fir.store %[[VAL_16]] to %[[VAL_5]] : !fir.ref<i32>
+! CHECK:           %[[VAL_17:.*]] = arith.constant 1 : i64
+! CHECK:           %[[VAL_18:.*]] = fir.load %[[VAL_3]] : !fir.ref<i32>
+! CHECK:           %[[VAL_19:.*]] = fir.convert %[[VAL_18]] : (i32) -> i64
+! CHECK:           %[[VAL_20:.*]] = arith.constant 1 : i64
+! CHECK:           %[[VAL_21:.*]] = fir.load %[[VAL_4]] : !fir.ref<i32>
+! CHECK:           %[[VAL_22:.*]] = fir.convert %[[VAL_21]] : (i32) -> i64
+! CHECK:           %[[VAL_23:.*]] = arith.constant 1 : index
+! CHECK:           %[[VAL_24:.*]] = fir.load %[[VAL_5]] : !fir.ref<i32>
+! CHECK:           %[[VAL_25:.*]] = fir.convert %[[VAL_24]] : (i32) -> i64
+! CHECK:           %[[VAL_26:.*]] = fir.convert %[[VAL_25]] : (i64) -> index
+! CHECK:           %[[VAL_27:.*]] = arith.subi %[[VAL_26]], %[[VAL_23]] : index
+! CHECK:           %[[VAL_28:.*]] = fir.field_index ip, !fir.type<_QMarray_of_pointer_testTta{ip:!fir.box<!fir.ptr<!fir.array<?xi32>>>}>
+! CHECK:           %[[VAL_29:.*]] = fir.array_fetch %[[VAL_12]], %[[VAL_27]], %[[VAL_28]] : (!fir.array<?x!fir.type<_QMarray_of_pointer_testTta{ip:!fir.box<!fir.ptr<!fir.array<?xi32>>>}>>, index, !fir.field) -> !fir.box<!fir.ptr<!fir.array<?xi32>>>
+! CHECK:           %[[VAL_30:.*]] = arith.constant 1 : index
+! CHECK:           %[[VAL_31:.*]] = fir.load %[[VAL_5]] : !fir.ref<i32>
+! CHECK:           %[[VAL_32:.*]] = fir.convert %[[VAL_31]] : (i32) -> i64
+! CHECK:           %[[VAL_33:.*]] = fir.convert %[[VAL_32]] : (i64) -> index
+! CHECK:           %[[VAL_34:.*]] = arith.subi %[[VAL_33]], %[[VAL_30]] : index
+! CHECK:           %[[VAL_35:.*]] = fir.field_index ip, !fir.type<_QMarray_of_pointer_testTtb{ip:!fir.box<!fir.ptr<!fir.array<?x?xi32>>>}>
+! CHECK:           %[[VAL_36:.*]] = fir.convert %[[VAL_29]] : (!fir.box<!fir.ptr<!fir.array<?xi32>>>) -> !fir.box<!fir.ptr<!fir.array<?x?xi32>>>
+! CHECK:           %[[VAL_37:.*]] = fir.shape_shift %[[VAL_17]], %[[VAL_19]], %[[VAL_20]], %[[VAL_22]] : (i64, i64, i64, i64) -> !fir.shapeshift<2>
+! CHECK:           %[[VAL_38:.*]] = fir.rebox %[[VAL_36]](%[[VAL_37]]) : (!fir.box<!fir.ptr<!fir.array<?x?xi32>>>, !fir.shapeshift<2>) -> !fir.box<!fir.ptr<!fir.array<?x?xi32>>>
+! CHECK:           %[[VAL_39:.*]] = fir.array_update %[[VAL_15]], %[[VAL_38]], %[[VAL_34]], %[[VAL_35]] : (!fir.array<?x!fir.type<_QMarray_of_pointer_testTtb{ip:!fir.box<!fir.ptr<!fir.array<?x?xi32>>>}>>, !fir.box<!fir.ptr<!fir.array<?x?xi32>>>, index, !fir.field) -> !fir.array<?x!fir.type<_QMarray_of_pointer_testTtb{ip:!fir.box<!fir.ptr<!fir.array<?x?xi32>>>}>>
+! CHECK:           fir.result %[[VAL_39]] : !fir.array<?x!fir.type<_QMarray_of_pointer_testTtb{ip:!fir.box<!fir.ptr<!fir.array<?x?xi32>>>}>>
+! CHECK:         }
+! CHECK:         fir.array_merge_store %[[VAL_11]], %[[VAL_40:.*]] to %[[VAL_1]] : !fir.array<?x!fir.type<_QMarray_of_pointer_testTtb{ip:!fir.box<!fir.ptr<!fir.array<?x?xi32>>>}>>, !fir.array<?x!fir.type<_QMarray_of_pointer_testTtb{ip:!fir.box<!fir.ptr<!fir.array<?x?xi32>>>}>>, !fir.box<!fir.array<?x!fir.type<_QMarray_of_pointer_testTtb{ip:!fir.box<!fir.ptr<!fir.array<?x?xi32>>>}>>>
+! CHECK:         return
+! CHECK:       }
+
+! RHS is an array section. Hits a TODO.
+subroutine s5_1(x,y,z,n1,n2)
+  use array_of_pointer_test
+  type(ta) :: x(:)
+  type(tb) :: y(:)
+  type(ta), TARGET :: z(:)
+
+  forall (i=1:10)
+     ! Slice a rank 1 array and save the slice to the box.
+!     x(i)%ip => z(i)%ip(1::n1+1)
+  end forall
+end subroutine s5_1
+
+subroutine s6(x,y)
+  use array_of_pointer_test
+  type(tv) :: x(:)
+  integer, target :: y(:)
+
+  forall (i=1:10, j=2:20:2)
+     ! Two box indirections.
+     x(i)%jp(j)%ip%v = y(i)
+  end forall
+end subroutine s6
+
+! CHECK-LABEL: func @_QPs6(
+! CHECK-SAME:              %[[VAL_0:.*]]: !fir.box<!fir.array<?x!fir.type<_QMarray_of_pointer_testTtv{jp:!fir.box<!fir.ptr<!fir.array<?x!fir.type<_QMarray_of_pointer_testTtu{ip:!fir.box<!fir.ptr<!fir.type<_QMarray_of_pointer_testTu{v:i32}>>>}>>>>}>>> {fir.bindc_name = "x"},
+! CHECK-SAME:              %[[VAL_1:.*]]: !fir.box<!fir.array<?xi32>> {fir.bindc_name = "y", fir.target}) {
+! CHECK:         %[[VAL_2:.*]] = fir.alloca i32 {adapt.valuebyref, bindc_name = "j"}
+! CHECK:         %[[VAL_3:.*]] = fir.alloca i32 {adapt.valuebyref, bindc_name = "i"}
+! CHECK:         %[[VAL_4:.*]] = arith.constant 1 : i32
+! CHECK:         %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (i32) -> index
+! CHECK:         %[[VAL_6:.*]] = arith.constant 10 : i32
+! CHECK:         %[[VAL_7:.*]] = fir.convert %[[VAL_6]] : (i32) -> index
+! CHECK:         %[[VAL_8:.*]] = arith.constant 1 : index
+! CHECK:         %[[VAL_9:.*]] = arith.constant 2 : i32
+! CHECK:         %[[VAL_10:.*]] = fir.convert %[[VAL_9]] : (i32) -> index
+! CHECK:         %[[VAL_11:.*]] = arith.constant 20 : i32
+! CHECK:         %[[VAL_12:.*]] = fir.convert %[[VAL_11]] : (i32) -> index
+! CHECK:         %[[VAL_13:.*]] = arith.constant 2 : i32
+! CHECK:         %[[VAL_14:.*]] = fir.convert %[[VAL_13]] : (i32) -> index
+! CHECK:         %[[VAL_15:.*]] = fir.array_load %[[VAL_0]] : (!fir.box<!fir.array<?x!fir.type<_QMarray_of_pointer_testTtv{jp:!fir.box<!fir.ptr<!fir.array<?x!fir.type<_QMarray_of_pointer_testTtu{ip:!fir.box<!fir.ptr<!fir.type<_QMarray_of_pointer_testTu{v:i32}>>>}>>>>}>>>) -> !fir.array<?x!fir.type<_QMarray_of_pointer_testTtv{jp:!fir.box<!fir.ptr<!fir.array<?x!fir.type<_QMarray_of_pointer_testTtu{ip:!fir.box<!fir.ptr<!fir.type<_QMarray_of_pointer_testTu{v:i32}>>>}>>>>}>>
+! CHECK:         %[[VAL_16:.*]] = fir.array_load %[[VAL_1]] : (!fir.box<!fir.array<?xi32>>) -> !fir.array<?xi32>
+! CHECK:         %[[VAL_17:.*]] = fir.do_loop %[[VAL_18:.*]] = %[[VAL_5]] to %[[VAL_7]] step %[[VAL_8]] unordered iter_args(%[[VAL_19:.*]] = %[[VAL_15]]) -> (!fir.array<?x!fir.type<_QMarray_of_pointer_testTtv{jp:!fir.box<!fir.ptr<!fir.array<?x!fir.type<_QMarray_of_pointer_testTtu{ip:!fir.box<!fir.ptr<!fir.type<_QMarray_of_pointer_testTu{v:i32}>>>}>>>>}>>) {
+! CHECK:           %[[VAL_20:.*]] = fir.convert %[[VAL_18]] : (index) -> i32
+! CHECK:           fir.store %[[VAL_20]] to %[[VAL_3]] : !fir.ref<i32>
+! CHECK:           %[[VAL_21:.*]] = fir.do_loop %[[VAL_22:.*]] = %[[VAL_10]] to %[[VAL_12]] step %[[VAL_14]] unordered iter_args(%[[VAL_23:.*]] = %[[VAL_19]]) -> (!fir.array<?x!fir.type<_QMarray_of_pointer_testTtv{jp:!fir.box<!fir.ptr<!fir.array<?x!fir.type<_QMarray_of_pointer_testTtu{ip:!fir.box<!fir.ptr<!fir.type<_QMarray_of_pointer_testTu{v:i32}>>>}>>>>}>>) {
+! CHECK:             %[[VAL_24:.*]] = fir.convert %[[VAL_22]] : (index) -> i32
+! CHECK:             fir.store %[[VAL_24]] to %[[VAL_2]] : !fir.ref<i32>
+! CHECK:             %[[VAL_25:.*]] = arith.constant 1 : index
+! CHECK:             %[[VAL_26:.*]] = fir.load %[[VAL_3]] : !fir.ref<i32>
+! CHECK:             %[[VAL_27:.*]] = fir.convert %[[VAL_26]] : (i32) -> i64
+! CHECK:             %[[VAL_28:.*]] = fir.convert %[[VAL_27]] : (i64) -> index
+! CHECK:             %[[VAL_29:.*]] = arith.subi %[[VAL_28]], %[[VAL_25]] : index
+! CHECK:             %[[VAL_30:.*]] = fir.array_fetch %[[VAL_16]], %[[VAL_29]] : (!fir.array<?xi32>, index) -> i32
+! CHECK:             %[[VAL_31:.*]] = arith.constant 1 : index
+! CHECK:             %[[VAL_32:.*]] = fir.load %[[VAL_3]] : !fir.ref<i32>
+! CHECK:             %[[VAL_33:.*]] = fir.convert %[[VAL_32]] : (i32) -> i64
+! CHECK:             %[[VAL_34:.*]] = fir.convert %[[VAL_33]] : (i64) -> index
+! CHECK:             %[[VAL_35:.*]] = arith.subi %[[VAL_34]], %[[VAL_31]] : index
+! CHECK:             %[[VAL_36:.*]] = fir.field_index jp, !fir.type<_QMarray_of_pointer_testTtv{jp:!fir.box<!fir.ptr<!fir.array<?x!fir.type<_QMarray_of_pointer_testTtu{ip:!fir.box<!fir.ptr<!fir.type<_QMarray_of_pointer_testTu{v:i32}>>>}>>>>}>
+! CHECK:             %[[VAL_37:.*]] = fir.load %[[VAL_2]] : !fir.ref<i32>
+! CHECK:             %[[VAL_38:.*]] = fir.convert %[[VAL_37]] : (i32) -> i64
+! CHECK:             %[[VAL_39:.*]] = fir.convert %[[VAL_38]] : (i64) -> index
+! CHECK:             %[[VAL_40:.*]] = arith.subi %[[VAL_39]], %[[VAL_31]] : index
+! CHECK:             %[[VAL_41:.*]] = fir.field_index ip, !fir.type<_QMarray_of_pointer_testTtu{ip:!fir.box<!fir.ptr<!fir.type<_QMarray_of_pointer_testTu{v:i32}>>>}>
+! CHECK:             %[[VAL_42:.*]] = fir.field_index v, !fir.type<_QMarray_of_pointer_testTu{v:i32}>
+! CHECK:             %[[VAL_43:.*]] = fir.array_access %[[VAL_23]], %[[VAL_35]], %[[VAL_36]] : (!fir.array<?x!fir.type<_QMarray_of_pointer_testTtv{jp:!fir.box<!fir.ptr<!fir.array<?x!fir.type<_QMarray_of_pointer_testTtu{ip:!fir.box<!fir.ptr<!fir.type<_QMarray_of_pointer_testTu{v:i32}>>>}>>>>}>>, index, !fir.field) -> !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.type<_QMarray_of_pointer_testTtu{ip:!fir.box<!fir.ptr<!fir.type<_QMarray_of_pointer_testTu{v:i32}>>>}>>>>>
+! CHECK:             %[[VAL_44:.*]] = fir.load %[[VAL_43]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.type<_QMarray_of_pointer_testTtu{ip:!fir.box<!fir.ptr<!fir.type<_QMarray_of_pointer_testTu{v:i32}>>>}>>>>>
+! CHECK:             %[[VAL_45:.*]] = fir.coordinate_of %[[VAL_44]], %[[VAL_40]] : (!fir.box<!fir.ptr<!fir.array<?x!fir.type<_QMarray_of_pointer_testTtu{ip:!fir.box<!fir.ptr<!fir.type<_QMarray_of_pointer_testTu{v:i32}>>>}>>>>, index) -> !fir.ref<!fir.type<_QMarray_of_pointer_testTtu{ip:!fir.box<!fir.ptr<!fir.type<_QMarray_of_pointer_testTu{v:i32}>>>}>>
+! CHECK:             %[[VAL_46:.*]] = fir.coordinate_of %[[VAL_45]], %[[VAL_41]] : (!fir.ref<!fir.type<_QMarray_of_pointer_testTtu{ip:!fir.box<!fir.ptr<!fir.type<_QMarray_of_pointer_testTu{v:i32}>>>}>>, !fir.field) -> !fir.ref<!fir.box<!fir.ptr<!fir.type<_QMarray_of_pointer_testTu{v:i32}>>>>
+! CHECK:             %[[VAL_47:.*]] = fir.load %[[VAL_46]] : !fir.ref<!fir.box<!fir.ptr<!fir.type<_QMarray_of_pointer_testTu{v:i32}>>>>
+! CHECK:             %[[VAL_48:.*]] = fir.coordinate_of %[[VAL_47]], %[[VAL_42]] : (!fir.box<!fir.ptr<!fir.type<_QMarray_of_pointer_testTu{v:i32}>>>, !fir.field) -> !fir.ref<i32>
+! CHECK:             fir.store %[[VAL_30]] to %[[VAL_48]] : !fir.ref<i32>
+! CHECK:             %[[VAL_49:.*]] = fir.array_amend %[[VAL_23]], %[[VAL_43]] : (!fir.array<?x!fir.type<_QMarray_of_pointer_testTtv{jp:!fir.box<!fir.ptr<!fir.array<?x!fir.type<_QMarray_of_pointer_testTtu{ip:!fir.box<!fir.ptr<!fir.type<_QMarray_of_pointer_testTu{v:i32}>>>}>>>>}>>, !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.type<_QMarray_of_pointer_testTtu{ip:!fir.box<!fir.ptr<!fir.type<_QMarray_of_pointer_testTu{v:i32}>>>}>>>>>) -> !fir.array<?x!fir.type<_QMarray_of_pointer_testTtv{jp:!fir.box<!fir.ptr<!fir.array<?x!fir.type<_QMarray_of_pointer_testTtu{ip:!fir.box<!fir.ptr<!fir.type<_QMarray_of_pointer_testTu{v:i32}>>>}>>>>}>>
+! CHECK:             fir.result %[[VAL_49]] : !fir.array<?x!fir.type<_QMarray_of_pointer_testTtv{jp:!fir.box<!fir.ptr<!fir.array<?x!fir.type<_QMarray_of_pointer_testTtu{ip:!fir.box<!fir.ptr<!fir.type<_QMarray_of_pointer_testTu{v:i32}>>>}>>>>}>>
+! CHECK:           }
+! CHECK:           fir.result %[[VAL_50:.*]] : !fir.array<?x!fir.type<_QMarray_of_pointer_testTtv{jp:!fir.box<!fir.ptr<!fir.array<?x!fir.type<_QMarray_of_pointer_testTtu{ip:!fir.box<!fir.ptr<!fir.type<_QMarray_of_pointer_testTu{v:i32}>>>}>>>>}>>
+! CHECK:         }
+! CHECK:         fir.array_merge_store %[[VAL_15]], %[[VAL_51:.*]] to %[[VAL_0]] : !fir.array<?x!fir.type<_QMarray_of_pointer_testTtv{jp:!fir.box<!fir.ptr<!fir.array<?x!fir.type<_QMarray_of_pointer_testTtu{ip:!fir.box<!fir.ptr<!fir.type<_QMarray_of_pointer_testTu{v:i32}>>>}>>>>}>>, !fir.array<?x!fir.type<_QMarray_of_pointer_testTtv{jp:!fir.box<!fir.ptr<!fir.array<?x!fir.type<_QMarray_of_pointer_testTtu{ip:!fir.box<!fir.ptr<!fir.type<_QMarray_of_pointer_testTu{v:i32}>>>}>>>>}>>, !fir.box<!fir.array<?x!fir.type<_QMarray_of_pointer_testTtv{jp:!fir.box<!fir.ptr<!fir.array<?x!fir.type<_QMarray_of_pointer_testTtu{ip:!fir.box<!fir.ptr<!fir.type<_QMarray_of_pointer_testTu{v:i32}>>>}>>>>}>>>
+! CHECK:         return
+! CHECK:       }
+
+subroutine s7(x,y,n)
+  use array_of_pointer_test
+  type(t) x(:)
+  integer, TARGET :: y(:)
+  ! Introduce a crossing dependence
+  forall (i=1:n)
+    x(i)%ip => y(x(n+1-i)%ip)
+  end forall
+end subroutine s7
+
+! CHECK-LABEL: func @_QPs7(
+! CHECK-SAME:              %[[VAL_0:.*]]: !fir.box<!fir.array<?x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>> {fir.bindc_name = "x"},
+! CHECK-SAME:              %[[VAL_1:.*]]: !fir.box<!fir.array<?xi32>> {fir.bindc_name = "y", fir.target},
+! CHECK-SAME:              %[[VAL_2:.*]]: !fir.ref<i32> {fir.bindc_name = "n"}) {
+! CHECK:         %[[VAL_3:.*]] = fir.alloca i32 {adapt.valuebyref, bindc_name = "i"}
+! CHECK:         %[[VAL_4:.*]] = arith.constant 1 : i32
+! CHECK:         %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (i32) -> index
+! CHECK:         %[[VAL_6:.*]] = fir.load %[[VAL_2]] : !fir.ref<i32>
+! CHECK:         %[[VAL_7:.*]] = fir.convert %[[VAL_6]] : (i32) -> index
+! CHECK:         %[[VAL_8:.*]] = arith.constant 1 : index
+! CHECK:         %[[VAL_9:.*]] = fir.array_load %[[VAL_0]] : (!fir.box<!fir.array<?x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>>) -> !fir.array<?x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>
+! CHECK:         %[[VAL_10:.*]] = fir.array_load %[[VAL_1]] : (!fir.box<!fir.array<?xi32>>) -> !fir.array<?xi32>
+! CHECK:         %[[VAL_11:.*]] = fir.do_loop %[[VAL_12:.*]] = %[[VAL_5]] to %[[VAL_7]] step %[[VAL_8]] unordered iter_args(%[[VAL_13:.*]] = %[[VAL_9]]) -> (!fir.array<?x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>) {
+! CHECK:           %[[VAL_14:.*]] = fir.convert %[[VAL_12]] : (index) -> i32
+! CHECK:           fir.store %[[VAL_14]] to %[[VAL_3]] : !fir.ref<i32>
+! CHECK:           %[[VAL_15:.*]] = arith.constant 1 : index
+! CHECK:           %[[VAL_16:.*]] = fir.load %[[VAL_2]] : !fir.ref<i32>
+! CHECK:           %[[VAL_17:.*]] = arith.constant 1 : i32
+! CHECK:           %[[VAL_18:.*]] = arith.addi %[[VAL_16]], %[[VAL_17]] : i32
+! CHECK:           %[[VAL_19:.*]] = fir.load %[[VAL_3]] : !fir.ref<i32>
+! CHECK:           %[[VAL_20:.*]] = arith.subi %[[VAL_18]], %[[VAL_19]] : i32
+! CHECK:           %[[VAL_21:.*]] = fir.convert %[[VAL_20]] : (i32) -> i64
+! CHECK:           %[[VAL_22:.*]] = arith.constant 1 : i64
+! CHECK:           %[[VAL_23:.*]] = arith.subi %[[VAL_21]], %[[VAL_22]] : i64
+! CHECK:           %[[VAL_24:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_23]] : (!fir.box<!fir.array<?x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>>, i64) -> !fir.ref<!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>
+! CHECK:           %[[VAL_25:.*]] = fir.field_index ip, !fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>
+! CHECK:           %[[VAL_26:.*]] = fir.coordinate_of %[[VAL_24]], %[[VAL_25]] : (!fir.ref<!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>, !fir.field) -> !fir.ref<!fir.box<!fir.ptr<i32>>>
+! CHECK:           %[[VAL_27:.*]] = fir.load %[[VAL_26]] : !fir.ref<!fir.box<!fir.ptr<i32>>>
+! CHECK:           %[[VAL_28:.*]] = fir.box_addr %[[VAL_27]] : (!fir.box<!fir.ptr<i32>>) -> !fir.ptr<i32>
+! CHECK:           %[[VAL_29:.*]] = fir.load %[[VAL_28]] : !fir.ptr<i32>
+! CHECK:           %[[VAL_30:.*]] = fir.convert %[[VAL_29]] : (i32) -> i64
+! CHECK:           %[[VAL_31:.*]] = fir.convert %[[VAL_30]] : (i64) -> index
+! CHECK:           %[[VAL_32:.*]] = arith.subi %[[VAL_31]], %[[VAL_15]] : index
+! CHECK:           %[[VAL_33:.*]] = fir.array_access %[[VAL_10]], %[[VAL_32]] : (!fir.array<?xi32>, index) -> !fir.ref<i32>
+! CHECK:           %[[VAL_34:.*]] = fir.convert %[[VAL_33]] : (!fir.ref<i32>) -> !fir.ptr<i32>
+! CHECK:           %[[VAL_35:.*]] = fir.embox %[[VAL_34]] : (!fir.ptr<i32>) -> !fir.box<!fir.ptr<i32>>
+! CHECK:           %[[VAL_36:.*]] = arith.constant 1 : index
+! CHECK:           %[[VAL_37:.*]] = fir.load %[[VAL_3]] : !fir.ref<i32>
+! CHECK:           %[[VAL_38:.*]] = fir.convert %[[VAL_37]] : (i32) -> i64
+! CHECK:           %[[VAL_39:.*]] = fir.convert %[[VAL_38]] : (i64) -> index
+! CHECK:           %[[VAL_40:.*]] = arith.subi %[[VAL_39]], %[[VAL_36]] : index
+! CHECK:           %[[VAL_41:.*]] = fir.field_index ip, !fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>
+! CHECK:           %[[VAL_42:.*]] = fir.array_update %[[VAL_13]], %[[VAL_35]], %[[VAL_40]], %[[VAL_41]] : (!fir.array<?x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>, !fir.box<!fir.ptr<i32>>, index, !fir.field) -> !fir.array<?x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>
+! CHECK:           fir.result %[[VAL_42]] : !fir.array<?x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>
+! CHECK:         }
+! CHECK:         fir.array_merge_store %[[VAL_9]], %[[VAL_43:.*]] to %[[VAL_0]] : !fir.array<?x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>, !fir.array<?x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>, !fir.box<!fir.array<?x!fir.type<_QMarray_of_pointer_testTt{ip:!fir.box<!fir.ptr<i32>>}>>>
+! CHECK:         return
+! CHECK:       }
+
+subroutine s8(x,y,n)
+  use array_of_pointer_test
+  type(ta) x(:)
+  integer, POINTER :: y(:)
+  forall (i=1:n)
+     x(i)%ip(i:) => y
+  end forall
+end subroutine s8
+
+! CHECK-LABEL: func @_QPs8(
+! CHECK-SAME:              %[[VAL_0:.*]]: !fir.box<!fir.array<?x!fir.type<_QMarray_of_pointer_testTta{ip:!fir.box<!fir.ptr<!fir.array<?xi32>>>}>>> {fir.bindc_name = "x"},
+! CHECK-SAME:              %[[VAL_1:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>> {fir.bindc_name = "y"},
+! CHECK-SAME:              %[[VAL_2:.*]]: !fir.ref<i32> {fir.bindc_name = "n"}) {
+! CHECK:         %[[VAL_3:.*]] = fir.alloca i32 {adapt.valuebyref, bindc_name = "i"}
+! CHECK:         %[[VAL_4:.*]] = arith.constant 1 : i32
+! CHECK:         %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (i32) -> index
+! CHECK:         %[[VAL_6:.*]] = fir.load %[[VAL_2]] : !fir.ref<i32>
+! CHECK:         %[[VAL_7:.*]] = fir.convert %[[VAL_6]] : (i32) -> index
+! CHECK:         %[[VAL_8:.*]] = arith.constant 1 : index
+! CHECK:         %[[VAL_9:.*]] = fir.array_load %[[VAL_0]] : (!fir.box<!fir.array<?x!fir.type<_QMarray_of_pointer_testTta{ip:!fir.box<!fir.ptr<!fir.array<?xi32>>>}>>>) -> !fir.array<?x!fir.type<_QMarray_of_pointer_testTta{ip:!fir.box<!fir.ptr<!fir.array<?xi32>>>}>>
+! CHECK:         %[[VAL_10:.*]] = fir.load %[[VAL_1]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>
+! CHECK:         %[[VAL_11:.*]] = arith.constant 0 : index
+! CHECK:         %[[VAL_12:.*]]:3 = fir.box_dims %[[VAL_10]], %[[VAL_11]] : (!fir.box<!fir.ptr<!fir.array<?xi32>>>, index) -> (index, index, index)
+! CHECK:         %[[VAL_13:.*]] = fir.shift %[[VAL_12]]#0 : (index) -> !fir.shift<1>
+! CHECK:         %[[VAL_14:.*]] = fir.do_loop %[[VAL_15:.*]] = %[[VAL_5]] to %[[VAL_7]] step %[[VAL_8]] unordered iter_args(%[[VAL_16:.*]] = %[[VAL_9]]) -> (!fir.array<?x!fir.type<_QMarray_of_pointer_testTta{ip:!fir.box<!fir.ptr<!fir.array<?xi32>>>}>>) {
+! CHECK:           %[[VAL_17:.*]] = fir.convert %[[VAL_15]] : (index) -> i32
+! CHECK:           fir.store %[[VAL_17]] to %[[VAL_3]] : !fir.ref<i32>
+! CHECK:           %[[VAL_18:.*]] = fir.load %[[VAL_3]] : !fir.ref<i32>
+! CHECK:           %[[VAL_19:.*]] = fir.convert %[[VAL_18]] : (i32) -> i64
+! CHECK:           %[[VAL_20:.*]] = fir.rebox %[[VAL_10]](%[[VAL_13]]) : (!fir.box<!fir.ptr<!fir.array<?xi32>>>, !fir.shift<1>) -> !fir.box<!fir.ptr<!fir.array<?xi32>>>
+! CHECK:           %[[VAL_21:.*]] = arith.constant 1 : index
+! CHECK:           %[[VAL_22:.*]] = fir.load %[[VAL_3]] : !fir.ref<i32>
+! CHECK:           %[[VAL_23:.*]] = fir.convert %[[VAL_22]] : (i32) -> i64
+! CHECK:           %[[VAL_24:.*]] = fir.convert %[[VAL_23]] : (i64) -> index
+! CHECK:           %[[VAL_25:.*]] = arith.subi %[[VAL_24]], %[[VAL_21]] : index
+! CHECK:           %[[VAL_26:.*]] = fir.field_index ip, !fir.type<_QMarray_of_pointer_testTta{ip:!fir.box<!fir.ptr<!fir.array<?xi32>>>}>
+! CHECK:           %[[VAL_27:.*]] = fir.shift %[[VAL_19]] : (i64) -> !fir.shift<1>
+! CHECK:           %[[VAL_28:.*]] = fir.rebox %[[VAL_20]](%[[VAL_27]]) : (!fir.box<!fir.ptr<!fir.array<?xi32>>>, !fir.shift<1>) -> !fir.box<!fir.ptr<!fir.array<?xi32>>>
+! CHECK:           %[[VAL_29:.*]] = fir.array_update %[[VAL_16]], %[[VAL_28]], %[[VAL_25]], %[[VAL_26]] : (!fir.array<?x!fir.type<_QMarray_of_pointer_testTta{ip:!fir.box<!fir.ptr<!fir.array<?xi32>>>}>>, !fir.box<!fir.ptr<!fir.array<?xi32>>>, index, !fir.field) -> !fir.array<?x!fir.type<_QMarray_of_pointer_testTta{ip:!fir.box<!fir.ptr<!fir.array<?xi32>>>}>>
+! CHECK:           fir.result %[[VAL_29]] : !fir.array<?x!fir.type<_QMarray_of_pointer_testTta{ip:!fir.box<!fir.ptr<!fir.array<?xi32>>>}>>
+! CHECK:         }
+! CHECK:         fir.array_merge_store %[[VAL_9]], %[[VAL_30:.*]] to %[[VAL_0]] : !fir.array<?x!fir.type<_QMarray_of_pointer_testTta{ip:!fir.box<!fir.ptr<!fir.array<?xi32>>>}>>, !fir.array<?x!fir.type<_QMarray_of_pointer_testTta{ip:!fir.box<!fir.ptr<!fir.array<?xi32>>>}>>, !fir.box<!fir.array<?x!fir.type<_QMarray_of_pointer_testTta{ip:!fir.box<!fir.ptr<!fir.array<?xi32>>>}>>>
+! CHECK:         return
+! CHECK:       }
+
+subroutine s8_1(x,y,n1,n2)
+  use array_of_pointer_test
+  type(ta) x(:)
+  integer, POINTER :: y(:)
+  forall (i=1:n1)
+     x(i)%ip(i:n2+1+i) => y
+  end forall
+end subroutine s8_1
+
+! CHECK-LABEL: func @_QPs8_1(
+! CHECK-SAME:                %[[VAL_0:.*]]: !fir.box<!fir.array<?x!fir.type<_QMarray_of_pointer_testTta{ip:!fir.box<!fir.ptr<!fir.array<?xi32>>>}>>> {fir.bindc_name = "x"},
+! CHECK-SAME:                %[[VAL_1:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>> {fir.bindc_name = "y"},
+! CHECK-SAME:                %[[VAL_2:.*]]: !fir.ref<i32> {fir.bindc_name = "n1"},
+! CHECK-SAME:                %[[VAL_3:.*]]: !fir.ref<i32> {fir.bindc_name = "n2"}) {
+! CHECK:         %[[VAL_4:.*]] = fir.alloca i32 {adapt.valuebyref, bindc_name = "i"}
+! CHECK:         %[[VAL_5:.*]] = arith.constant 1 : i32
+! CHECK:         %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (i32) -> index
+! CHECK:         %[[VAL_7:.*]] = fir.load %[[VAL_2]] : !fir.ref<i32>
+! CHECK:         %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (i32) -> index
+! CHECK:         %[[VAL_9:.*]] = arith.constant 1 : index
+! CHECK:         %[[VAL_10:.*]] = fir.array_load %[[VAL_0]] : (!fir.box<!fir.array<?x!fir.type<_QMarray_of_pointer_testTta{ip:!fir.box<!fir.ptr<!fir.array<?xi32>>>}>>>) -> !fir.array<?x!fir.type<_QMarray_of_pointer_testTta{ip:!fir.box<!fir.ptr<!fir.array<?xi32>>>}>>
+! CHECK:         %[[VAL_11:.*]] = fir.load %[[VAL_1]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>
+! CHECK:         %[[VAL_12:.*]] = arith.constant 0 : index
+! CHECK:         %[[VAL_13:.*]]:3 = fir.box_dims %[[VAL_11]], %[[VAL_12]] : (!fir.box<!fir.ptr<!fir.array<?xi32>>>, index) -> (index, index, index)
+! CHECK:         %[[VAL_14:.*]] = fir.shift %[[VAL_13]]#0 : (index) -> !fir.shift<1>
+! CHECK:         %[[VAL_15:.*]] = fir.do_loop %[[VAL_16:.*]] = %[[VAL_6]] to %[[VAL_8]] step %[[VAL_9]] unordered iter_args(%[[VAL_17:.*]] = %[[VAL_10]]) -> (!fir.array<?x!fir.type<_QMarray_of_pointer_testTta{ip:!fir.box<!fir.ptr<!fir.array<?xi32>>>}>>) {
+! CHECK:           %[[VAL_18:.*]] = fir.convert %[[VAL_16]] : (index) -> i32
+! CHECK:           fir.store %[[VAL_18]] to %[[VAL_4]] : !fir.ref<i32>
+! CHECK:           %[[VAL_19:.*]] = fir.load %[[VAL_4]] : !fir.ref<i32>
+! CHECK:           %[[VAL_20:.*]] = fir.convert %[[VAL_19]] : (i32) -> i64
+! CHECK:           %[[VAL_21:.*]] = fir.load %[[VAL_3]] : !fir.ref<i32>
+! CHECK:           %[[VAL_22:.*]] = arith.constant 1 : i32
+! CHECK:           %[[VAL_23:.*]] = arith.addi %[[VAL_21]], %[[VAL_22]] : i32
+! CHECK:           %[[VAL_24:.*]] = fir.load %[[VAL_4]] : !fir.ref<i32>
+! CHECK:           %[[VAL_25:.*]] = arith.addi %[[VAL_23]], %[[VAL_24]] : i32
+! CHECK:           %[[VAL_26:.*]] = fir.convert %[[VAL_25]] : (i32) -> i64
+! CHECK:           %[[VAL_27:.*]] = fir.rebox %[[VAL_11]](%[[VAL_14]]) : (!fir.box<!fir.ptr<!fir.array<?xi32>>>, !fir.shift<1>) -> !fir.box<!fir.ptr<!fir.array<?xi32>>>
+! CHECK:           %[[VAL_28:.*]] = arith.constant 1 : index
+! CHECK:           %[[VAL_29:.*]] = fir.load %[[VAL_4]] : !fir.ref<i32>
+! CHECK:           %[[VAL_30:.*]] = fir.convert %[[VAL_29]] : (i32) -> i64
+! CHECK:           %[[VAL_31:.*]] = fir.convert %[[VAL_30]] : (i64) -> index
+! CHECK:           %[[VAL_32:.*]] = arith.subi %[[VAL_31]], %[[VAL_28]] : index
+! CHECK:           %[[VAL_33:.*]] = fir.field_index ip, !fir.type<_QMarray_of_pointer_testTta{ip:!fir.box<!fir.ptr<!fir.array<?xi32>>>}>
+! CHECK:           %[[VAL_34:.*]] = fir.shape_shift %[[VAL_20]], %[[VAL_26]] : (i64, i64) -> !fir.shapeshift<1>
+! CHECK:           %[[VAL_35:.*]] = fir.rebox %[[VAL_27]](%[[VAL_34]]) : (!fir.box<!fir.ptr<!fir.array<?xi32>>>, !fir.shapeshift<1>) -> !fir.box<!fir.ptr<!fir.array<?xi32>>>
+! CHECK:           %[[VAL_36:.*]] = fir.array_update %[[VAL_17]], %[[VAL_35]], %[[VAL_32]], %[[VAL_33]] : (!fir.array<?x!fir.type<_QMarray_of_pointer_testTta{ip:!fir.box<!fir.ptr<!fir.array<?xi32>>>}>>, !fir.box<!fir.ptr<!fir.array<?xi32>>>, index, !fir.field) -> !fir.array<?x!fir.type<_QMarray_of_pointer_testTta{ip:!fir.box<!fir.ptr<!fir.array<?xi32>>>}>>
+! CHECK:           fir.result %[[VAL_36]] : !fir.array<?x!fir.type<_QMarray_of_pointer_testTta{ip:!fir.box<!fir.ptr<!fir.array<?xi32>>>}>>
+! CHECK:         }
+! CHECK:         fir.array_merge_store %[[VAL_10]], %[[VAL_37:.*]] to %[[VAL_0]] : !fir.array<?x!fir.type<_QMarray_of_pointer_testTta{ip:!fir.box<!fir.ptr<!fir.array<?xi32>>>}>>, !fir.array<?x!fir.type<_QMarray_of_pointer_testTta{ip:!fir.box<!fir.ptr<!fir.array<?xi32>>>}>>, !fir.box<!fir.array<?x!fir.type<_QMarray_of_pointer_testTta{ip:!fir.box<!fir.ptr<!fir.array<?xi32>>>}>>>
+! CHECK:         return
+! CHECK:       }
+
+subroutine s8_2(x,y,n)
+  use array_of_pointer_test
+  type(ta) x(:)
+  integer, TARGET :: y(:)
+  forall (i=1:n)
+!     x(i)%ip(i:) => y
+  end forall
+end subroutine s8_2
+
+subroutine s8_3(x,y,n1,n2)
+  use array_of_pointer_test
+  type(ta) x(:)
+  integer, TARGET :: y(:)
+  forall (i=1:n1)
+!     x(i)%ip(i:n2+1+i) => y
+  end forall
+end subroutine s8_3
+
+subroutine s8_4(x,y,n)
+  use array_of_pointer_test
+  type(ta) x(:)
+  integer, ALLOCATABLE, TARGET :: y(:)
+  forall (i=1:n)
+!     x(i)%ip(i:) => y
+  end forall
+end subroutine s8_4
+
+subroutine s8_5(x,y,n1,n2)
+  use array_of_pointer_test
+  type(ta) x(:)
+  integer, ALLOCATABLE, TARGET :: y(:)
+  forall (i=1:n1)
+!     x(i)%ip(i:n2+1+i) => y
+  end forall
+end subroutine s8_5

flang/test/Lower/forall/forall-2.f90

 ! RUN: bbc -emit-fir %s -o - | FileCheck %s
+! RUN: bbc %s -o - | FileCheck --check-prefix=POSTOPT %s
 
 ! CHECK-LABEL: func @_QPimplied_iters_allocatable(
 ! CHECK-SAME: %[[VAL_0:.*]]: !fir.box<!fir.array<?x!fir.type<_QFimplied_iters_allocatableTt{oui:!fir.logical<4>,arr:!fir.box<!fir.heap<!fir.array<?xf32>>>}>>>{{.*}}, %[[VAL_1:.*]]: !fir.box<!fir.array<?xf32>>{{.*}}) {
+! CHECK: return
+! CHECK: }
+
 subroutine implied_iters_allocatable(thing, a1)
   ! No dependence between lhs and rhs.
   ! Lhs may need to be reallocated to conform.
   real :: a1(:)
   type t
      logical :: oui
      real, allocatable :: arr(:)
   end type t
   type(t) :: thing(:)
   integer :: i
   
   forall (i=5:13)
-  ! commenting out this test for the moment
+  ! commenting out this test for the moment (hits assert)
   !  thing(i)%arr = a1
   end forall
-  ! CHECK: return
-  ! CHECK: }
 end subroutine implied_iters_allocatable
 
-! CHECK-LABEL: func @_QPconflicting_allocatable(
-! CHECK-SAME: %[[VAL_0:.*]]: !fir.box<!fir.array<?x!fir.type<_QFconflicting_allocatableTt{oui:!fir.logical<4>,arr:!fir.box<!fir.heap<!fir.array<?xf32>>>}>>>{{.*}}, %[[VAL_1:.*]]: !fir.ref<i32>{{.*}}, %[[VAL_2:.*]]: !fir.ref<i32>{{.*}}) {
 subroutine conflicting_allocatable(thing, lo, hi)
-  ! Introduce a crossing dependence to incite a (deep) copy.
+  ! Introduce a crossing dependence to produce copy-in/copy-out code.
   integer :: lo,hi
   type t
      logical :: oui
      real, allocatable :: arr(:)
   end type t
   type(t) :: thing(:)
   integer :: i
   
   forall (i = lo:hi)
-  ! commenting out this test for the moment
+  ! commenting out this test for the moment (hits assert)
   !  thing(i)%arr = thing(hi-i)%arr
   end forall
-  ! CHECK: return
-  ! CHECK: }
 end subroutine conflicting_allocatable
 
 ! CHECK-LABEL: func @_QPforall_pointer_assign(
-! CHECK-SAME: %[[VAL_0:.*]]: !fir.box<!fir.array<?x!fir.type<_QFforall_pointer_assignTt{ptr:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>>>{{.*}}, %[[VAL_1:.*]]: !fir.box<!fir.array<?x!fir.type<_QFforall_pointer_assignTu{targ:!fir.array<20xf32>}>>> {fir.bindc_name = "at", fir.target}, %[[VAL_2:.*]]: !fir.ref<i32>{{.*}}, %[[VAL_3:.*]]: !fir.ref<i32>{{.*}}) {
+! CHECK-SAME:    %[[VAL_0:.*]]: !fir.box<!fir.array<?x!fir.type<_QFforall_pointer_assignTt{ptr:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>>> {fir.bindc_name = "ap"}, %[[VAL_1:.*]]: !fir.ref<f32> {fir.bindc_name = "at"}, %[[VAL_2:.*]]: !fir.ref<i32> {fir.bindc_name = "ii"}, %[[VAL_3:.*]]: !fir.ref<i32> {fir.bindc_name = "ij"}) {
+! CHECK:         %[[VAL_4:.*]] = fir.alloca i32 {adapt.valuebyref, bindc_name = "i"}
+! CHECK:         %[[VAL_5:.*]] = fir.load %[[VAL_2]] : !fir.ref<i32>
+! CHECK:         %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (i32) -> index
+! CHECK:         %[[VAL_7:.*]] = fir.load %[[VAL_3]] : !fir.ref<i32>
+! CHECK:         %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (i32) -> index
+! CHECK:         %[[VAL_9:.*]] = arith.constant 8 : i32
+! CHECK:         %[[VAL_10:.*]] = fir.convert %[[VAL_9]] : (i32) -> index
+! CHECK:         %[[VAL_11:.*]] = fir.array_load %[[VAL_0]] : (!fir.box<!fir.array<?x!fir.type<_QFforall_pointer_assignTt{ptr:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>>>) -> !fir.array<?x!fir.type<_QFforall_pointer_assignTt{ptr:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>>
+! CHECK:         %[[VAL_12:.*]] = fir.array_load %[[VAL_0]] : (!fir.box<!fir.array<?x!fir.type<_QFforall_pointer_assignTt{ptr:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>>>) -> !fir.array<?x!fir.type<_QFforall_pointer_assignTt{ptr:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>>
+! CHECK:         %[[VAL_13:.*]] = fir.do_loop %[[VAL_14:.*]] = %[[VAL_6]] to %[[VAL_8]] step %[[VAL_10]] unordered iter_args(%[[VAL_15:.*]] = %[[VAL_11]]) -> (!fir.array<?x!fir.type<_QFforall_pointer_assignTt{ptr:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>>) {
+! CHECK:           %[[VAL_16:.*]] = fir.convert %[[VAL_14]] : (index) -> i32
+! CHECK:           fir.store %[[VAL_16]] to %[[VAL_4]] : !fir.ref<i32>
+! CHECK-DAG:       %[[VAL_17:.*]] = arith.constant 1 : index
+! CHECK-DAG:       %[[VAL_18:.*]] = arith.constant 1 : i32
+! CHECK-DAG:       %[[VAL_19:.*]] = fir.load %[[VAL_4]] : !fir.ref<i32>
+! CHECK:           %[[VAL_20:.*]] = arith.subi %[[VAL_19]], %[[VAL_18]] : i32
+! CHECK:           %[[VAL_21:.*]] = fir.convert %[[VAL_20]] : (i32) -> i64
+! CHECK:           %[[VAL_22:.*]] = fir.convert %[[VAL_21]] : (i64) -> index
+! CHECK:           %[[VAL_23:.*]] = arith.subi %[[VAL_22]], %[[VAL_17]] : index
+! CHECK:           %[[VAL_24:.*]] = fir.field_index ptr, !fir.type<_QFforall_pointer_assignTt{ptr:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>
+! CHECK:           %[[VAL_25:.*]] = fir.array_fetch %[[VAL_12]], %[[VAL_23]], %[[VAL_24]] : (!fir.array<?x!fir.type<_QFforall_pointer_assignTt{ptr:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>>, index, !fir.field) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
+! CHECK:           %[[VAL_26:.*]] = arith.constant 1 : index
+! CHECK:           %[[VAL_27:.*]] = fir.load %[[VAL_4]] : !fir.ref<i32>
+! CHECK:           %[[VAL_28:.*]] = fir.convert %[[VAL_27]] : (i32) -> i64
+! CHECK:           %[[VAL_29:.*]] = fir.convert %[[VAL_28]] : (i64) -> index
+! CHECK:           %[[VAL_30:.*]] = arith.subi %[[VAL_29]], %[[VAL_26]] : index
+! CHECK:           %[[VAL_31:.*]] = fir.field_index ptr, !fir.type<_QFforall_pointer_assignTt{ptr:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>
+! CHECK:           %[[VAL_32:.*]] = fir.array_update %[[VAL_15]], %[[VAL_25]], %[[VAL_30]], %[[VAL_31]] : (!fir.array<?x!fir.type<_QFforall_pointer_assignTt{ptr:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>>, !fir.box<!fir.ptr<!fir.array<?xf32>>>, index, !fir.field) -> !fir.array<?x!fir.type<_QFforall_pointer_assignTt{ptr:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>>
+! CHECK:           fir.result %[[VAL_32]] : !fir.array<?x!fir.type<_QFforall_pointer_assignTt{ptr:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>>
+! CHECK:         }
+! CHECK:         fir.array_merge_store %[[VAL_11]], %[[VAL_33:.*]] to %[[VAL_0]] : !fir.array<?x!fir.type<_QFforall_pointer_assignTt{ptr:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>>, !fir.array<?x!fir.type<_QFforall_pointer_assignTt{ptr:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>>, !fir.box<!fir.array<?x!fir.type<_QFforall_pointer_assignTt{ptr:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>>>
+! CHECK:         return
+! CHECK:       }
+
+! POSTOPT-LABEL: func @_QPforall_pointer_assign(
+! POSTOPT:         %[[VAL_15:.*]] = fir.allocmem !fir.array<?x!fir.type<_QFforall_pointer_assignTt{ptr:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>>, %{{.*}}#1
+! POSTOPT:       ^bb{{[0-9]+}}(%[[VAL_16:.*]]: index, %[[VAL_17:.*]]: index):
+! POSTOPT:       ^bb{{[0-9]+}}(%[[VAL_30:.*]]: index, %[[VAL_31:.*]]: index):
+! POSTOPT:       ^bb{{[0-9]+}}(%[[VAL_46:.*]]: index, %[[VAL_47:.*]]: index):
+! POSTOPT-NOT:   ^bb{{[0-9]+}}(%{{.*}}: index, %{{.*}}: index):
+! POSTOPT:         fir.freemem %[[VAL_15]] : !fir.heap<!fir.array<?x!fir.type<_QFforall_pointer_assignTt{ptr:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>>>
+! POSTOPT:       }
+
 subroutine forall_pointer_assign(ap, at, ii, ij)
-  ! Set pointer members in an array of derived type to targets.
-  ! No conflicts (multiple-assignment being forbidden, of course).
+  ! Set pointer members in an array of derived type of pointers to arrays.
+  ! Introduce a loop carried dependence to produce copy-in/copy-out code.
   type t
      real, pointer :: ptr(:)
   end type t
-  type u
-     real :: targ(20)
-  end type u
   type(t) :: ap(:)
-  type(u), target :: at(:)
   integer :: ii, ij
 
   forall (i = ii:ij:8)
-  ! commenting out this test for the moment
-  !   ap(i)%ptr => at(i-4)%targ
+     ap(i)%ptr => ap(i-1)%ptr
   end forall
-  ! CHECK: return
-  ! CHECK: }  
 end subroutine forall_pointer_assign
 
 ! CHECK-LABEL: func @_QPslice_with_explicit_iters() {
 ! CHECK:         %[[VAL_0:.*]] = fir.alloca i32 {adapt.valuebyref, bindc_name = "i"}
 ! CHECK:         %[[VAL_1:.*]] = arith.constant 10 : index
 ! CHECK:         %[[VAL_2:.*]] = arith.constant 10 : index
 ! CHECK:         %[[VAL_3:.*]] = fir.alloca !fir.array<10x10xi32> {bindc_name = "a", uniq_name = "_QFslice_with_explicit_itersEa"}
 ! CHECK:         %[[VAL_4:.*]] = arith.constant 1 : i32

flang/unittests/Optimizer/Builder/FIRBuilderTest.cpp

TEST_F(FIRBuilderTest, readCharLen) {
   EXPECT_EQ(strLit.getCharBox()->getLen(), len);
 }
 
 TEST_F(FIRBuilderTest, getExtents) {
   auto builder = getBuilder();
   auto loc = builder.getUnknownLoc();
   llvm::StringRef strValue("length");
   auto strLit = fir::factory::createStringLiteral(builder, loc, strValue);
-  auto ext = fir::factory::getExtents(builder, loc, strLit);
+  auto ext = fir::factory::getExtents(loc, builder, strLit);
   EXPECT_EQ(0u, ext.size());
   auto c10 = builder.createIntegerConstant(loc, builder.getI64Type(), 10);
   auto c100 = builder.createIntegerConstant(loc, builder.getI64Type(), 100);
   llvm::SmallVector<mlir::Value> extents = {c10, c100};
   fir::SequenceType::Shape shape(2, fir::SequenceType::getUnknownExtent());
   auto arrayTy = fir::SequenceType::get(shape, builder.getI64Type());
   mlir::Value array = builder.create<fir::UndefOp>(loc, arrayTy);
   fir::ArrayBoxValue aab(array, extents, {});
   fir::ExtendedValue ex(aab);
-  auto readExtents = fir::factory::getExtents(builder, loc, ex);
+  auto readExtents = fir::factory::getExtents(loc, builder, ex);
   EXPECT_EQ(2u, readExtents.size());
 }
 
 TEST_F(FIRBuilderTest, createZeroValue) {
   auto builder = getBuilder();
   auto loc = builder.getUnknownLoc();
 
   mlir::Type i64Ty = mlir::IntegerType::get(builder.getContext(), 64);
TEST_F(FIRBuilderTest, getBaseTypeOf) {
   };
 
   auto f32Ty = mlir::FloatType::getF32(builder.getContext());
   mlir::Type f32SeqTy = builder.getVarLenSeqTy(f32Ty);
   auto [f32Scalars, f32Arrays] = makeExv(f32Ty, f32SeqTy);
   for (const auto &scalar : f32Scalars) {
     EXPECT_EQ(fir::getBaseTypeOf(scalar), f32Ty);
     EXPECT_EQ(fir::getElementTypeOf(scalar), f32Ty);
-    EXPECT_FALSE(fir::isDerivedWithLengthParameters(scalar));
+    EXPECT_FALSE(fir::isDerivedWithLenParameters(scalar));
   }
   for (const auto &array : f32Arrays) {
     EXPECT_EQ(fir::getBaseTypeOf(array), f32SeqTy);
     EXPECT_EQ(fir::getElementTypeOf(array), f32Ty);
-    EXPECT_FALSE(fir::isDerivedWithLengthParameters(array));
+    EXPECT_FALSE(fir::isDerivedWithLenParameters(array));
   }
 
   auto derivedWithLengthTy =
       fir::RecordType::get(builder.getContext(), "derived_test");
 
   llvm::SmallVector<std::pair<std::string, mlir::Type>> parameters;
   llvm::SmallVector<std::pair<std::string, mlir::Type>> components;
   parameters.emplace_back("p1", builder.getI64Type());
   components.emplace_back("c1", f32Ty);
   derivedWithLengthTy.finalize(parameters, components);
   mlir::Type derivedWithLengthSeqTy =
       builder.getVarLenSeqTy(derivedWithLengthTy);
   auto [derivedWithLengthScalars, derivedWithLengthArrays] =
       makeExv(derivedWithLengthTy, derivedWithLengthSeqTy);
   for (const auto &scalar : derivedWithLengthScalars) {
     EXPECT_EQ(fir::getBaseTypeOf(scalar), derivedWithLengthTy);
     EXPECT_EQ(fir::getElementTypeOf(scalar), derivedWithLengthTy);
-    EXPECT_TRUE(fir::isDerivedWithLengthParameters(scalar));
+    EXPECT_TRUE(fir::isDerivedWithLenParameters(scalar));
   }
   for (const auto &array : derivedWithLengthArrays) {
     EXPECT_EQ(fir::getBaseTypeOf(array), derivedWithLengthSeqTy);
     EXPECT_EQ(fir::getElementTypeOf(array), derivedWithLengthTy);
-    EXPECT_TRUE(fir::isDerivedWithLengthParameters(array));
+    EXPECT_TRUE(fir::isDerivedWithLenParameters(array));
   }
 }