diff --git a/flang/include/flang/Lower/FIRBuilder.h b/flang/include/flang/Lower/FIRBuilder.h --- a/flang/include/flang/Lower/FIRBuilder.h +++ b/flang/include/flang/Lower/FIRBuilder.h @@ -26,8 +26,8 @@ #include "llvm/ADT/Optional.h" namespace Fortran::lower { - class AbstractConverter; +class BoxValue; //===----------------------------------------------------------------------===// // FirOpBuilder diff --git a/flang/include/flang/Optimizer/Builder/FIRBuilder.h b/flang/include/flang/Optimizer/Builder/FIRBuilder.h --- a/flang/include/flang/Optimizer/Builder/FIRBuilder.h +++ b/flang/include/flang/Optimizer/Builder/FIRBuilder.h @@ -23,7 +23,9 @@ #include "mlir/IR/BuiltinOps.h" namespace fir { +class AbstractArrayBox; class ExtendedValue; +class BoxValue; //===----------------------------------------------------------------------===// // FirOpBuilder @@ -241,6 +243,16 @@ return createFunction(loc, module, name, ty); } + /// Construct one of the two forms of shape op from an array box. + mlir::Value genShape(mlir::Location loc, const fir::AbstractArrayBox &arr); + mlir::Value genShape(mlir::Location loc, llvm::ArrayRef shift, + llvm::ArrayRef exts); + mlir::Value genShape(mlir::Location loc, llvm::ArrayRef exts); + + /// Create one of the shape ops given an extended value. For a boxed value, + /// this may create a `fir.shift` op. + mlir::Value createShape(mlir::Location loc, const fir::ExtendedValue &exv); + /// Create constant i1 with value 1. if \p b is true or 0. otherwise mlir::Value createBool(mlir::Location loc, bool b) { return createIntegerConstant(loc, getIntegerType(1), b ? 1 : 0); @@ -322,6 +334,28 @@ namespace fir::factory { +//===----------------------------------------------------------------------===// +// ExtendedValue inquiry helpers +//===----------------------------------------------------------------------===// + +/// Read or get character length from \p box that must contain a character +/// entity. If the length value is contained in the ExtendedValue, this will +/// not generate any code, otherwise this will generate a read of the fir.box +/// describing the entity. +mlir::Value readCharLen(fir::FirOpBuilder &builder, mlir::Location loc, + const fir::ExtendedValue &box); + +/// Read extents from \p box. +llvm::SmallVector 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 getExtents(fir::FirOpBuilder &builder, + mlir::Location loc, + const fir::ExtendedValue &box); + //===----------------------------------------------------------------------===// // String literal helper helpers //===----------------------------------------------------------------------===// diff --git a/flang/include/flang/Optimizer/Builder/MutableBox.h b/flang/include/flang/Optimizer/Builder/MutableBox.h new file mode 100644 --- /dev/null +++ b/flang/include/flang/Optimizer/Builder/MutableBox.h @@ -0,0 +1,138 @@ +//===-- MutableBox.h -- MutableBox utilities -----------------------------===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// +// +// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/ +// +//===----------------------------------------------------------------------===// + +#ifndef FORTRAN_OPTIMIZER_BUILDER_MUTABLEBOX_H +#define FORTRAN_OPTIMIZER_BUILDER_MUTABLEBOX_H + +#include "llvm/ADT/StringRef.h" + +namespace mlir { +class Value; +class ValueRange; +class Type; +class Location; +} // namespace mlir + +namespace fir { +class FirOpBuilder; +class MutableBoxValue; +class ExtendedValue; +} // namespace fir + +namespace fir::factory { + +/// Create a fir.box of type \p boxType that can be used to initialize an +/// allocatable variable. Initialization of such variable has to be done at the +/// beginning of the variable lifetime by storing the created box in the memory +/// for the variable box. +/// \p nonDeferredParams must provide the non deferred length parameters so that +/// they can already be placed in the unallocated box (inquiries about these +/// parameters are legal even in unallocated state). +mlir::Value createUnallocatedBox(fir::FirOpBuilder &builder, mlir::Location loc, + mlir::Type boxType, + mlir::ValueRange nonDeferredParams); + +/// Create a MutableBoxValue for a temporary allocatable. +/// The created MutableBoxValue wraps a fir.ref>> and is +/// initialized to unallocated/diassociated status. An optional name can be +/// given to the created !fir.ref. +fir::MutableBoxValue createTempMutableBox(fir::FirOpBuilder &builder, + mlir::Location loc, mlir::Type type, + llvm::StringRef name = {}); + +/// Update a MutableBoxValue to describe entity \p source (that must be in +/// memory). 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(fir::FirOpBuilder &builder, mlir::Location loc, + const fir::MutableBoxValue &box, + const fir::ExtendedValue &source, + mlir::ValueRange lbounds); + +/// Update a MutableBoxValue to describe entity \p source (that must be in +/// memory) with a new array layout given by \p lbounds and \p ubounds. +/// \p source must be known to be contiguous at compile time, or it must have +/// rank 1 (constraint from Fortran 2018 standard 10.2.2.3 point 9). +void associateMutableBoxWithRemap(fir::FirOpBuilder &builder, + mlir::Location loc, + const fir::MutableBoxValue &box, + const fir::ExtendedValue &source, + mlir::ValueRange lbounds, + mlir::ValueRange ubounds); + +/// Set the association status of a MutableBoxValue to +/// disassociated/unallocated. Nothing is done with the entity that was +/// previously associated/allocated. The function generates code that sets the +/// address field of the MutableBoxValue to zero. +void disassociateMutableBox(fir::FirOpBuilder &builder, mlir::Location loc, + const fir::MutableBoxValue &box); + +/// Generate code to conditionally reallocate a MutableBoxValue with a new +/// shape, lower bounds, and length parameters if it is unallocated or if its +/// current shape or deferred length parameters do not match the provided ones. +/// Lower bounds are only used if the entity needs to be allocated, otherwise, +/// the MutableBoxValue will keep its current lower bounds. +/// If the MutableBoxValue is an array, the provided shape can be empty, in +/// which case the MutableBoxValue must already be allocated at runtime and its +/// shape and lower bounds will be kept. If \p shape is empty, only a length +/// parameter mismatch can trigger a reallocation. See Fortran 10.2.1.3 point 3 +/// that this function is implementing for more details. The polymorphic +/// requirements are not yet covered by this function. +void genReallocIfNeeded(fir::FirOpBuilder &builder, mlir::Location loc, + const fir::MutableBoxValue &box, + mlir::ValueRange lbounds, mlir::ValueRange shape, + mlir::ValueRange lengthParams); + +/// Finalize a mutable box if it is allocated or associated. This includes both +/// calling the finalizer, if any, and deallocating the storage. +void genFinalization(fir::FirOpBuilder &builder, mlir::Location loc, + const fir::MutableBoxValue &box); + +void genInlinedAllocation(fir::FirOpBuilder &builder, mlir::Location loc, + const fir::MutableBoxValue &box, + mlir::ValueRange lbounds, mlir::ValueRange extents, + mlir::ValueRange lenParams, + llvm::StringRef allocName); + +void genInlinedDeallocate(fir::FirOpBuilder &builder, mlir::Location loc, + const fir::MutableBoxValue &box); + +/// When the MutableBoxValue was passed as a fir.ref to a call that may +/// have modified it, update the MutableBoxValue according to the +/// fir.ref value. +void syncMutableBoxFromIRBox(fir::FirOpBuilder &builder, mlir::Location loc, + const fir::MutableBoxValue &box); + +/// Read all mutable properties into a normal symbol box. +/// It is OK to call this on unassociated/unallocated boxes but any use of the +/// resulting values will be undefined (only the base address will be guaranteed +/// to be null). +fir::ExtendedValue genMutableBoxRead(fir::FirOpBuilder &builder, + mlir::Location loc, + const fir::MutableBoxValue &box, + bool mayBePolymorphic = true); + +/// Returns the fir.ref> of a MutableBoxValue filled with the current +/// association / allocation properties. If the fir.ref already exists +/// and is-up to date, this is a no-op, otherwise, code will be generated to +/// fill it. +mlir::Value getMutableIRBox(fir::FirOpBuilder &builder, mlir::Location loc, + const fir::MutableBoxValue &box); + +/// Generate allocation or association status test and returns the resulting +/// i1. This is testing this for a valid/non-null base address value. +mlir::Value genIsAllocatedOrAssociatedTest(fir::FirOpBuilder &builder, + mlir::Location loc, + const fir::MutableBoxValue &box); + +} // namespace fir::factory + +#endif // FORTRAN_OPTIMIZER_BUILDER_MUTABLEBOX_H diff --git a/flang/lib/Optimizer/Builder/CMakeLists.txt b/flang/lib/Optimizer/Builder/CMakeLists.txt --- a/flang/lib/Optimizer/Builder/CMakeLists.txt +++ b/flang/lib/Optimizer/Builder/CMakeLists.txt @@ -5,6 +5,7 @@ Character.cpp DoLoopHelper.cpp FIRBuilder.cpp + MutableBox.cpp DEPENDS FIRDialect diff --git a/flang/lib/Optimizer/Builder/FIRBuilder.cpp b/flang/lib/Optimizer/Builder/FIRBuilder.cpp --- a/flang/lib/Optimizer/Builder/FIRBuilder.cpp +++ b/flang/lib/Optimizer/Builder/FIRBuilder.cpp @@ -8,6 +8,8 @@ #include "flang/Optimizer/Builder/FIRBuilder.h" #include "flang/Optimizer/Builder/BoxValue.h" +#include "flang/Optimizer/Builder/Character.h" +#include "flang/Optimizer/Builder/MutableBox.h" #include "flang/Optimizer/Dialect/FIROpsSupport.h" #include "flang/Optimizer/Support/FatalError.h" #include "flang/Optimizer/Support/InternalNames.h" @@ -277,6 +279,54 @@ llvm::None, attrs); } +mlir::Value fir::FirOpBuilder::genShape(mlir::Location loc, + llvm::ArrayRef exts) { + auto shapeType = fir::ShapeType::get(getContext(), exts.size()); + return create(loc, shapeType, exts); +} + +mlir::Value fir::FirOpBuilder::genShape(mlir::Location loc, + llvm::ArrayRef shift, + llvm::ArrayRef exts) { + auto shapeType = fir::ShapeShiftType::get(getContext(), exts.size()); + llvm::SmallVector shapeArgs; + auto idxTy = getIndexType(); + for (auto [lbnd, ext] : llvm::zip(shift, exts)) { + auto lb = createConvert(loc, idxTy, lbnd); + shapeArgs.push_back(lb); + shapeArgs.push_back(ext); + } + return create(loc, shapeType, shapeArgs); +} + +mlir::Value fir::FirOpBuilder::genShape(mlir::Location loc, + const fir::AbstractArrayBox &arr) { + if (arr.lboundsAllOne()) + return genShape(loc, arr.getExtents()); + return genShape(loc, arr.getLBounds(), arr.getExtents()); +} + +mlir::Value fir::FirOpBuilder::createShape(mlir::Location loc, + const fir::ExtendedValue &exv) { + return exv.match( + [&](const fir::ArrayBoxValue &box) { return genShape(loc, box); }, + [&](const fir::CharArrayBoxValue &box) { return genShape(loc, box); }, + [&](const fir::BoxValue &box) -> mlir::Value { + if (!box.getLBounds().empty()) { + auto shiftType = + fir::ShiftType::get(getContext(), box.getLBounds().size()); + return create(loc, shiftType, box.getLBounds()); + } + return {}; + }, + [&](const fir::MutableBoxValue &) -> mlir::Value { + // MutableBoxValue must be read into another category to work with them + // outside of allocation/assignment contexts. + fir::emitFatalError(loc, "createShape on MutableBoxValue"); + }, + [&](auto) -> mlir::Value { fir::emitFatalError(loc, "not an array"); }); +} + static mlir::Value genNullPointerComparison(fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value addr, @@ -296,6 +346,76 @@ return genNullPointerComparison(*this, loc, addr, arith::CmpIPredicate::eq); } +//===--------------------------------------------------------------------===// +// ExtendedValue inquiry helper implementation +//===--------------------------------------------------------------------===// + +mlir::Value fir::factory::readCharLen(fir::FirOpBuilder &builder, + mlir::Location loc, + const fir::ExtendedValue &box) { + return box.match( + [&](const fir::CharBoxValue &x) -> mlir::Value { return x.getLen(); }, + [&](const fir::CharArrayBoxValue &x) -> mlir::Value { + return x.getLen(); + }, + [&](const fir::BoxValue &x) -> mlir::Value { + assert(x.isCharacter()); + if (!x.getExplicitParameters().empty()) + return x.getExplicitParameters()[0]; + return fir::factory::CharacterExprHelper{builder, loc} + .readLengthFromBox(x.getAddr()); + }, + [&](const fir::MutableBoxValue &) -> mlir::Value { + // MutableBoxValue must be read into another category to work with them + // outside of allocation/assignment contexts. + fir::emitFatalError(loc, "readCharLen on MutableBoxValue"); + }, + [&](const auto &) -> mlir::Value { + fir::emitFatalError( + loc, "Character length inquiry on a non-character entity"); + }); +} + +llvm::SmallVector +fir::factory::readExtents(fir::FirOpBuilder &builder, mlir::Location loc, + const fir::BoxValue &box) { + llvm::SmallVector result; + auto explicitExtents = box.getExplicitExtents(); + if (!explicitExtents.empty()) { + result.append(explicitExtents.begin(), explicitExtents.end()); + return result; + } + auto rank = box.rank(); + auto idxTy = builder.getIndexType(); + for (decltype(rank) dim = 0; dim < rank; ++dim) { + auto dimVal = builder.createIntegerConstant(loc, idxTy, dim); + auto dimInfo = builder.create(loc, idxTy, idxTy, idxTy, + box.getAddr(), dimVal); + result.emplace_back(dimInfo.getResult(1)); + } + return result; +} + +llvm::SmallVector +fir::factory::getExtents(fir::FirOpBuilder &builder, mlir::Location loc, + const fir::ExtendedValue &box) { + return box.match( + [&](const fir::ArrayBoxValue &x) -> llvm::SmallVector { + return {x.getExtents().begin(), x.getExtents().end()}; + }, + [&](const fir::CharArrayBoxValue &x) -> llvm::SmallVector { + return {x.getExtents().begin(), x.getExtents().end()}; + }, + [&](const fir::BoxValue &x) -> llvm::SmallVector { + return fir::factory::readExtents(builder, loc, x); + }, + [&](const fir::MutableBoxValue &x) -> llvm::SmallVector { + auto load = fir::factory::genMutableBoxRead(builder, loc, x); + return fir::factory::getExtents(builder, loc, load); + }, + [&](const auto &) -> llvm::SmallVector { return {}; }); +} + std::string fir::factory::uniqueCGIdent(llvm::StringRef prefix, llvm::StringRef name) { // For "long" identifiers use a hash value diff --git a/flang/lib/Optimizer/Builder/MutableBox.cpp b/flang/lib/Optimizer/Builder/MutableBox.cpp new file mode 100644 --- /dev/null +++ b/flang/lib/Optimizer/Builder/MutableBox.cpp @@ -0,0 +1,746 @@ +//===-- MutableBox.cpp -- MutableBox utilities ----------------------------===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// +// +// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/ +// +//===----------------------------------------------------------------------===// + +#include "flang/Optimizer/Builder/MutableBox.h" +#include "flang/Lower/Todo.h" +#include "flang/Optimizer/Builder/Character.h" +#include "flang/Optimizer/Builder/FIRBuilder.h" +#include "flang/Optimizer/Dialect/FIROps.h" +#include "flang/Optimizer/Dialect/FIROpsSupport.h" +#include "flang/Optimizer/Support/FatalError.h" + +//===----------------------------------------------------------------------===// +// MutableBoxValue writer and reader +//===----------------------------------------------------------------------===// + +namespace { +/// MutablePropertyWriter and MutablePropertyReader implementations are the only +/// places that depend on how the properties of MutableBoxValue (pointers and +/// allocatables) that can be modified in the lifetime of the entity (address, +/// extents, lower bounds, length parameters) are represented. +/// That is, the properties may be only stored in a fir.box in memory if we +/// need to enforce a single point of truth for the properties across calls. +/// Or, they can be tracked as independent local variables when it is safe to +/// do so. Using bare variables benefits from all optimization passes, even +/// when they are not aware of what a fir.box is and fir.box have not been +/// optimized out yet. + +/// MutablePropertyWriter allows reading the properties of a MutableBoxValue. +class MutablePropertyReader { +public: + MutablePropertyReader(fir::FirOpBuilder &builder, mlir::Location loc, + const fir::MutableBoxValue &box, + bool forceIRBoxRead = false) + : builder{builder}, loc{loc}, box{box} { + if (forceIRBoxRead || !box.isDescribedByVariables()) + irBox = builder.create(loc, box.getAddr()); + } + /// Get base address of allocated/associated entity. + mlir::Value readBaseAddress() { + if (irBox) { + auto heapOrPtrTy = box.getBoxTy().getEleTy(); + return builder.create(loc, heapOrPtrTy, irBox); + } + auto addrVar = box.getMutableProperties().addr; + return builder.create(loc, addrVar); + } + /// Return {lbound, extent} values read from the MutableBoxValue given + /// the dimension. + std::pair readShape(unsigned dim) { + auto idxTy = builder.getIndexType(); + if (irBox) { + auto dimVal = builder.createIntegerConstant(loc, idxTy, dim); + auto dimInfo = builder.create(loc, idxTy, idxTy, idxTy, + irBox, dimVal); + return {dimInfo.getResult(0), dimInfo.getResult(1)}; + } + const auto &mutableProperties = box.getMutableProperties(); + auto lb = builder.create(loc, mutableProperties.lbounds[dim]); + auto ext = builder.create(loc, mutableProperties.extents[dim]); + return {lb, ext}; + } + + /// Return the character length. If the length was not deferred, the value + /// that was specified is returned (The mutable fields is not read). + mlir::Value readCharacterLength() { + if (box.hasNonDeferredLenParams()) + return box.nonDeferredLenParams()[0]; + if (irBox) + return fir::factory::CharacterExprHelper{builder, loc}.readLengthFromBox( + irBox); + const auto &deferred = box.getMutableProperties().deferredParams; + if (deferred.empty()) + fir::emitFatalError(loc, "allocatable entity has no length property"); + return builder.create(loc, deferred[0]); + } + + /// Read and return all extents. If \p lbounds vector is provided, lbounds are + /// also read into it. + llvm::SmallVector + readShape(llvm::SmallVectorImpl *lbounds = nullptr) { + llvm::SmallVector extents(box.rank()); + auto rank = box.rank(); + for (decltype(rank) dim = 0; dim < rank; ++dim) { + auto [lb, extent] = readShape(dim); + if (lbounds) + lbounds->push_back(lb); + extents.push_back(extent); + } + return extents; + } + + /// Read all mutable properties. Return the base address. + mlir::Value read(llvm::SmallVectorImpl &lbounds, + llvm::SmallVectorImpl &extents, + llvm::SmallVectorImpl &lengths) { + extents = readShape(&lbounds); + if (box.isCharacter()) + lengths.emplace_back(readCharacterLength()); + else if (box.isDerivedWithLengthParameters()) + TODO(loc, "read allocatable or pointer derived type LEN parameters"); + return readBaseAddress(); + } + + /// Return the loaded fir.box. + mlir::Value getIrBox() const { + assert(irBox); + return irBox; + } + + /// Read the lower bounds + void getLowerBounds(llvm::SmallVectorImpl &lbounds) { + auto rank = box.rank(); + for (decltype(rank) dim = 0; dim < rank; ++dim) + lbounds.push_back(std::get<0>(readShape(dim))); + } + +private: + fir::FirOpBuilder &builder; + mlir::Location loc; + fir::MutableBoxValue box; + mlir::Value irBox; +}; + +/// MutablePropertyWriter allows modifying the properties of a MutableBoxValue. +class MutablePropertyWriter { +public: + MutablePropertyWriter(fir::FirOpBuilder &builder, mlir::Location loc, + const fir::MutableBoxValue &box) + : builder{builder}, loc{loc}, box{box} {} + /// Update MutableBoxValue with new address, shape and length parameters. + /// Extents and lbounds must all have index type. + /// lbounds can be empty in which case all ones is assumed. + /// Length parameters must be provided for the length parameters that are + /// deferred. + void updateMutableBox(mlir::Value addr, mlir::ValueRange lbounds, + mlir::ValueRange extents, mlir::ValueRange lengths) { + if (box.isDescribedByVariables()) + updateMutableProperties(addr, lbounds, extents, lengths); + else + updateIRBox(addr, lbounds, extents, lengths); + } + + /// Update MutableBoxValue with a new fir.box. This requires that the mutable + /// box is not described by a set of variables, since they could not describe + /// all that can be described in the new fir.box (e.g. non contiguous entity). + void updateWithIrBox(mlir::Value newBox) { + assert(!box.isDescribedByVariables()); + builder.create(loc, newBox, box.getAddr()); + } + /// Set unallocated/disassociated status for the entity described by + /// MutableBoxValue. Deallocation is not performed by this helper. + void setUnallocatedStatus() { + if (box.isDescribedByVariables()) { + auto addrVar = box.getMutableProperties().addr; + auto nullTy = fir::dyn_cast_ptrEleTy(addrVar.getType()); + builder.create(loc, builder.createNullConstant(loc, nullTy), + addrVar); + } else { + // Note that the dynamic type of polymorphic entities must be reset to the + // declaration type of the mutable box. See Fortran 2018 7.8.2 NOTE 1. + // For those, we cannot simply set the address to zero. The way we are + // currently unallocating fir.box guarantees that we are resetting the + // type to the declared type. Beware if changing this. + // Note: the standard is not clear in Deallocate and p => NULL semantics + // regarding the new dynamic type the entity must have. So far, assume + // this is just like NULLIFY and the dynamic type must be set to the + // declared type, not retain the previous dynamic type. + auto deallocatedBox = fir::factory::createUnallocatedBox( + builder, loc, box.getBoxTy(), box.nonDeferredLenParams()); + builder.create(loc, deallocatedBox, box.getAddr()); + } + } + + /// Copy Values from the fir.box into the property variables if any. + void syncMutablePropertiesFromIRBox() { + if (!box.isDescribedByVariables()) + return; + llvm::SmallVector lbounds; + llvm::SmallVector extents; + llvm::SmallVector lengths; + auto addr = + MutablePropertyReader{builder, loc, box, /*forceIRBoxRead=*/true}.read( + lbounds, extents, lengths); + updateMutableProperties(addr, lbounds, extents, lengths); + } + + /// Copy Values from property variables, if any, into the fir.box. + void syncIRBoxFromMutableProperties() { + if (!box.isDescribedByVariables()) + return; + llvm::SmallVector lbounds; + llvm::SmallVector extents; + llvm::SmallVector lengths; + auto addr = MutablePropertyReader{builder, loc, box}.read(lbounds, extents, + lengths); + updateIRBox(addr, lbounds, extents, lengths); + } + +private: + /// Update the IR box (fir.ref>) of the MutableBoxValue. + void updateIRBox(mlir::Value addr, mlir::ValueRange lbounds, + mlir::ValueRange extents, mlir::ValueRange lengths) { + mlir::Value shape; + if (!extents.empty()) { + if (lbounds.empty()) { + auto shapeType = + fir::ShapeType::get(builder.getContext(), extents.size()); + shape = builder.create(loc, shapeType, extents); + } else { + llvm::SmallVector shapeShiftBounds; + for (auto [lb, extent] : llvm::zip(lbounds, extents)) { + shapeShiftBounds.emplace_back(lb); + shapeShiftBounds.emplace_back(extent); + } + auto shapeShiftType = + fir::ShapeShiftType::get(builder.getContext(), extents.size()); + shape = builder.create(loc, shapeShiftType, + shapeShiftBounds); + } + } + mlir::Value emptySlice; + // Ignore lengths if already constant in the box type (this would trigger an + // error in the embox). + llvm::SmallVector cleanedLengths; + mlir::Value irBox; + if (addr.getType().isa()) { + // The entity is already boxed. + irBox = builder.createConvert(loc, box.getBoxTy(), addr); + } else { + auto cleanedAddr = addr; + if (auto charTy = box.getEleTy().dyn_cast()) { + // Cast address to box type so that both input and output type have + // unknown or constant lengths. + auto bt = box.getBaseTy(); + auto addrTy = addr.getType(); + auto type = addrTy.isa() ? fir::HeapType::get(bt) + : addrTy.isa() ? fir::PointerType::get(bt) + : builder.getRefType(bt); + cleanedAddr = builder.createConvert(loc, type, addr); + if (charTy.getLen() == fir::CharacterType::unknownLen()) + cleanedLengths.append(lengths.begin(), lengths.end()); + } else if (box.isDerivedWithLengthParameters()) { + TODO(loc, "updating mutablebox of derived type with length parameters"); + cleanedLengths = lengths; + } + irBox = builder.create(loc, box.getBoxTy(), cleanedAddr, + shape, emptySlice, cleanedLengths); + } + builder.create(loc, irBox, box.getAddr()); + } + + /// Update the set of property variables of the MutableBoxValue. + void updateMutableProperties(mlir::Value addr, mlir::ValueRange lbounds, + mlir::ValueRange extents, + mlir::ValueRange lengths) { + auto castAndStore = [&](mlir::Value val, mlir::Value addr) { + auto type = fir::dyn_cast_ptrEleTy(addr.getType()); + builder.create(loc, builder.createConvert(loc, type, val), + addr); + }; + const auto &mutableProperties = box.getMutableProperties(); + castAndStore(addr, mutableProperties.addr); + for (auto [extent, extentVar] : + llvm::zip(extents, mutableProperties.extents)) + castAndStore(extent, extentVar); + if (!mutableProperties.lbounds.empty()) { + if (lbounds.empty()) { + auto one = + builder.createIntegerConstant(loc, builder.getIndexType(), 1); + for (auto lboundVar : mutableProperties.lbounds) + castAndStore(one, lboundVar); + } else { + for (auto [lbound, lboundVar] : + llvm::zip(lbounds, mutableProperties.lbounds)) + castAndStore(lbound, lboundVar); + } + } + if (box.isCharacter()) + // llvm::zip account for the fact that the length only needs to be stored + // when it is specified in the allocation and deferred in the + // MutableBoxValue. + for (auto [len, lenVar] : + llvm::zip(lengths, mutableProperties.deferredParams)) + castAndStore(len, lenVar); + else if (box.isDerivedWithLengthParameters()) + TODO(loc, "update allocatable derived type length parameters"); + } + fir::FirOpBuilder &builder; + mlir::Location loc; + fir::MutableBoxValue box; +}; + +} // namespace + +mlir::Value +fir::factory::createUnallocatedBox(fir::FirOpBuilder &builder, + mlir::Location loc, mlir::Type boxType, + mlir::ValueRange nonDeferredParams) { + auto heapType = boxType.dyn_cast().getEleTy(); + auto type = fir::dyn_cast_ptrEleTy(heapType); + auto eleTy = type; + if (auto seqType = eleTy.dyn_cast()) + eleTy = seqType.getEleTy(); + if (auto recTy = eleTy.dyn_cast()) + if (recTy.getNumLenParams() > 0) + TODO(loc, "creating unallocated fir.box of derived type with length " + "parameters"); + auto nullAddr = builder.createNullConstant(loc, heapType); + mlir::Value shape; + if (auto seqTy = type.dyn_cast()) { + auto zero = builder.createIntegerConstant(loc, builder.getIndexType(), 0); + llvm::SmallVector extents(seqTy.getDimension(), zero); + shape = builder.createShape( + loc, fir::ArrayBoxValue{nullAddr, extents, /*lbounds=*/llvm::None}); + } + // Provide dummy length parameters if they are dynamic. If a length parameter + // is deferred. It is set to zero here and will be set on allocation. + llvm::SmallVector lenParams; + if (auto charTy = eleTy.dyn_cast()) { + if (charTy.getLen() == fir::CharacterType::unknownLen()) { + if (!nonDeferredParams.empty()) { + lenParams.push_back(nonDeferredParams[0]); + } else { + auto zero = builder.createIntegerConstant( + loc, builder.getCharacterLengthType(), 0); + lenParams.push_back(zero); + } + } + } + mlir::Value emptySlice; + return builder.create(loc, boxType, nullAddr, shape, emptySlice, + lenParams); +} + +fir::MutableBoxValue +fir::factory::createTempMutableBox(fir::FirOpBuilder &builder, + mlir::Location loc, mlir::Type type, + llvm::StringRef name) { + auto boxType = fir::BoxType::get(fir::HeapType::get(type)); + auto boxAddr = builder.createTemporary(loc, boxType, name); + auto box = + fir::MutableBoxValue(boxAddr, /*nonDeferredParams=*/mlir::ValueRange(), + /*mutableProperties=*/{}); + MutablePropertyWriter{builder, loc, box}.setUnallocatedStatus(); + return box; +} + +/// Helper to decide if a MutableBoxValue must be read to a BoxValue or +/// can be read to a reified box value. +static bool readToBoxValue(const fir::MutableBoxValue &box, + bool mayBePolymorphic) { + // If this is described by a set of local variables, the value + // should not be tracked as a fir.box. + if (box.isDescribedByVariables()) + return false; + // Polymorphism might be a source of discontiguity, even on allocatables. + // Track value as fir.box + if ((box.isDerived() && mayBePolymorphic) || box.isUnlimitedPolymorphic()) + return true; + // Intrinsic allocatables are contiguous, no need to track the value by + // fir.box. + if (box.isAllocatable() || box.rank() == 0) + return false; + // Pointers are known to be contiguous at compile time iff they have the + // CONTIGUOUS attribute. + return !fir::valueHasFirAttribute(box.getAddr(), + fir::getContiguousAttrName()); +} + +fir::ExtendedValue +fir::factory::genMutableBoxRead(fir::FirOpBuilder &builder, mlir::Location loc, + const fir::MutableBoxValue &box, + bool mayBePolymorphic) { + if (box.hasAssumedRank()) + TODO(loc, "Assumed rank allocatables or pointers"); + llvm::SmallVector lbounds; + llvm::SmallVector extents; + llvm::SmallVector lengths; + if (readToBoxValue(box, mayBePolymorphic)) { + auto reader = MutablePropertyReader(builder, loc, box); + reader.getLowerBounds(lbounds); + return fir::BoxValue{reader.getIrBox(), lbounds, + box.nonDeferredLenParams()}; + } + // Contiguous intrinsic type entity: all the data can be extracted from the + // fir.box. + auto addr = + MutablePropertyReader(builder, loc, box).read(lbounds, extents, lengths); + auto rank = box.rank(); + if (box.isCharacter()) { + auto len = lengths.empty() ? mlir::Value{} : lengths[0]; + if (rank) + return fir::CharArrayBoxValue{addr, len, extents, lbounds}; + return fir::CharBoxValue{addr, len}; + } + if (rank) + return fir::ArrayBoxValue{addr, extents, lbounds}; + return addr; +} + +mlir::Value +fir::factory::genIsAllocatedOrAssociatedTest(fir::FirOpBuilder &builder, + mlir::Location loc, + const fir::MutableBoxValue &box) { + auto addr = MutablePropertyReader(builder, loc, box).readBaseAddress(); + return builder.genIsNotNull(loc, addr); +} + +/// Generate finalizer call and inlined free. This does not check that the +/// address was allocated. +static void genFinalizeAndFree(fir::FirOpBuilder &builder, mlir::Location loc, + mlir::Value addr) { + // TODO: call finalizer if any. + + // A heap (ALLOCATABLE) object may have been converted to a ptr (POINTER), + // so make sure the heap type is restored before deallocation. + auto cast = builder.createConvert( + loc, fir::HeapType::get(fir::dyn_cast_ptrEleTy(addr.getType())), addr); + builder.create(loc, cast); +} + +void fir::factory::genFinalization(fir::FirOpBuilder &builder, + mlir::Location loc, + const fir::MutableBoxValue &box) { + auto addr = MutablePropertyReader(builder, loc, box).readBaseAddress(); + auto isAllocated = builder.genIsNotNull(loc, addr); + auto ifOp = builder.create(loc, isAllocated, + /*withElseRegion=*/false); + auto insPt = builder.saveInsertionPoint(); + builder.setInsertionPointToStart(&ifOp.thenRegion().front()); + genFinalizeAndFree(builder, loc, addr); + builder.restoreInsertionPoint(insPt); +} + +//===----------------------------------------------------------------------===// +// MutableBoxValue writing interface implementation +//===----------------------------------------------------------------------===// + +void fir::factory::associateMutableBox(fir::FirOpBuilder &builder, + mlir::Location loc, + const fir::MutableBoxValue &box, + const fir::ExtendedValue &source, + mlir::ValueRange lbounds) { + MutablePropertyWriter writer(builder, loc, box); + source.match( + [&](const fir::UnboxedValue &addr) { + writer.updateMutableBox(addr, /*lbounds=*/llvm::None, + /*extents=*/llvm::None, /*lengths=*/llvm::None); + }, + [&](const fir::CharBoxValue &ch) { + writer.updateMutableBox(ch.getAddr(), /*lbounds=*/llvm::None, + /*extents=*/llvm::None, {ch.getLen()}); + }, + [&](const fir::ArrayBoxValue &arr) { + writer.updateMutableBox(arr.getAddr(), + lbounds.empty() ? arr.getLBounds() : lbounds, + arr.getExtents(), /*lengths=*/llvm::None); + }, + [&](const fir::CharArrayBoxValue &arr) { + writer.updateMutableBox(arr.getAddr(), + lbounds.empty() ? arr.getLBounds() : lbounds, + arr.getExtents(), {arr.getLen()}); + }, + [&](const fir::BoxValue &arr) { + // Rebox array fir.box to the pointer type and apply potential new lower + // bounds. + mlir::ValueRange newLbounds = lbounds.empty() + ? mlir::ValueRange{arr.getLBounds()} + : mlir::ValueRange{lbounds}; + if (box.isDescribedByVariables()) { + // LHS is a contiguous pointer described by local variables. Open RHS + // fir.box to update the LHS. + auto rawAddr = builder.create(loc, arr.getMemTy(), + arr.getAddr()); + auto extents = fir::factory::getExtents(builder, loc, source); + llvm::SmallVector lenParams; + if (arr.isCharacter()) { + lenParams.emplace_back( + fir::factory::readCharLen(builder, loc, source)); + } else if (arr.isDerivedWithLengthParameters()) { + TODO(loc, "pointer assignment to derived with length parameters"); + } + writer.updateMutableBox(rawAddr, newLbounds, extents, lenParams); + } else { + mlir::Value shift; + if (!newLbounds.empty()) { + auto shiftType = + fir::ShiftType::get(builder.getContext(), newLbounds.size()); + shift = builder.create(loc, shiftType, newLbounds); + } + auto reboxed = + builder.create(loc, box.getBoxTy(), arr.getAddr(), + shift, /*slice=*/mlir::Value()); + writer.updateWithIrBox(reboxed); + } + }, + [&](const fir::MutableBoxValue &) { + // No point implementing this, if right-hand side is a + // pointer/allocatable, the related MutableBoxValue has been read into + // another ExtendedValue category. + fir::emitFatalError(loc, + "Cannot write MutableBox to another MutableBox"); + }, + [&](const fir::ProcBoxValue &) { + TODO(loc, "Procedure pointer assignment"); + }); +} + +void fir::factory::associateMutableBoxWithRemap( + fir::FirOpBuilder &builder, mlir::Location loc, + const fir::MutableBoxValue &box, const fir::ExtendedValue &source, + mlir::ValueRange lbounds, mlir::ValueRange ubounds) { + // Compute new extents + llvm::SmallVector extents; + auto idxTy = builder.getIndexType(); + if (!lbounds.empty()) { + auto one = builder.createIntegerConstant(loc, idxTy, 1); + for (auto [lb, ub] : llvm::zip(lbounds, ubounds)) { + auto lbi = builder.createConvert(loc, idxTy, lb); + auto ubi = builder.createConvert(loc, idxTy, ub); + auto diff = builder.create(loc, idxTy, ubi, lbi); + extents.emplace_back( + builder.create(loc, idxTy, diff, one)); + } + } else { + // lbounds are default. Upper bounds and extents are the same. + for (auto ub : ubounds) { + auto cast = builder.createConvert(loc, idxTy, ub); + extents.emplace_back(cast); + } + } + const auto newRank = extents.size(); + auto cast = [&](mlir::Value addr) -> mlir::Value { + // Cast base addr to new sequence type. + auto ty = fir::dyn_cast_ptrEleTy(addr.getType()); + if (auto seqTy = ty.dyn_cast()) { + fir::SequenceType::Shape shape(newRank, + fir::SequenceType::getUnknownExtent()); + ty = fir::SequenceType::get(shape, seqTy.getEleTy()); + } + return builder.createConvert(loc, builder.getRefType(ty), addr); + }; + MutablePropertyWriter writer(builder, loc, box); + source.match( + [&](const fir::UnboxedValue &addr) { + writer.updateMutableBox(cast(addr), lbounds, extents, + /*lengths=*/llvm::None); + }, + [&](const fir::CharBoxValue &ch) { + writer.updateMutableBox(cast(ch.getAddr()), lbounds, extents, + {ch.getLen()}); + }, + [&](const fir::ArrayBoxValue &arr) { + writer.updateMutableBox(cast(arr.getAddr()), lbounds, extents, + /*lengths=*/llvm::None); + }, + [&](const fir::CharArrayBoxValue &arr) { + writer.updateMutableBox(cast(arr.getAddr()), lbounds, extents, + {arr.getLen()}); + }, + [&](const fir::BoxValue &arr) { + // Rebox right-hand side fir.box with a new shape and type. + if (box.isDescribedByVariables()) { + // LHS is a contiguous pointer described by local variables. Open RHS + // fir.box to update the LHS. + auto rawAddr = builder.create(loc, arr.getMemTy(), + arr.getAddr()); + llvm::SmallVector lenParams; + if (arr.isCharacter()) { + lenParams.emplace_back( + fir::factory::readCharLen(builder, loc, source)); + } else if (arr.isDerivedWithLengthParameters()) { + TODO(loc, "pointer assignment to derived with length parameters"); + } + writer.updateMutableBox(rawAddr, lbounds, extents, lenParams); + } else { + auto shapeType = + fir::ShapeShiftType::get(builder.getContext(), extents.size()); + llvm::SmallVector shapeArgs; + auto idxTy = builder.getIndexType(); + for (auto [lbnd, ext] : llvm::zip(lbounds, extents)) { + auto lb = builder.createConvert(loc, idxTy, lbnd); + shapeArgs.push_back(lb); + shapeArgs.push_back(ext); + } + auto shape = + builder.create(loc, shapeType, shapeArgs); + auto reboxed = + builder.create(loc, box.getBoxTy(), arr.getAddr(), + shape, /*slice=*/mlir::Value()); + writer.updateWithIrBox(reboxed); + } + }, + [&](const fir::MutableBoxValue &) { + // No point implementing this, if right-hand side is a pointer or + // allocatable, the related MutableBoxValue has already been read into + // another ExtendedValue category. + fir::emitFatalError(loc, + "Cannot write MutableBox to another MutableBox"); + }, + [&](const fir::ProcBoxValue &) { + TODO(loc, "Procedure pointer assignment"); + }); +} + +void fir::factory::disassociateMutableBox(fir::FirOpBuilder &builder, + mlir::Location loc, + const fir::MutableBoxValue &box) { + MutablePropertyWriter{builder, loc, box}.setUnallocatedStatus(); +} + +void fir::factory::genInlinedAllocation(fir::FirOpBuilder &builder, + mlir::Location loc, + const fir::MutableBoxValue &box, + mlir::ValueRange lbounds, + mlir::ValueRange extents, + mlir::ValueRange lenParams, + llvm::StringRef allocName) { + auto idxTy = builder.getIndexType(); + llvm::SmallVector lengths; + if (auto charTy = box.getEleTy().dyn_cast()) { + if (charTy.getLen() == fir::CharacterType::unknownLen()) { + if (box.hasNonDeferredLenParams()) + lengths.emplace_back( + builder.createConvert(loc, idxTy, box.nonDeferredLenParams()[0])); + else if (!lenParams.empty()) + lengths.emplace_back(builder.createConvert(loc, idxTy, lenParams[0])); + else + fir::emitFatalError( + loc, "could not deduce character lengths in character allocation"); + } + } + mlir::Value heap = builder.create( + loc, box.getBaseTy(), allocName, lengths, extents); + // TODO: run initializer if any. Currently, there is no way to know this is + // required here. + MutablePropertyWriter{builder, loc, box}.updateMutableBox(heap, lbounds, + extents, lengths); +} + +void fir::factory::genInlinedDeallocate(fir::FirOpBuilder &builder, + mlir::Location loc, + const fir::MutableBoxValue &box) { + auto addr = MutablePropertyReader(builder, loc, box).readBaseAddress(); + genFinalizeAndFree(builder, loc, addr); + MutablePropertyWriter{builder, loc, box}.setUnallocatedStatus(); +} + +void fir::factory::genReallocIfNeeded(fir::FirOpBuilder &builder, + mlir::Location loc, + const fir::MutableBoxValue &box, + mlir::ValueRange lbounds, + mlir::ValueRange shape, + mlir::ValueRange lengthParams) { + // Implement 10.2.1.3 point 3 logic when lhs is an array. + auto reader = MutablePropertyReader(builder, loc, box); + auto addr = reader.readBaseAddress(); + auto isAllocated = builder.genIsNotNull(loc, addr); + builder.genIfThenElse(loc, isAllocated) + .genThen([&]() { + // The box is allocated. Check if it must be reallocated and reallocate. + mlir::Value mustReallocate = builder.createBool(loc, false); + auto compareProperty = [&](mlir::Value previous, mlir::Value required) { + auto castPrevious = + builder.createConvert(loc, required.getType(), previous); + // reallocate = reallocate || previous != required + auto cmp = builder.create( + loc, arith::CmpIPredicate::ne, castPrevious, required); + mustReallocate = + builder.create(loc, cmp, cmp, mustReallocate); + }; + llvm::SmallVector previousLbounds; + llvm::SmallVector previousExtents = + reader.readShape(&previousLbounds); + if (!shape.empty()) + for (auto [previousExtent, requested] : + llvm::zip(previousExtents, shape)) + compareProperty(previousExtent, requested); + + if (box.isCharacter() && !box.hasNonDeferredLenParams()) { + // When the allocatable length is not deferred, it must not be + // reallocated in case of length mismatch, instead, padding/trimming + // will ocur in later assignment to it. + assert(!lengthParams.empty() && + "must provide length parameters for character"); + compareProperty(reader.readCharacterLength(), lengthParams[0]); + } else if (box.isDerivedWithLengthParameters()) { + TODO(loc, + "automatic allocation of derived type allocatable with length " + "parameters"); + } + builder.genIfThen(loc, mustReallocate) + .genThen([&]() { + // If shape or length mismatch, deallocate and reallocate. + genFinalizeAndFree(builder, loc, addr); + // When rhs is a scalar, keep the previous shape + auto extents = + shape.empty() ? mlir::ValueRange(previousExtents) : shape; + auto lbs = + shape.empty() ? mlir::ValueRange(previousLbounds) : lbounds; + genInlinedAllocation(builder, loc, box, lbs, extents, + lengthParams, ".auto.alloc"); + }) + .end(); + }) + .genElse([&]() { + // The box is not yet allocated, simply allocate it. + if (shape.empty() && box.rank() != 0) { + // TODO: + // runtime error: right hand side must be allocated if right hand + // side is a scalar and the box is an array. + } else { + genInlinedAllocation(builder, loc, box, lbounds, shape, lengthParams, + ".auto.alloc"); + } + }) + .end(); +} + +//===----------------------------------------------------------------------===// +// MutableBoxValue syncing implementation +//===----------------------------------------------------------------------===// + +/// Depending on the implementation, allocatable/pointer descriptor and the +/// MutableBoxValue need to be synced before and after calls passing the +/// descriptor. These calls will generate the syncing if needed or be no-op. +mlir::Value fir::factory::getMutableIRBox(fir::FirOpBuilder &builder, + mlir::Location loc, + const fir::MutableBoxValue &box) { + MutablePropertyWriter{builder, loc, box}.syncIRBoxFromMutableProperties(); + return box.getAddr(); +} +void fir::factory::syncMutableBoxFromIRBox(fir::FirOpBuilder &builder, + mlir::Location loc, + const fir::MutableBoxValue &box) { + MutablePropertyWriter{builder, loc, box}.syncMutablePropertiesFromIRBox(); +} diff --git a/flang/unittests/Optimizer/Builder/FIRBuilderTest.cpp b/flang/unittests/Optimizer/Builder/FIRBuilderTest.cpp --- a/flang/unittests/Optimizer/Builder/FIRBuilderTest.cpp +++ b/flang/unittests/Optimizer/Builder/FIRBuilderTest.cpp @@ -15,7 +15,8 @@ struct FIRBuilderTest : public testing::Test { public: void SetUp() override { - fir::KindMapping kindMap(&context); + llvm::ArrayRef defs; + fir::KindMapping kindMap(&context, defs); mlir::OpBuilder builder(&context); auto loc = builder.getUnknownLoc(); @@ -335,3 +336,80 @@ EXPECT_EQ(0u, allocaOp.typeparams().size()); EXPECT_EQ(0u, allocaOp.shape().size()); } + +static void checkShapeOp(mlir::Value shape, mlir::Value c10, mlir::Value c100) { + EXPECT_TRUE(mlir::isa(shape.getDefiningOp())); + fir::ShapeOp op = dyn_cast(shape.getDefiningOp()); + auto shapeTy = op.getType().dyn_cast(); + EXPECT_EQ(2u, shapeTy.getRank()); + EXPECT_EQ(2u, op.getExtents().size()); + EXPECT_EQ(c10, op.getExtents()[0]); + EXPECT_EQ(c100, op.getExtents()[1]); +} + +TEST_F(FIRBuilderTest, genShapeWithExtents) { + auto builder = getBuilder(); + auto loc = builder.getUnknownLoc(); + auto c10 = builder.createIntegerConstant(loc, builder.getI64Type(), 10); + auto c100 = builder.createIntegerConstant(loc, builder.getI64Type(), 100); + llvm::SmallVector extents = {c10, c100}; + auto shape = builder.genShape(loc, extents); + checkShapeOp(shape, c10, c100); +} + +TEST_F(FIRBuilderTest, genShapeWithExtentsAndShapeShift) { + auto builder = getBuilder(); + auto loc = builder.getUnknownLoc(); + auto c10 = builder.createIntegerConstant(loc, builder.getI64Type(), 10); + auto c100 = builder.createIntegerConstant(loc, builder.getI64Type(), 100); + auto c1 = builder.createIntegerConstant(loc, builder.getI64Type(), 100); + llvm::SmallVector shifts = {c1, c1}; + llvm::SmallVector extents = {c10, c100}; + auto shape = builder.genShape(loc, shifts, extents); + EXPECT_TRUE(mlir::isa(shape.getDefiningOp())); + fir::ShapeShiftOp op = dyn_cast(shape.getDefiningOp()); + auto shapeTy = op.getType().dyn_cast(); + EXPECT_EQ(2u, shapeTy.getRank()); + EXPECT_EQ(2u, op.getExtents().size()); + EXPECT_EQ(2u, op.getOrigins().size()); +} + +TEST_F(FIRBuilderTest, genShapeWithAbstractArrayBox) { + auto builder = getBuilder(); + auto loc = builder.getUnknownLoc(); + auto c10 = builder.createIntegerConstant(loc, builder.getI64Type(), 10); + auto c100 = builder.createIntegerConstant(loc, builder.getI64Type(), 100); + llvm::SmallVector extents = {c10, c100}; + fir::AbstractArrayBox aab(extents, {}); + EXPECT_TRUE(aab.lboundsAllOne()); + auto shape = builder.genShape(loc, aab); + checkShapeOp(shape, c10, c100); +} + +TEST_F(FIRBuilderTest, readCharLen) { + auto builder = getBuilder(); + auto loc = builder.getUnknownLoc(); + llvm::StringRef strValue("length"); + auto strLit = fir::factory::createStringLiteral(builder, loc, strValue); + auto len = fir::factory::readCharLen(builder, loc, strLit); + EXPECT_EQ(strLit.getCharBox()->getLen(), len); +} + +TEST_F(FIRBuilderTest, getExtents) { + auto builder = getBuilder(); + auto loc = builder.getUnknownLoc(); + llvm::StringRef strValue("length"); + auto strLit = fir::factory::createStringLiteral(builder, loc, strValue); + auto ext = fir::factory::getExtents(builder, loc, strLit); + EXPECT_EQ(0u, ext.size()); + auto c10 = builder.createIntegerConstant(loc, builder.getI64Type(), 10); + auto c100 = builder.createIntegerConstant(loc, builder.getI64Type(), 100); + llvm::SmallVector extents = {c10, c100}; + fir::SequenceType::Shape shape(2, fir::SequenceType::getUnknownExtent()); + auto arrayTy = fir::SequenceType::get(shape, builder.getI64Type()); + mlir::Value array = builder.create(loc, arrayTy); + fir::ArrayBoxValue aab(array, extents, {}); + fir::ExtendedValue ex(aab); + auto readExtents = fir::factory::getExtents(builder, loc, ex); + EXPECT_EQ(2u, readExtents.size()); +}