[flang-commits] [flang] 1bffc75 - Upstream support for POINTER assignment in FORALL.
Eric Schweitz via flang-commits
flang-commits at lists.llvm.org
Fri May 6 19:53:02 PDT 2022
Author: Eric Schweitz
Date: 2022-05-06T19:52:47-07:00
New Revision: 1bffc75383a2285e69deda90cd10860769485234
URL: https://github.com/llvm/llvm-project/commit/1bffc75383a2285e69deda90cd10860769485234
DIFF: https://github.com/llvm/llvm-project/commit/1bffc75383a2285e69deda90cd10860769485234.diff
LOG: Upstream support for POINTER assignment in FORALL.
Reviewed By: vdonaldson, PeteSteinfeld
Differential Revision: https://reviews.llvm.org/D125140
Added:
flang/test/Lower/forall/array-pointer.f90
Modified:
flang/include/flang/Lower/AbstractConverter.h
flang/include/flang/Lower/Allocatable.h
flang/include/flang/Lower/ComponentPath.h
flang/include/flang/Lower/ConvertExpr.h
flang/include/flang/Lower/Support/Utils.h
flang/include/flang/Optimizer/Builder/BoxValue.h
flang/include/flang/Optimizer/Builder/FIRBuilder.h
flang/include/flang/Optimizer/Builder/Factory.h
flang/include/flang/Optimizer/Dialect/FIRType.h
flang/include/flang/Runtime/io-api.h
flang/lib/Lower/Allocatable.cpp
flang/lib/Lower/Bridge.cpp
flang/lib/Lower/ComponentPath.cpp
flang/lib/Lower/ConvertExpr.cpp
flang/lib/Lower/IO.cpp
flang/lib/Optimizer/Builder/BoxValue.cpp
flang/lib/Optimizer/Builder/FIRBuilder.cpp
flang/lib/Optimizer/Builder/MutableBox.cpp
flang/lib/Optimizer/Dialect/FIRType.cpp
flang/test/Lower/forall/forall-2.f90
flang/unittests/Optimizer/Builder/FIRBuilderTest.cpp
Removed:
################################################################################
diff --git a/flang/include/flang/Lower/AbstractConverter.h b/flang/include/flang/Lower/AbstractConverter.h
index 3b3603376bf4a..52c9c282192a6 100644
--- a/flang/include/flang/Lower/AbstractConverter.h
+++ b/flang/include/flang/Lower/AbstractConverter.h
@@ -103,37 +103,51 @@ class AbstractConverter {
// 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.
diff --git a/flang/include/flang/Lower/Allocatable.h b/flang/include/flang/Lower/Allocatable.h
index 8fb95a506e348..a54daad953fa5 100644
--- a/flang/include/flang/Lower/Allocatable.h
+++ b/flang/include/flang/Lower/Allocatable.h
@@ -13,6 +13,7 @@
#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"
@@ -23,55 +24,55 @@ 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 &);
-
-} // namespace Fortran::lower
+/// 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);
+
+/// 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
diff --git a/flang/include/flang/Lower/ComponentPath.h b/flang/include/flang/Lower/ComponentPath.h
index 951474287f33a..dc5cfa4d24b4d 100644
--- a/flang/include/flang/Lower/ComponentPath.h
+++ b/flang/include/flang/Lower/ComponentPath.h
@@ -27,8 +27,7 @@ class ImplicitSubscripts {};
using PathComponent =
std::variant<const evaluate::ArrayRef *, const evaluate::Component *,
- const Fortran::evaluate::ComplexPart *,
- details::ImplicitSubscripts>;
+ const evaluate::ComplexPart *, details::ImplicitSubscripts>;
/// Collection of components.
///
@@ -37,6 +36,8 @@ using PathComponent =
/// 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) {
@@ -44,10 +45,15 @@ class ComponentPath {
}
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;
@@ -57,6 +63,13 @@ class ComponentPath {
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);
};
diff --git a/flang/include/flang/Lower/ConvertExpr.h b/flang/include/flang/Lower/ConvertExpr.h
index 773f06a23deeb..66f43904ead8c 100644
--- a/flang/include/flang/Lower/ConvertExpr.h
+++ b/flang/include/flang/Lower/ConvertExpr.h
@@ -164,22 +164,6 @@ void createAnyMaskedArrayAssignment(AbstractConverter &converter,
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.
@@ -190,6 +174,17 @@ void createAllocatableArrayAssignment(AbstractConverter &converter,
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,
diff --git a/flang/include/flang/Lower/Support/Utils.h b/flang/include/flang/Lower/Support/Utils.h
index e98308ebb232a..8ddb00a03f4b1 100644
--- a/flang/include/flang/Lower/Support/Utils.h
+++ b/flang/include/flang/Lower/Support/Utils.h
@@ -79,4 +79,17 @@ ignoreEvConvert(const Fortran::evaluate::Expr<Fortran::evaluate::Type<
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
diff --git a/flang/include/flang/Optimizer/Builder/BoxValue.h b/flang/include/flang/Optimizer/Builder/BoxValue.h
index 55aaa6da69ff3..b2f6ea8aa2b12 100644
--- a/flang/include/flang/Optimizer/Builder/BoxValue.h
+++ b/flang/include/flang/Optimizer/Builder/BoxValue.h
@@ -25,8 +25,8 @@
namespace fir {
class FirOpBuilder;
+class ArrayLoadOp;
-class CharBoxValue;
class ArrayBoxValue;
class BoxValue;
class CharBoxValue;
@@ -61,9 +61,9 @@ class AbstractBox {
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:
@@ -239,18 +239,20 @@ class AbstractIrBox : public AbstractBox, public AbstractArrayBox {
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());
}
};
@@ -259,7 +261,7 @@ class AbstractIrBox : public AbstractBox, public AbstractArrayBox {
/// 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:
@@ -287,7 +289,7 @@ class BoxValue : public AbstractIrBox {
// 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.
@@ -301,8 +303,8 @@ class BoxValue : public AbstractIrBox {
// 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;
};
@@ -318,7 +320,7 @@ class MutableProperties {
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
@@ -333,9 +335,9 @@ class MutableProperties {
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(),
@@ -343,7 +345,7 @@ class MutableBoxValue : public AbstractIrBox {
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>>");
}
@@ -359,9 +361,9 @@ class MutableBoxValue : public AbstractIrBox {
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 &);
@@ -378,8 +380,8 @@ class MutableBoxValue : public AbstractIrBox {
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
@@ -411,14 +413,36 @@ 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
@@ -507,10 +531,9 @@ 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
diff --git a/flang/include/flang/Optimizer/Builder/FIRBuilder.h b/flang/include/flang/Optimizer/Builder/FIRBuilder.h
index f899a0e8cd662..ab5b9317f71df 100644
--- a/flang/include/flang/Optimizer/Builder/FIRBuilder.h
+++ b/flang/include/flang/Optimizer/Builder/FIRBuilder.h
@@ -426,12 +426,6 @@ 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
@@ -440,8 +434,8 @@ llvm::SmallVector<mlir::Value> getExtents(fir::FirOpBuilder &builder,
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);
diff --git a/flang/include/flang/Optimizer/Builder/Factory.h b/flang/include/flang/Optimizer/Builder/Factory.h
index 68dd9afe119a0..ec294d26ac961 100644
--- a/flang/include/flang/Optimizer/Builder/Factory.h
+++ b/flang/include/flang/Optimizer/Builder/Factory.h
@@ -144,26 +144,30 @@ void genCharacterCopy(mlir::Value src, mlir::Value srcLen, mlir::Value dst,
/// 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()};
diff --git a/flang/include/flang/Optimizer/Dialect/FIRType.h b/flang/include/flang/Optimizer/Dialect/FIRType.h
index 70ad63d4e1db9..956ec218ec532 100644
--- a/flang/include/flang/Optimizer/Dialect/FIRType.h
+++ b/flang/include/flang/Optimizer/Dialect/FIRType.h
@@ -65,15 +65,14 @@ inline bool isa_ref_type(mlir::Type t) {
/// 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
@@ -88,8 +87,7 @@ 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
@@ -102,13 +100,12 @@ 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);
@@ -121,7 +118,7 @@ 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.
@@ -193,6 +190,20 @@ inline mlir::Type unwrapPassByRefType(mlir::Type t) {
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) {
@@ -224,6 +235,10 @@ 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);
diff --git a/flang/include/flang/Runtime/io-api.h b/flang/include/flang/Runtime/io-api.h
index 2b0005f467399..5bdede744aa39 100644
--- a/flang/include/flang/Runtime/io-api.h
+++ b/flang/include/flang/Runtime/io-api.h
@@ -248,9 +248,7 @@ 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 &);
diff --git a/flang/lib/Lower/Allocatable.cpp b/flang/lib/Lower/Allocatable.cpp
index 4a622caafebae..4023552c6a9cf 100644
--- a/flang/lib/Lower/Allocatable.cpp
+++ b/flang/lib/Lower/Allocatable.cpp
@@ -13,6 +13,7 @@
#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"
@@ -58,12 +59,12 @@ struct ErrorManager {
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())));
@@ -343,7 +344,7 @@ class AllocateStmtHelper {
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;
@@ -351,7 +352,7 @@ class AllocateStmtHelper {
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);
@@ -404,11 +405,11 @@ class AllocateStmtHelper {
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
@@ -438,7 +439,7 @@ class AllocateStmtHelper {
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)));
}
}
}
@@ -526,8 +527,8 @@ static void genDeallocate(fir::FirOpBuilder &builder, mlir::Location loc,
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{
@@ -671,8 +672,8 @@ fir::MutableBoxValue Fortran::lower::createMutableBox(
// 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);
@@ -687,12 +688,28 @@ void Fortran::lower::associateMutableBox(
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;
+}
diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index cb3b8ce7888b1..a5d456d82518b 100644
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -373,16 +373,12 @@ class FirConverter : public Fortran::lower::AbstractConverter {
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 {
@@ -441,8 +437,8 @@ class FirConverter : public Fortran::lower::AbstractConverter {
// 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);
@@ -459,7 +455,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
},
[&](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);
});
@@ -1598,7 +1594,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
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);
@@ -1850,9 +1846,16 @@ class FirConverter : public Fortran::lower::AbstractConverter {
/// 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(
@@ -1861,6 +1864,17 @@ class FirConverter : public Fortran::lower::AbstractConverter {
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.
@@ -1885,13 +1899,6 @@ class FirConverter : public Fortran::lower::AbstractConverter {
: 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 =
@@ -1900,10 +1907,10 @@ class FirConverter : public Fortran::lower::AbstractConverter {
}
#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.
@@ -1929,7 +1936,8 @@ class FirConverter : public Fortran::lower::AbstractConverter {
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
@@ -1950,7 +1958,8 @@ class FirConverter : public Fortran::lower::AbstractConverter {
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 {
@@ -1959,7 +1968,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
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(
@@ -2023,7 +2032,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
// [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();
@@ -2034,23 +2043,19 @@ class FirConverter : public Fortran::lower::AbstractConverter {
(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
@@ -2066,14 +2071,6 @@ class FirConverter : public Fortran::lower::AbstractConverter {
(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,
@@ -2086,9 +2083,22 @@ class FirConverter : public Fortran::lower::AbstractConverter {
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);
@@ -2096,11 +2106,8 @@ class FirConverter : public Fortran::lower::AbstractConverter {
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);
- }
}
},
},
@@ -2349,7 +2356,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
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.
diff --git a/flang/lib/Lower/ComponentPath.cpp b/flang/lib/Lower/ComponentPath.cpp
index f06c72c249187..f6ba5f6c0769b 100644
--- a/flang/lib/Lower/ComponentPath.cpp
+++ b/flang/lib/Lower/ComponentPath.cpp
@@ -48,6 +48,15 @@ bool Fortran::lower::isRankedArrayAccess(const Fortran::evaluate::ArrayRef &x) {
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; };
}
diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp
index c822ed0a2451e..0418740d890bc 100644
--- a/flang/lib/Lower/ConvertExpr.cpp
+++ b/flang/lib/Lower/ConvertExpr.cpp
@@ -46,6 +46,7 @@
#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"
@@ -211,7 +212,8 @@ 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);
@@ -235,39 +237,56 @@ arrayLoadExtValue(fir::FirOpBuilder &builder, mlir::Location loc,
arrTy = ty.cast<fir::SequenceType>();
}
+ auto arrayToExtendedValue =
+ [&](const llvm::SmallVector<mlir::Value> &extents,
+ const llvm::SmallVector<mlir::Value> &origins) -> fir::ExtendedValue {
+ mlir::Type eleTy = fir::unwrapSequenceType(arrTy);
+ 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);
+ };
// 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 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);
+ // 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, "component is boxed, retreive its type parameters");
+ 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
@@ -304,7 +323,7 @@ createInMemoryScalarCopy(fir::FirOpBuilder &builder, mlir::Location loc,
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);
@@ -2281,7 +2300,7 @@ class ScalarExprLowering {
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;
@@ -2605,7 +2624,7 @@ class ScalarExprLowering {
[&](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
@@ -2711,6 +2730,167 @@ class ScalarExprLowering {
.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 ©OutPairs, 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) {
@@ -2792,8 +2972,7 @@ class ScalarExprLowering {
/*nonDeferredParams=*/mlir::ValueRange{},
/*mutableProperties=*/{});
Fortran::lower::associateMutableBox(converter, loc, pointer, *expr,
- /*lbounds*/ mlir::ValueRange{},
- stmtCtx);
+ /*lbounds=*/llvm::None, stmtCtx);
caller.placeInput(arg, irBox);
continue;
}
@@ -3350,8 +3529,8 @@ class ArrayExprLowering {
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);
}
@@ -3406,6 +3585,50 @@ class ArrayExprLowering {
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
//===--------------------------------------------------------------------===//
@@ -3437,7 +3660,7 @@ class ArrayExprLowering {
// 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);
@@ -3451,7 +3674,7 @@ class ArrayExprLowering {
// 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
@@ -3466,8 +3689,7 @@ class ArrayExprLowering {
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 =
@@ -3507,6 +3729,7 @@ class ArrayExprLowering {
}
ExtValue lowerBoxedArrayExpr(const Fortran::lower::SomeExpr &exp) {
+ PushSemantics(ConstituentSemantics::BoxValue);
return std::visit(
[&](const auto &e) {
auto f = genarr(e);
@@ -3703,12 +3926,12 @@ class ArrayExprLowering {
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);
@@ -3723,15 +3946,12 @@ class ArrayExprLowering {
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;
}
@@ -3793,7 +4013,7 @@ class ArrayExprLowering {
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) {
@@ -3832,7 +4052,7 @@ class ArrayExprLowering {
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{
@@ -3913,6 +4133,36 @@ class ArrayExprLowering {
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
@@ -3951,7 +4201,7 @@ class ArrayExprLowering {
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());
@@ -4014,9 +4264,7 @@ class ArrayExprLowering {
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.
@@ -4300,8 +4548,8 @@ class ArrayExprLowering {
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();
@@ -4429,7 +4677,9 @@ class ArrayExprLowering {
/// 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.
@@ -5329,10 +5579,9 @@ class ArrayExprLowering {
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;
@@ -6400,6 +6649,20 @@ class ArrayExprLowering {
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.
//
@@ -6419,11 +6682,17 @@ class ArrayExprLowering {
auto &revPath = components.reversePath;
ty = fir::unwrapPassByRefType(ty);
bool prefix = true;
- auto addComponent = [&](mlir::Value v) {
- if (prefix)
- components.prefixComponents.push_back(v);
- else
- components.suffixComponents.push_back(v);
+ 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 {
+ for (auto v : vals)
+ components.suffixComponents.push_back(v);
+ }
};
mlir::IndexType idxTy = builder.getIndexType();
mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1);
@@ -6431,6 +6700,7 @@ class ArrayExprLowering {
auto saveSemant = semant;
if (isProjectedCopyInCopyOut())
semant = ConstituentSemantics::RefTransparent;
+ unsigned index = 0;
for (const auto &v : llvm::reverse(revPath)) {
std::visit(
Fortran::common::visitors{
@@ -6450,10 +6720,12 @@ class ArrayExprLowering {
[&](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{
@@ -6483,7 +6755,7 @@ class ArrayExprLowering {
mlir::Value ivAdj =
builder.create<mlir::arith::SubIOp>(
loc, idxTy, val, lb);
- addComponent(
+ componentsToAdd.push_back(
builder.createConvert(loc, idxTy, ivAdj));
},
[&](const auto &) {
@@ -6494,20 +6766,47 @@ class ArrayExprLowering {
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());
- 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);
+ 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));
+ extendComponent(components, ty, {fld});
+ } else {
+ TODO(loc, "other component type");
+ }
}},
v);
atBase = false;
+ ++index;
}
semant = saveSemant;
ty = fir::unwrapSequenceType(ty);
@@ -6531,12 +6830,10 @@ class ArrayExprLowering {
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()) {
@@ -6555,7 +6852,8 @@ class ArrayExprLowering {
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);
@@ -6565,11 +6863,38 @@ class ArrayExprLowering {
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)); };
@@ -6612,14 +6937,46 @@ class ArrayExprLowering {
}
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
diff erent 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>
@@ -6664,9 +7021,19 @@ class ArrayExprLowering {
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);
@@ -6685,7 +7052,8 @@ class ArrayExprLowering {
/// 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);
@@ -6835,6 +7203,23 @@ class ArrayExprLowering {
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;
@@ -6857,6 +7242,10 @@ class ArrayExprLowering {
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;
@@ -6981,6 +7370,25 @@ void Fortran::lower::createAllocatableArrayAssignment(
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,
diff --git a/flang/lib/Lower/IO.cpp b/flang/lib/Lower/IO.cpp
index 679452854e071..75f23927c69b0 100644
--- a/flang/lib/Lower/IO.cpp
+++ b/flang/lib/Lower/IO.cpp
@@ -31,6 +31,7 @@
#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"
@@ -80,6 +81,7 @@ static constexpr std::tuple<
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),
@@ -87,18 +89,15 @@ static constexpr std::tuple<
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)>
@@ -113,10 +112,11 @@ namespace {
/// 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; }
@@ -129,7 +129,7 @@ struct ConditionSpecInfo {
/// Check for any condition specifier, including IOMSG.
bool hasAnyConditionSpec() const {
- return hasTransferConditionSpec() || ioMsgExpr != nullptr;
+ return hasTransferConditionSpec() || ioMsg;
}
};
} // namespace
@@ -138,7 +138,7 @@ 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>
@@ -162,7 +162,7 @@ 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());
@@ -176,35 +176,38 @@ static mlir::func::FuncOp getIORuntimeFunc(mlir::Location loc,
/// 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`.
@@ -420,10 +423,8 @@ static mlir::func::FuncOp getOutputFunc(mlir::Location loc,
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");
}
@@ -458,39 +459,37 @@ static mlir::func::FuncOp getOutputFunc(mlir::Location loc,
}
/// 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())
@@ -501,7 +500,7 @@ genOutputItemList(Fortran::lower::AbstractConverter &converter,
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 =
@@ -609,25 +608,25 @@ 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>();
@@ -653,11 +652,10 @@ static void genInputItemList(Fortran::lower::AbstractConverter &converter,
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);
}
}
@@ -667,14 +665,16 @@ 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));
@@ -687,13 +687,12 @@ static void genIoLoop(Fortran::lower::AbstractConverter &converter,
? 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.
@@ -701,8 +700,8 @@ static void genIoLoop(Fortran::lower::AbstractConverter &converter,
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());
@@ -711,7 +710,7 @@ static void genIoLoop(Fortran::lower::AbstractConverter &converter,
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;
@@ -722,8 +721,9 @@ static void genIoLoop(Fortran::lower::AbstractConverter &converter,
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()),
+ iterWhileOp.getInductionVar());
builder.create<fir::StoreOp>(loc, lcv, loopVar);
ok = iterWhileOp.getIterateVar();
mlir::Value falseValue =
@@ -756,7 +756,7 @@ static void genIoLoop(Fortran::lower::AbstractConverter &converter,
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);
}
@@ -874,10 +874,10 @@ mlir::Value genIntIOOption(Fortran::lower::AbstractConverter &converter,
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);
@@ -891,7 +891,7 @@ mlir::Value genCharIOOption(Fortran::lower::AbstractConverter &converter,
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,
@@ -923,7 +923,7 @@ mlir::Value genIOOption<Fortran::parser::FileNameExpr>(
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,
@@ -1094,14 +1094,13 @@ static void genIOReadSize(Fortran::lower::AbstractConverter &converter,
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);
@@ -1170,10 +1169,10 @@ static void threadSpecs(Fortran::lower::AbstractConverter &converter,
/// 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{
@@ -1187,13 +1186,13 @@ genConditionHandlerCall(Fortran::lower::AbstractConverter &converter,
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));
},
@@ -1203,11 +1202,24 @@ genConditionHandlerCall(Fortran::lower::AbstractConverter &converter,
[](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>(
@@ -1218,7 +1230,7 @@ genConditionHandlerCall(Fortran::lower::AbstractConverter &converter,
boolValue(csi.hasErr),
boolValue(csi.hasEnd),
boolValue(csi.hasEor),
- boolValue(csi.ioMsgExpr != nullptr)};
+ boolValue(csi.ioMsg.hasValue())};
builder.create<fir::CallOp>(loc, enableHandlers, ioArgs);
}
@@ -1437,7 +1449,7 @@ lowerReferenceAsStringSelect(Fortran::lower::AbstractConverter &converter,
// 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);
@@ -1524,34 +1536,85 @@ getBuffer(Fortran::lower::AbstractConverter &converter, mlir::Location loc,
llvm::report_fatal_error("failed to get IoUnit expr in lowering");
}
+static mlir::Value genIOUnitNumber(Fortran::lower::AbstractConverter &converter,
+ mlir::Location loc,
+ const Fortran::lower::SomeExpr *iounit,
+ mlir::Type ty, ConditionSpecInfo &csi,
+ Fortran::lower::StatementContext &stmtCtx) {
+ auto &builder = converter.getFirOpBuilder();
+ 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,
+ const Fortran::parser::IoUnit *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);
- }
+ 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,
- mlir::Location loc, const A &stmt, mlir::Type ty,
- 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));
+static mlir::Value getIOUnit(Fortran::lower::AbstractConverter &converter,
+ mlir::Location loc, const A &stmt, mlir::Type ty,
+ ConditionSpecInfo &csi,
+ Fortran::lower::StatementContext &stmtCtx) {
+ 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.
//===----------------------------------------------------------------------===//
@@ -1562,17 +1625,18 @@ static mlir::Value genBasicIOStmt(Fortran::lower::AbstractConverter &converter,
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();
@@ -1615,13 +1679,12 @@ genNewunitSpec(Fortran::lower::AbstractConverter &converter, mlir::Location loc,
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};
@@ -1638,14 +1701,15 @@ Fortran::lower::genOpenStatement(Fortran::lower::AbstractConverter &converter,
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 {
@@ -1658,7 +1722,6 @@ Fortran::lower::genOpenStatement(Fortran::lower::AbstractConverter &converter,
}
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();
@@ -1681,22 +1744,22 @@ Fortran::lower::genWaitStatement(Fortran::lower::AbstractConverter &converter,
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)
- : getIORuntimeFunc<mkIOKey(BeginWaitAll)>(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);
@@ -1779,7 +1842,7 @@ void genBeginDataTransferCallArgs(
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 = [&]() {
@@ -1812,12 +1875,14 @@ void genBeginDataTransferCallArgs(
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();
@@ -1849,19 +1914,23 @@ genDataTransferStmt(Fortran::lower::AbstractConverter &converter,
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,
- isInternalWithDesc, isAsync);
+ 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) {
@@ -1879,8 +1948,7 @@ genDataTransferStmt(Fortran::lower::AbstractConverter &converter,
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,
@@ -1890,11 +1958,11 @@ genDataTransferStmt(Fortran::lower::AbstractConverter &converter,
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();
@@ -1966,12 +2034,11 @@ mlir::Value genInquireSpec<Fortran::parser::InquireSpec::CharVar>(
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(
@@ -1996,12 +2063,11 @@ mlir::Value genInquireSpec<Fortran::parser::InquireSpec::IntVar>(
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,
@@ -2033,15 +2099,16 @@ mlir::Value genInquireSpec<Fortran::parser::InquireSpec::LogVar>(
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)
@@ -2069,7 +2136,7 @@ lowerIdExpr(Fortran::lower::AbstractConverter &converter, mlir::Location loc,
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))
@@ -2102,7 +2169,6 @@ mlir::Value Fortran::lower::genInquireStatement(
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);
@@ -2114,22 +2180,24 @@ mlir::Value Fortran::lower::genInquireStatement(
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)),
@@ -2150,12 +2218,11 @@ mlir::Value Fortran::lower::genInquireStatement(
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
diff --git a/flang/lib/Optimizer/Builder/BoxValue.cpp b/flang/lib/Optimizer/Builder/BoxValue.cpp
index 951bc3e18bc49..52c7fea058c11 100644
--- a/flang/lib/Optimizer/Builder/BoxValue.cpp
+++ b/flang/lib/Optimizer/Builder/BoxValue.cpp
@@ -222,10 +222,11 @@ bool fir::BoxValue::verify() const {
/// 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,
- fir::FirOpBuilder &builder,
- mlir::Location loc, unsigned dim) {
- auto extents = fir::factory::getExtents(builder, loc, exv);
+mlir::Value fir::factory::getExtentAtDimension(mlir::Location loc,
+ fir::FirOpBuilder &builder,
+ const fir::ExtendedValue &exv,
+ unsigned dim) {
+ auto extents = fir::factory::getExtents(loc, builder, exv);
if (dim < extents.size())
return extents[dim];
return {};
diff --git a/flang/lib/Optimizer/Builder/FIRBuilder.cpp b/flang/lib/Optimizer/Builder/FIRBuilder.cpp
index 6c12c515c2c50..6f62b5413ccdf 100644
--- a/flang/lib/Optimizer/Builder/FIRBuilder.cpp
+++ b/flang/lib/Optimizer/Builder/FIRBuilder.cpp
@@ -649,7 +649,7 @@ fir::factory::readExtents(fir::FirOpBuilder &builder, mlir::Location loc,
}
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> {
@@ -663,7 +663,7 @@ fir::factory::getExtents(fir::FirOpBuilder &builder, mlir::Location loc,
},
[&](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 {}; });
}
@@ -683,7 +683,7 @@ fir::ExtendedValue fir::factory::readBoxValue(fir::FirOpBuilder &builder,
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;
@@ -731,6 +731,71 @@ fir::factory::getNonDeferredLengthParams(const fir::ExtendedValue &exv) {
[&](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
@@ -886,7 +951,7 @@ fir::ExtendedValue fir::factory::arrayElementToExtendedValue(
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;
},
diff --git a/flang/lib/Optimizer/Builder/MutableBox.cpp b/flang/lib/Optimizer/Builder/MutableBox.cpp
index a9d86474a94d7..c3eea0b59ab05 100644
--- a/flang/lib/Optimizer/Builder/MutableBox.cpp
+++ b/flang/lib/Optimizer/Builder/MutableBox.cpp
@@ -66,7 +66,7 @@ static mlir::Value createNewFirBox(fir::FirOpBuilder &builder,
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;
}
@@ -164,7 +164,7 @@ class MutablePropertyReader {
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();
}
@@ -306,7 +306,7 @@ class MutablePropertyWriter {
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;
@@ -496,12 +496,12 @@ void fir::factory::associateMutableBox(fir::FirOpBuilder &builder,
// 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);
@@ -593,7 +593,7 @@ void fir::factory::associateMutableBoxWithRemap(
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);
@@ -745,7 +745,7 @@ fir::factory::genReallocIfNeeded(fir::FirOpBuilder &builder, mlir::Location loc,
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");
}
@@ -808,7 +808,7 @@ fir::factory::genReallocIfNeeded(fir::FirOpBuilder &builder, mlir::Location loc,
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};
@@ -834,12 +834,12 @@ void fir::factory::finalizeRealloc(fir::FirOpBuilder &builder,
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); })
diff --git a/flang/lib/Optimizer/Dialect/FIRType.cpp b/flang/lib/Optimizer/Dialect/FIRType.cpp
index 559b34edfef38..834173be2dd81 100644
--- a/flang/lib/Optimizer/Dialect/FIRType.cpp
+++ b/flang/lib/Optimizer/Dialect/FIRType.cpp
@@ -263,6 +263,14 @@ bool isAllocatableType(mlir::Type ty) {
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()) {
@@ -276,6 +284,28 @@ bool isRecordWithAllocatableMember(mlir::Type ty) {
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 {
diff --git a/flang/test/Lower/forall/array-pointer.f90 b/flang/test/Lower/forall/array-pointer.f90
new file mode 100644
index 0000000000000..3b36544ef43d1
--- /dev/null
+++ b/flang/test/Lower/forall/array-pointer.f90
@@ -0,0 +1,816 @@
+! 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
diff --git a/flang/test/Lower/forall/forall-2.f90 b/flang/test/Lower/forall/forall-2.f90
index bb8f639f11fe0..9f4ff6ed6c2e6 100644
--- a/flang/test/Lower/forall/forall-2.f90
+++ b/flang/test/Lower/forall/forall-2.f90
@@ -1,7 +1,11 @@
! 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.
@@ -14,17 +18,13 @@ subroutine implied_iters_allocatable(thing, a1)
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
@@ -34,34 +34,68 @@ subroutine conflicting_allocatable(thing, lo, hi)
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() {
diff --git a/flang/unittests/Optimizer/Builder/FIRBuilderTest.cpp b/flang/unittests/Optimizer/Builder/FIRBuilderTest.cpp
index 77ec88c1c340a..64827e097cf0b 100644
--- a/flang/unittests/Optimizer/Builder/FIRBuilderTest.cpp
+++ b/flang/unittests/Optimizer/Builder/FIRBuilderTest.cpp
@@ -404,7 +404,7 @@ TEST_F(FIRBuilderTest, getExtents) {
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);
@@ -414,7 +414,7 @@ TEST_F(FIRBuilderTest, getExtents) {
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());
}
@@ -497,12 +497,12 @@ TEST_F(FIRBuilderTest, getBaseTypeOf) {
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 =
@@ -520,11 +520,11 @@ TEST_F(FIRBuilderTest, getBaseTypeOf) {
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));
}
}
More information about the flang-commits
mailing list