//===----------------------------------------------------------------------===//
#include "flang/Optimizer/Builder/HLFIRTools.h"
+#include "flang/Optimizer/Builder/Character.h"
#include "flang/Optimizer/Builder/FIRBuilder.h"
#include "flang/Optimizer/Builder/MutableBox.h"
#include "flang/Optimizer/Builder/Todo.h"
// Return explicit extents. If the base is a fir.box, this won't read it to
// return the extents and will instead return an empty vector.
-static llvm::SmallVector<mlir::Value> getExplicitExtents(mlir::Value shape) {
+static llvm::SmallVector<mlir::Value>
+getExplicitExtentsFromShape(mlir::Value shape) {
llvm::SmallVector<mlir::Value> result;
auto *shapeOp = shape.getDefiningOp();
if (auto s = mlir::dyn_cast_or_null<fir::ShapeOp>(shapeOp)) {
static llvm::SmallVector<mlir::Value>
getExplicitExtents(fir::FortranVariableOpInterface var) {
if (mlir::Value shape = var.getShape())
- return getExplicitExtents(var.getShape());
+ return getExplicitExtentsFromShape(var.getShape());
return {};
}
// Return explicit lower bounds. For pointers and allocatables, this will not
// read the lower bounds and instead return an empty vector.
-static llvm::SmallVector<mlir::Value> getExplicitLbounds(mlir::Value shape) {
+static llvm::SmallVector<mlir::Value>
+getExplicitLboundsFromShape(mlir::Value shape) {
llvm::SmallVector<mlir::Value> result;
auto *shapeOp = shape.getDefiningOp();
if (auto s = mlir::dyn_cast_or_null<fir::ShapeOp>(shapeOp)) {
static llvm::SmallVector<mlir::Value>
getExplicitLbounds(fir::FortranVariableOpInterface var) {
if (mlir::Value shape = var.getShape())
- return getExplicitLbounds(shape);
+ return getExplicitLboundsFromShape(shape);
return {};
}
+static void
+genLboundsAndExtentsFromBox(mlir::Location loc, fir::FirOpBuilder &builder,
+ hlfir::Entity boxEntity,
+ llvm::SmallVectorImpl<mlir::Value> &lbounds,
+ llvm::SmallVectorImpl<mlir::Value> *extents) {
+ assert(boxEntity.getType().isa<fir::BaseBoxType>() && "must be a box");
+ mlir::Type idxTy = builder.getIndexType();
+ const int rank = boxEntity.getRank();
+ for (int i = 0; i < rank; ++i) {
+ mlir::Value dim = builder.createIntegerConstant(loc, idxTy, i);
+ auto dimInfo = builder.create<fir::BoxDimsOp>(loc, idxTy, idxTy, idxTy,
+ boxEntity, dim);
+ lbounds.push_back(dimInfo.getLowerBound());
+ if (extents)
+ extents->push_back(dimInfo.getExtent());
+ }
+}
+
static llvm::SmallVector<mlir::Value>
-getExplicitTypeParams(fir::FortranVariableOpInterface var) {
+getNonDefaultLowerBounds(mlir::Location loc, fir::FirOpBuilder &builder,
+ hlfir::Entity entity) {
+ if (!entity.hasNonDefaultLowerBounds())
+ return {};
+ if (auto varIface = entity.getIfVariableInterface()) {
+ llvm::SmallVector<mlir::Value> lbounds = getExplicitLbounds(varIface);
+ if (!lbounds.empty())
+ return lbounds;
+ }
+ if (entity.isMutableBox())
+ entity = hlfir::derefPointersAndAllocatables(loc, builder, entity);
+ llvm::SmallVector<mlir::Value> lowerBounds;
+ genLboundsAndExtentsFromBox(loc, builder, entity, lowerBounds,
+ /*extents=*/nullptr);
+ return lowerBounds;
+}
+
+static llvm::SmallVector<mlir::Value> toSmallVector(mlir::ValueRange range) {
llvm::SmallVector<mlir::Value> res;
- mlir::OperandRange range = var.getExplicitTypeParams();
res.append(range.begin(), range.end());
return res;
}
-std::pair<fir::ExtendedValue, std::optional<hlfir::CleanupFunction>>
-hlfir::translateToExtendedValue(mlir::Location loc, fir::FirOpBuilder &builder,
- hlfir::Entity entity) {
- if (auto variable = entity.getIfVariableInterface())
- return {hlfir::translateToExtendedValue(loc, builder, variable), {}};
- if (entity.isVariable()) {
- if (entity.isScalar() && !entity.hasLengthParameters() &&
- !hlfir::isBoxAddressOrValueType(entity.getType()))
- return {fir::ExtendedValue{entity.getBase()}, std::nullopt};
- TODO(loc, "HLFIR variable to fir::ExtendedValue without a "
- "FortranVariableOpInterface");
- }
- if (entity.getType().isa<hlfir::ExprType>()) {
- hlfir::AssociateOp associate = hlfir::genAssociateExpr(
- loc, builder, entity, entity.getType(), "adapt.valuebyref");
- auto *bldr = &builder;
- hlfir::CleanupFunction cleanup = [bldr, loc, associate]() -> void {
- bldr->create<hlfir::EndAssociateOp>(loc, associate);
- };
- hlfir::Entity temp{associate.getBase()};
- return {translateToExtendedValue(loc, builder, temp).first, cleanup};
- }
- return {{static_cast<mlir::Value>(entity)}, {}};
+static llvm::SmallVector<mlir::Value> getExplicitTypeParams(hlfir::Entity var) {
+ if (auto varIface = var.getMaybeDereferencedVariableInterface())
+ return toSmallVector(varIface.getExplicitTypeParams());
+ return {};
+}
+
+static mlir::Value tryGettingNonDeferredCharLen(hlfir::Entity var) {
+ if (auto varIface = var.getMaybeDereferencedVariableInterface())
+ if (!varIface.getExplicitTypeParams().empty())
+ return varIface.getExplicitTypeParams()[0];
+ return mlir::Value{};
+}
+
+static mlir::Value genCharacterVariableLength(mlir::Location loc,
+ fir::FirOpBuilder &builder,
+ hlfir::Entity var) {
+ if (mlir::Value len = tryGettingNonDeferredCharLen(var))
+ return len;
+ auto charType = var.getFortranElementType().cast<fir::CharacterType>();
+ if (charType.hasConstantLen())
+ return builder.createIntegerConstant(loc, builder.getIndexType(),
+ charType.getLen());
+ if (var.isMutableBox())
+ var = hlfir::Entity{builder.create<fir::LoadOp>(loc, var)};
+ mlir::Value len = fir::factory::CharacterExprHelper{builder, loc}.getLength(
+ var.getFirBase());
+ assert(len && "failed to retrieve length");
+ return len;
+}
+
+static fir::CharBoxValue genUnboxChar(mlir::Location loc,
+ fir::FirOpBuilder &builder,
+ mlir::Value boxChar) {
+ if (auto emboxChar = boxChar.getDefiningOp<fir::EmboxCharOp>())
+ return {emboxChar.getMemref(), emboxChar.getLen()};
+ mlir::Type refType = fir::ReferenceType::get(
+ boxChar.getType().cast<fir::BoxCharType>().getEleTy());
+ auto unboxed = builder.create<fir::UnboxCharOp>(
+ loc, refType, builder.getIndexType(), boxChar);
+ mlir::Value addr = unboxed.getResult(0);
+ mlir::Value len = unboxed.getResult(1);
+ if (auto varIface = boxChar.getDefiningOp<fir::FortranVariableOpInterface>())
+ if (mlir::Value explicitlen = varIface.getExplicitCharLen())
+ len = explicitlen;
+ return {addr, len};
}
mlir::Value hlfir::Entity::getFirBase() const {
return getBase();
}
-fir::ExtendedValue
-hlfir::translateToExtendedValue(mlir::Location loc, fir::FirOpBuilder &builder,
- fir::FortranVariableOpInterface variable) {
- /// When going towards FIR, use the original base value to avoid
- /// introducing descriptors at runtime when they are not required.
- mlir::Value firBase = Entity{variable}.getFirBase();
- if (variable.isPointer() || variable.isAllocatable())
- TODO(variable->getLoc(), "pointer or allocatable "
- "FortranVariableOpInterface to extendedValue");
- if (firBase.getType().isa<fir::BaseBoxType>())
- return fir::BoxValue(firBase, getExplicitLbounds(variable),
- getExplicitTypeParams(variable));
-
- if (variable.isCharacter()) {
- if (variable.isArray())
- return fir::CharArrayBoxValue(firBase, variable.getExplicitCharLen(),
- getExplicitExtents(variable),
- getExplicitLbounds(variable));
- if (auto boxCharType = firBase.getType().dyn_cast<fir::BoxCharType>()) {
- auto unboxed = builder.create<fir::UnboxCharOp>(
- loc, fir::ReferenceType::get(boxCharType.getEleTy()),
- builder.getIndexType(), firBase);
- return fir::CharBoxValue(unboxed.getResult(0),
- variable.getExplicitCharLen());
- }
- return fir::CharBoxValue(firBase, variable.getExplicitCharLen());
- }
- if (variable.isArray())
- return fir::ArrayBoxValue(firBase, getExplicitExtents(variable),
- getExplicitLbounds(variable));
- return firBase;
-}
-
fir::FortranVariableOpInterface
hlfir::genDeclare(mlir::Location loc, fir::FirOpBuilder &builder,
const fir::ExtendedValue &exv, llvm::StringRef name,
if (var.isMutableBox())
baseAddr = builder.create<fir::LoadOp>(loc, baseAddr);
// Get raw address.
- if (baseAddr.getType().isa<fir::BaseBoxType>()) {
- auto addrType =
- fir::ReferenceType::get(fir::unwrapPassByRefType(baseAddr.getType()));
- baseAddr = builder.create<fir::BoxAddrOp>(loc, addrType, baseAddr);
- }
+ if (baseAddr.getType().isa<fir::BaseBoxType>())
+ baseAddr = builder.create<fir::BoxAddrOp>(loc, baseAddr);
return baseAddr;
}
return entity;
}
-static std::optional<llvm::SmallVector<mlir::Value>>
-getNonDefaultLowerBounds(mlir::Location loc, fir::FirOpBuilder &builder,
- hlfir::Entity entity) {
- if (!entity.hasNonDefaultLowerBounds())
- return std::nullopt;
- if (auto varIface = entity.getIfVariableInterface()) {
- llvm::SmallVector<mlir::Value> lbounds = getExplicitLbounds(varIface);
- if (!lbounds.empty())
- return lbounds;
- }
- TODO(loc, "get non default lower bounds without FortranVariableInterface");
-}
-
hlfir::Entity hlfir::getElementAt(mlir::Location loc,
fir::FirOpBuilder &builder, Entity entity,
mlir::ValueRange oneBasedIndices) {
// based on the array operand lower bounds.
mlir::Type resultType = hlfir::getVariableElementType(entity);
hlfir::DesignateOp designate;
- if (auto lbounds = getNonDefaultLowerBounds(loc, builder, entity)) {
+ llvm::SmallVector<mlir::Value> lbounds =
+ getNonDefaultLowerBounds(loc, builder, entity);
+ if (!lbounds.empty()) {
llvm::SmallVector<mlir::Value> indices;
mlir::Type idxTy = builder.getIndexType();
mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1);
- for (auto [oneBased, lb] : llvm::zip(oneBasedIndices, *lbounds)) {
+ for (auto [oneBased, lb] : llvm::zip(oneBasedIndices, lbounds)) {
auto lbIdx = builder.createConvert(loc, idxTy, lb);
auto oneBasedIdx = builder.createConvert(loc, idxTy, oneBased);
auto shift = builder.create<mlir::arith::SubIOp>(loc, lbIdx, one);
assert((shape.getType().isa<fir::ShapeShiftType>() ||
shape.getType().isa<fir::ShapeType>()) &&
"shape must contain extents");
- auto extents = getExplicitExtents(shape);
- auto lowers = getExplicitLbounds(shape);
+ auto extents = getExplicitExtentsFromShape(shape);
+ auto lowers = getExplicitLboundsFromShape(shape);
assert(lowers.empty() || lowers.size() == extents.size());
mlir::Type idxTy = builder.getIndexType();
mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1);
return entity;
}
+llvm::SmallVector<mlir::Value> getVariableExtents(mlir::Location loc,
+ fir::FirOpBuilder &builder,
+ hlfir::Entity variable) {
+ llvm::SmallVector<mlir::Value> extents;
+ if (fir::FortranVariableOpInterface varIface =
+ variable.getIfVariableInterface()) {
+ extents = getExplicitExtents(varIface);
+ if (!extents.empty())
+ return extents;
+ }
+
+ if (variable.isMutableBox())
+ variable = hlfir::derefPointersAndAllocatables(loc, builder, variable);
+ // Use the type shape information, and/or the fir.box/fir.class shape
+ // information if any extents are not static.
+ fir::SequenceType seqTy =
+ hlfir::getFortranElementOrSequenceType(variable.getType())
+ .cast<fir::SequenceType>();
+ mlir::Type idxTy = builder.getIndexType();
+ for (auto typeExtent : seqTy.getShape())
+ if (typeExtent != fir::SequenceType::getUnknownExtent()) {
+ extents.push_back(builder.createIntegerConstant(loc, idxTy, typeExtent));
+ } else {
+ assert(variable.getType().isa<fir::BaseBoxType>() &&
+ "array variable with dynamic extent must be boxed");
+ mlir::Value dim =
+ builder.createIntegerConstant(loc, idxTy, extents.size());
+ auto dimInfo = builder.create<fir::BoxDimsOp>(loc, idxTy, idxTy, idxTy,
+ variable, dim);
+ extents.push_back(dimInfo.getExtent());
+ }
+ return extents;
+}
+
mlir::Value hlfir::genShape(mlir::Location loc, fir::FirOpBuilder &builder,
hlfir::Entity entity) {
assert(entity.isArray() && "entity must be an array");
- if (entity.isMutableBox())
- entity = hlfir::derefPointersAndAllocatables(loc, builder, entity);
- else
- entity = followEntitySource(entity);
+ entity = followEntitySource(entity);
if (entity.getType().isa<hlfir::ExprType>()) {
if (auto elemental = entity.getDefiningOp<hlfir::ElementalOp>())
return builder.create<fir::ShapeOp>(loc, s.getExtents());
}
}
- // There is no shape lying around for this entity: build one using
- // the type shape information, and/or the fir.box/fir.class shape
- // information if any extents are not static.
- fir::SequenceType seqTy =
- hlfir::getFortranElementOrSequenceType(entity.getType())
- .cast<fir::SequenceType>();
- llvm::SmallVector<mlir::Value> extents;
- mlir::Type idxTy = builder.getIndexType();
- for (auto typeExtent : seqTy.getShape())
- if (typeExtent != fir::SequenceType::getUnknownExtent()) {
- extents.push_back(builder.createIntegerConstant(loc, idxTy, typeExtent));
- } else {
- assert(entity.getType().isa<fir::BaseBoxType>() &&
- "array variable with dynamic extent must be boxes");
- mlir::Value dim =
- builder.createIntegerConstant(loc, idxTy, extents.size());
- auto dimInfo =
- builder.create<fir::BoxDimsOp>(loc, idxTy, idxTy, idxTy, entity, dim);
- extents.push_back(dimInfo.getExtent());
- }
- return builder.create<fir::ShapeOp>(loc, extents);
+ // There is no shape lying around for this entity. Retrieve the extents and
+ // build a new fir.shape.
+ return builder.create<fir::ShapeOp>(loc,
+ getVariableExtents(loc, builder, entity));
}
llvm::SmallVector<mlir::Value>
hlfir::getIndexExtents(mlir::Location loc, fir::FirOpBuilder &builder,
mlir::Value shape) {
- llvm::SmallVector<mlir::Value> extents;
- if (auto s = shape.getDefiningOp<fir::ShapeOp>()) {
- auto e = s.getExtents();
- extents.insert(extents.end(), e.begin(), e.end());
- } else if (auto s = shape.getDefiningOp<fir::ShapeShiftOp>()) {
- auto e = s.getExtents();
- extents.insert(extents.end(), e.begin(), e.end());
- } else {
- // TODO: add fir.get_extent ops on fir.shape<> ops.
- TODO(loc, "get extents from fir.shape without fir::ShapeOp parent op");
- }
+ llvm::SmallVector<mlir::Value> extents = getExplicitExtentsFromShape(shape);
mlir::Type indexType = builder.getIndexType();
for (auto &extent : extents)
extent = builder.createConvert(loc, indexType, extent);
}
if (entity.isCharacter()) {
- auto [exv, cleanup] = translateToExtendedValue(loc, builder, entity);
- assert(!cleanup && "translation of entity should not yield cleanup");
- result.push_back(fir::factory::readCharLen(builder, loc, exv));
+ result.push_back(genCharacterVariableLength(loc, builder, entity));
return;
}
TODO(loc, "inquire PDTs length parameters in HLFIR");
hlfir::Entity hlfir::derefPointersAndAllocatables(mlir::Location loc,
fir::FirOpBuilder &builder,
Entity entity) {
- if (entity.isMutableBox())
- return hlfir::Entity{builder.create<fir::LoadOp>(loc, entity).getResult()};
+ if (entity.isMutableBox()) {
+ hlfir::Entity boxLoad{builder.create<fir::LoadOp>(loc, entity)};
+ if (entity.isScalar()) {
+ mlir::Type elementType = boxLoad.getFortranElementType();
+ if (fir::isa_trivial(elementType))
+ return hlfir::Entity{builder.create<fir::BoxAddrOp>(loc, boxLoad)};
+ if (auto charType = elementType.dyn_cast<fir::CharacterType>()) {
+ mlir::Value base = builder.create<fir::BoxAddrOp>(loc, boxLoad);
+ if (charType.hasConstantLen())
+ return hlfir::Entity{base};
+ mlir::Value len = genCharacterVariableLength(loc, builder, entity);
+ auto boxCharType =
+ fir::BoxCharType::get(builder.getContext(), charType.getFKind());
+ return hlfir::Entity{
+ builder.create<fir::EmboxCharOp>(loc, boxCharType, base, len)
+ .getResult()};
+ }
+ }
+ // Keep the entity boxed for now.
+ return boxLoad;
+ }
return entity;
}
builder.restoreInsertionPoint(insPt);
return {innerLoop, indices};
}
+
+static fir::ExtendedValue
+translateVariableToExtendedValue(mlir::Location loc, fir::FirOpBuilder &builder,
+ hlfir::Entity variable) {
+ assert(variable.isVariable() && "must be a variable");
+ /// When going towards FIR, use the original base value to avoid
+ /// introducing descriptors at runtime when they are not required.
+ mlir::Value firBase = variable.getFirBase();
+ if (variable.isMutableBox())
+ return fir::MutableBoxValue(firBase, getExplicitTypeParams(variable),
+ fir::MutableProperties{});
+
+ if (firBase.getType().isa<fir::BaseBoxType>()) {
+ if (!variable.isSimplyContiguous() || variable.isPolymorphic() ||
+ variable.isDerivedWithLengthParameters()) {
+ llvm::SmallVector<mlir::Value> nonDefaultLbounds =
+ getNonDefaultLowerBounds(loc, builder, variable);
+ return fir::BoxValue(firBase, nonDefaultLbounds,
+ getExplicitTypeParams(variable));
+ }
+ // Otherwise, the variable can be represented in a fir::ExtendedValue
+ // without the overhead of a fir.box.
+ firBase = genVariableRawAddress(loc, builder, variable);
+ }
+
+ if (variable.isScalar()) {
+ if (variable.isCharacter()) {
+ if (firBase.getType().isa<fir::BoxCharType>())
+ return genUnboxChar(loc, builder, firBase);
+ mlir::Value len = genCharacterVariableLength(loc, builder, variable);
+ return fir::CharBoxValue{firBase, len};
+ }
+ return firBase;
+ }
+ llvm::SmallVector<mlir::Value> extents;
+ llvm::SmallVector<mlir::Value> nonDefaultLbounds;
+ if (variable.getType().isa<fir::BaseBoxType>() &&
+ !variable.getIfVariableInterface()) {
+ // This special case avoids generating two generating to sets of identical
+ // fir.box_dim to get both the lower bounds and extents.
+ genLboundsAndExtentsFromBox(loc, builder, variable, nonDefaultLbounds,
+ &extents);
+ } else {
+ extents = getVariableExtents(loc, builder, variable);
+ nonDefaultLbounds = getNonDefaultLowerBounds(loc, builder, variable);
+ }
+ if (variable.isCharacter())
+ return fir::CharArrayBoxValue{
+ firBase, genCharacterVariableLength(loc, builder, variable), extents,
+ nonDefaultLbounds};
+ return fir::ArrayBoxValue{firBase, extents, nonDefaultLbounds};
+}
+
+fir::ExtendedValue
+hlfir::translateToExtendedValue(mlir::Location loc, fir::FirOpBuilder &builder,
+ fir::FortranVariableOpInterface var) {
+ return translateVariableToExtendedValue(loc, builder, var);
+}
+
+std::pair<fir::ExtendedValue, std::optional<hlfir::CleanupFunction>>
+hlfir::translateToExtendedValue(mlir::Location loc, fir::FirOpBuilder &builder,
+ hlfir::Entity entity) {
+ if (entity.isVariable())
+ return {translateVariableToExtendedValue(loc, builder, entity),
+ std::nullopt};
+
+ if (entity.getType().isa<hlfir::ExprType>()) {
+ hlfir::AssociateOp associate = hlfir::genAssociateExpr(
+ loc, builder, entity, entity.getType(), "adapt.valuebyref");
+ auto *bldr = &builder;
+ hlfir::CleanupFunction cleanup = [bldr, loc, associate]() -> void {
+ bldr->create<hlfir::EndAssociateOp>(loc, associate);
+ };
+ hlfir::Entity temp{associate.getBase()};
+ return {translateToExtendedValue(loc, builder, temp).first, cleanup};
+ }
+ return {{static_cast<mlir::Value>(entity)}, {}};
+}
--- /dev/null
+! Test lowering of whole allocatable and pointers to HLFIR
+! RUN: bbc -emit-fir -hlfir -o - %s 2>&1 | FileCheck %s
+
+subroutine passing_allocatable(x)
+ interface
+ subroutine takes_allocatable(y)
+ real, allocatable :: y(:)
+ end subroutine
+ subroutine takes_array(y)
+ real :: y(*)
+ end subroutine
+ end interface
+ real, allocatable :: x(:)
+ call takes_allocatable(x)
+ call takes_array(x)
+end subroutine
+! CHECK-LABEL: func.func @_QPpassing_allocatable(
+! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs<allocatable>, uniq_name = {{.*}}Ex"}
+! CHECK: fir.call @_QPtakes_allocatable(%[[VAL_1]]#0) {{.*}} : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>) -> ()
+! CHECK: %[[VAL_2:.*]] = fir.load %[[VAL_1]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>
+! CHECK: %[[VAL_3:.*]] = fir.box_addr %[[VAL_2]] : (!fir.box<!fir.heap<!fir.array<?xf32>>>) -> !fir.heap<!fir.array<?xf32>>
+! CHECK: %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.heap<!fir.array<?xf32>>) -> !fir.ref<!fir.array<?xf32>>
+! CHECK: fir.call @_QPtakes_array(%[[VAL_4]]) {{.*}} : (!fir.ref<!fir.array<?xf32>>) -> ()
+
+subroutine passing_pointer(x)
+ interface
+ subroutine takes_pointer(y)
+ real, pointer :: y(:)
+ end subroutine
+ end interface
+ real, pointer :: x(:)
+ call takes_pointer(x)
+ call takes_pointer(NULL())
+end subroutine
+! CHECK-LABEL: func.func @_QPpassing_pointer(
+! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?xf32>>>
+! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = {{.*}}Ex"}
+! CHECK: fir.call @_QPtakes_pointer(%[[VAL_2]]#0) {{.*}} : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>) -> ()
+! CHECK: %[[VAL_3:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xf32>>
+! CHECK: %[[VAL_4:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_5:.*]] = fir.shape %[[VAL_4]] : (index) -> !fir.shape<1>
+! CHECK: %[[VAL_6:.*]] = fir.embox %[[VAL_3]](%[[VAL_5]]) : (!fir.ptr<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
+! CHECK: fir.store %[[VAL_6]] to %[[VAL_1]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
+! CHECK: fir.call @_QPtakes_pointer(%[[VAL_1]]) {{.*}} : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>) -> ()
+
+subroutine passing_contiguous_pointer(x)
+ interface
+ subroutine takes_array(y)
+ real :: y(*)
+ end subroutine
+ end interface
+ real, pointer, contiguous :: x(:)
+ call takes_array(x)
+end subroutine
+! CHECK-LABEL: func.func @_QPpassing_contiguous_pointer(
+! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs<contiguous, pointer>, uniq_name = {{.*}}Ex"}
+! CHECK: %[[VAL_2:.*]] = fir.load %[[VAL_1]]#0 : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
+! CHECK: %[[VAL_3:.*]] = fir.box_addr %[[VAL_2]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.ptr<!fir.array<?xf32>>
+! CHECK: %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.ptr<!fir.array<?xf32>>) -> !fir.ref<!fir.array<?xf32>>
+! CHECK: fir.call @_QPtakes_array(%[[VAL_4]]) {{.*}} : (!fir.ref<!fir.array<?xf32>>) -> ()
+
+subroutine character_allocatable_cst_len(x)
+ character(10), allocatable :: x
+ call takes_char(x)
+ call takes_char(x//"hello")
+end subroutine
+! CHECK-LABEL: func.func @_QPcharacter_allocatable_cst_len(
+! CHECK: %[[VAL_1:.*]] = arith.constant 10 : index
+! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] typeparams %[[VAL_1:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs<allocatable>, uniq_name = {{.*}}Ex"}
+! CHECK: %[[VAL_3:.*]] = fir.load %[[VAL_2]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.char<1,10>>>>
+! CHECK: %[[VAL_4:.*]] = fir.box_addr %[[VAL_3]] : (!fir.box<!fir.heap<!fir.char<1,10>>>) -> !fir.heap<!fir.char<1,10>>
+! CHECK: %[[VAL_5:.*]] = arith.constant 10 : index
+! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_4]] : (!fir.heap<!fir.char<1,10>>) -> !fir.ref<!fir.char<1,10>>
+! CHECK: %[[VAL_7:.*]] = fir.emboxchar %[[VAL_6]], %[[VAL_5]] : (!fir.ref<!fir.char<1,10>>, index) -> !fir.boxchar<1>
+! CHECK: fir.call @_QPtakes_char(%[[VAL_7]]) {{.*}} : (!fir.boxchar<1>) -> ()
+! CHECK: %[[VAL_8:.*]] = fir.load %[[VAL_2]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.char<1,10>>>>
+! CHECK: %[[VAL_9:.*]] = fir.box_addr %[[VAL_8]] : (!fir.box<!fir.heap<!fir.char<1,10>>>) -> !fir.heap<!fir.char<1,10>>
+! CHECK: %[[VAL_12:.*]]:2 = hlfir.declare %[[VAL_10:[a-z0-9]*]] typeparams %[[VAL_11:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs<parameter>
+! CHECK: %[[VAL_13:.*]] = arith.constant 10 : index
+! CHECK: %[[VAL_14:.*]] = arith.addi %[[VAL_13]], %[[VAL_11]] : index
+! CHECK: %[[VAL_15:.*]] = hlfir.concat %[[VAL_9]], %[[VAL_12]]#0 len %[[VAL_14]] : (!fir.heap<!fir.char<1,10>>, !fir.ref<!fir.char<1,5>>, index) -> !hlfir.expr<!fir.char<1,15>>
+
+subroutine character_allocatable_dyn_len(x, l)
+ integer(8) :: l
+ character(l), allocatable :: x
+ call takes_char(x)
+ call takes_char(x//"hello")
+end subroutine
+! CHECK-LABEL: func.func @_QPcharacter_allocatable_dyn_len(
+! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_1:[a-z0-9]*]] {uniq_name = {{.*}}El"}
+! CHECK: %[[VAL_3:.*]] = fir.load %[[VAL_2]]#0 : !fir.ref<i64>
+! CHECK: %[[VAL_4:.*]] = arith.constant 0 : i64
+! CHECK: %[[VAL_5:.*]] = arith.cmpi sgt, %[[VAL_3]], %[[VAL_4]] : i64
+! CHECK: %[[VAL_6:.*]] = arith.select %[[VAL_5]], %[[VAL_3]], %[[VAL_4]] : i64
+! CHECK: %[[VAL_7:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] typeparams %[[VAL_6:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs<allocatable>, uniq_name = {{.*}}Ex"}
+! CHECK: %[[VAL_8:.*]] = fir.load %[[VAL_7]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>
+! CHECK: %[[VAL_9:.*]] = fir.box_addr %[[VAL_8]] : (!fir.box<!fir.heap<!fir.char<1,?>>>) -> !fir.heap<!fir.char<1,?>>
+! CHECK: %[[VAL_10:.*]] = fir.emboxchar %[[VAL_9]], %[[VAL_6]] : (!fir.heap<!fir.char<1,?>>, i64) -> !fir.boxchar<1>
+! CHECK: fir.call @_QPtakes_char(%[[VAL_10]]) {{.*}} : (!fir.boxchar<1>) -> ()
+! CHECK: %[[VAL_11:.*]] = fir.load %[[VAL_7]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>
+! CHECK: %[[VAL_12:.*]] = fir.box_addr %[[VAL_11]] : (!fir.box<!fir.heap<!fir.char<1,?>>>) -> !fir.heap<!fir.char<1,?>>
+! CHECK: %[[VAL_13:.*]] = fir.emboxchar %[[VAL_12]], %[[VAL_6]] : (!fir.heap<!fir.char<1,?>>, i64) -> !fir.boxchar<1>
+! CHECK: %[[VAL_16:.*]]:2 = hlfir.declare %[[VAL_14:[a-z0-9]*]] typeparams %[[VAL_15:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs<parameter>
+! CHECK: %[[VAL_17:.*]] = fir.convert %[[VAL_6]] : (i64) -> index
+! CHECK: %[[VAL_18:.*]] = arith.addi %[[VAL_17]], %[[VAL_15]] : index
+! CHECK: %[[VAL_19:.*]] = hlfir.concat %[[VAL_13]], %[[VAL_16]]#0 len %[[VAL_18]] : (!fir.boxchar<1>, !fir.ref<!fir.char<1,5>>, index) -> !hlfir.expr<!fir.char<1,?>>
+
+subroutine print_allocatable(x)
+ real, allocatable :: x(:)
+ print *, x
+end subroutine
+! CHECK-LABEL: func.func @_QPprint_allocatable(
+! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs<allocatable>, uniq_name = {{.*}}Ex"}
+! CHECK: %[[VAL_7:.*]] = fir.load %[[VAL_1]]#1 : !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>
+! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (!fir.box<!fir.heap<!fir.array<?xf32>>>) -> !fir.box<none>
+! CHECK: %[[VAL_9:.*]] = fir.call @_FortranAioOutputDescriptor(%{{.*}}, %[[VAL_8]])
+
+subroutine print_pointer(x)
+ real, pointer :: x(:)
+ print *, x
+end subroutine
+! CHECK-LABEL: func.func @_QPprint_pointer(
+! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = {{.*}}Ex"}
+! CHECK: %[[VAL_7:.*]] = fir.load %[[VAL_1]]#1 : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
+! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.box<none>
+! CHECK: %[[VAL_9:.*]] = fir.call @_FortranAioOutputDescriptor(%{{.*}}, %[[VAL_8]])
+
+subroutine elemental_expr(x)
+ integer, pointer :: x(:, :)
+ call takes_array_2(x+42)
+end subroutine
+! CHECK-LABEL: func.func @_QPelemental_expr(
+! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = {{.*}}Ex"}
+! CHECK: %[[VAL_2:.*]] = fir.load %[[VAL_1]]#0 : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xi32>>>>
+! CHECK: %[[VAL_3:.*]] = arith.constant 42 : i32
+! CHECK: %[[VAL_4:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_5:.*]]:3 = fir.box_dims %[[VAL_2]], %[[VAL_4]] : (!fir.box<!fir.ptr<!fir.array<?x?xi32>>>, index) -> (index, index, index)
+! CHECK: %[[VAL_6:.*]] = arith.constant 1 : index
+! CHECK: %[[VAL_7:.*]]:3 = fir.box_dims %[[VAL_2]], %[[VAL_6]] : (!fir.box<!fir.ptr<!fir.array<?x?xi32>>>, index) -> (index, index, index)
+! CHECK: %[[VAL_8:.*]] = fir.shape %[[VAL_5]]#1, %[[VAL_7]]#1 : (index, index) -> !fir.shape<2>
+! CHECK: %[[VAL_9:.*]] = hlfir.elemental %[[VAL_8]] : (!fir.shape<2>) -> !hlfir.expr<?x?xi32> {
+! CHECK: ^bb0(%[[VAL_10:.*]]: index, %[[VAL_11:.*]]: index):
+! CHECK: %[[VAL_12:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_13:.*]]:3 = fir.box_dims %[[VAL_2]], %[[VAL_12]] : (!fir.box<!fir.ptr<!fir.array<?x?xi32>>>, index) -> (index, index, index)
+! CHECK: %[[VAL_14:.*]] = arith.constant 1 : index
+! CHECK: %[[VAL_15:.*]]:3 = fir.box_dims %[[VAL_2]], %[[VAL_14]] : (!fir.box<!fir.ptr<!fir.array<?x?xi32>>>, index) -> (index, index, index)
+! CHECK: %[[VAL_16:.*]] = arith.constant 1 : index
+! CHECK: %[[VAL_17:.*]] = arith.subi %[[VAL_13]]#0, %[[VAL_16]] : index
+! CHECK: %[[VAL_18:.*]] = arith.addi %[[VAL_10]], %[[VAL_17]] : index
+! CHECK: %[[VAL_19:.*]] = arith.subi %[[VAL_15]]#0, %[[VAL_16]] : index
+! CHECK: %[[VAL_20:.*]] = arith.addi %[[VAL_11]], %[[VAL_19]] : index
+! CHECK: %[[VAL_21:.*]] = hlfir.designate %[[VAL_2]] (%[[VAL_18]], %[[VAL_20]]) : (!fir.box<!fir.ptr<!fir.array<?x?xi32>>>, index, index) -> !fir.ref<i32>
+! CHECK: %[[VAL_22:.*]] = fir.load %[[VAL_21]] : !fir.ref<i32>
+! CHECK: %[[VAL_23:.*]] = arith.addi %[[VAL_22]], %[[VAL_3]] : i32
+! CHECK: hlfir.yield_element %[[VAL_23]] : i32
+! CHECK: }