[flang-commits] [flang] [flang][lowering] fix vector subscripts in character elemental procedures (PR #156661)
via flang-commits
flang-commits at lists.llvm.org
Fri Sep 5 02:35:05 PDT 2025
https://github.com/jeanPerier updated https://github.com/llvm/llvm-project/pull/156661
>From 357f2b6457bf8543c56f488d707bb629f2fa7b84 Mon Sep 17 00:00:00 2001
From: Jean Perier <jperier at nvidia.com>
Date: Wed, 3 Sep 2025 05:49:57 -0700
Subject: [PATCH 1/2] [flang][lowering] fix vector subscripts in character
elemental procedures
---
flang/include/flang/Lower/HlfirIntrinsics.h | 5 ++
flang/lib/Lower/ConvertCall.cpp | 58 ++++++++++++++++++-
.../test/Lower/array-elemental-calls-char.f90 | 50 +++++++++++++++-
3 files changed, 109 insertions(+), 4 deletions(-)
diff --git a/flang/include/flang/Lower/HlfirIntrinsics.h b/flang/include/flang/Lower/HlfirIntrinsics.h
index 088f8bccef4aa..89aad7f462aba 100644
--- a/flang/include/flang/Lower/HlfirIntrinsics.h
+++ b/flang/include/flang/Lower/HlfirIntrinsics.h
@@ -50,9 +50,14 @@ struct PreparedActualArgument {
: actual{actual}, isPresent{isPresent} {}
PreparedActualArgument(hlfir::ElementalAddrOp vectorSubscriptedActual)
: actual{vectorSubscriptedActual}, isPresent{std::nullopt} {}
+
void setElementalIndices(mlir::ValueRange &indices) {
oneBasedElementalIndices = &indices;
}
+ void resetElementalIndices() { oneBasedElementalIndices = nullptr; }
+ bool hasElementalIndices() const {
+ return oneBasedElementalIndices != nullptr;
+ }
/// Get the prepared actual. If this is an array argument in an elemental
/// call, the current element value will be returned.
diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index 04dcc9250be61..c6a705a007b6a 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -903,6 +903,15 @@ struct CallContext {
return false;
}
+ int getRankIfElementalProcWithArrayArgs() const {
+ if (procRef.IsElemental())
+ for (const std::optional<Fortran::evaluate::ActualArgument> &arg :
+ procRef.arguments())
+ if (arg && arg->Rank() != 0)
+ return arg->Rank();
+ return 0;
+ }
+
/// Is this a statement function reference?
bool isStatementFunctionCall() const {
if (const Fortran::semantics::Symbol *symbol = procRef.proc().GetSymbol())
@@ -2367,10 +2376,37 @@ class ElementalUserCallBuilder
auto &converter = callContext.converter;
mlir::Type idxTy = builder.getIndexType();
llvm::SmallVector<CallCleanUp> callCleanUps;
+ llvm::SmallVector<mlir::Value> mockIndices;
+ mlir::ValueRange mockIndicesRange;
+
+ // If this is an elemental call, evaluate the specification expressions
+ // using the first elements of dummy arguments. The address of these
+ // elements will not be read thanks to Fortran 2023 C15121 (dummy
+ // arguments can only be inquired about inside the specification for the
+ // result), so no care is needed for the zero size array case.
+ bool mustResetElementalIndices = false;
+ if (int elementalRank = callContext.getRankIfElementalProcWithArrayArgs()) {
+ mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1);
+ mockIndices.assign(elementalRank, one);
+ mockIndicesRange = mockIndices;
+ for (auto &preparedActual : loweredActuals)
+ if (preparedActual) {
+ assert(
+ !preparedActual->hasElementalIndices() &&
+ "result length must be computed before the elemental loop nest");
+ preparedActual->setElementalIndices(mockIndicesRange);
+ }
+ mustResetElementalIndices = true;
+ }
prepareUserCallArguments(loweredActuals, caller, callSiteType, callContext,
callCleanUps);
+ if (mustResetElementalIndices)
+ for (auto &preparedActual : loweredActuals)
+ if (preparedActual)
+ preparedActual->resetElementalIndices();
+
callContext.symMap.pushScope();
// Map prepared argument to dummy symbol to be able to lower spec expr.
@@ -2381,7 +2417,7 @@ class ElementalUserCallBuilder
fir::ExtendedValue exv = Fortran::lower::translateToExtendedValue(
loc, builder, hlfir::Entity{input}, callContext.stmtCtx);
fir::FortranVariableOpInterface variableIface = hlfir::genDeclare(
- loc, builder, exv, "dummy.tmp", fir::FortranVariableFlagsAttr{});
+ loc, builder, exv, "mock.dummy", fir::FortranVariableFlagsAttr{});
callContext.symMap.addVariableDefinition(*sym, variableIface);
}
@@ -2769,11 +2805,24 @@ genIntrinsicRef(const Fortran::evaluate::SpecificIntrinsic *intrinsic,
return genIntrinsicRef(intrinsic, *intrinsicEntry, callContext);
}
+namespace {
+/// Helper to erase temporary ElementalAddrOp created for vector subscripted
+/// arguments of elemental procedures using C++ lifetime scopes.
+struct ElementalAddrEraser {
+ ~ElementalAddrEraser() {
+ for (hlfir::ElementalAddrOp elementalAddr : elementalAddrOps)
+ elementalAddr.erase();
+ }
+ llvm::SmallVector<hlfir::ElementalAddrOp> elementalAddrOps;
+};
+} // namespace
+
/// Main entry point to lower procedure references, regardless of what they are.
static std::optional<hlfir::EntityWithAttributes>
genProcedureRef(CallContext &callContext) {
mlir::Location loc = callContext.loc;
fir::FirOpBuilder &builder = callContext.getBuilder();
+ ElementalAddrEraser elementalAddrEraser;
if (auto *intrinsic = callContext.procRef.proc().GetSpecificIntrinsic())
return genIntrinsicRef(intrinsic, callContext);
// Intercept non BIND(C) module procedure reference that have lowering
@@ -2856,6 +2905,12 @@ genProcedureRef(CallContext &callContext) {
Fortran::lower::convertVectorSubscriptedExprToElementalAddr(
loc, callContext.converter, *expr, callContext.symMap,
callContext.stmtCtx);
+ // ElementalAddrOp bodies will be copied as needed when generating the
+ // elemental calls to generate the operand element addressing and the
+ // operation must be erased afterwards (cannot wait on dead code
+ // elimination because these operations are invalid outside of
+ // hlfir.region_assign contexts).
+ elementalAddrEraser.elementalAddrOps.push_back(elementalAddr);
loweredActuals.emplace_back(
Fortran::lower::PreparedActualArgument{elementalAddr});
continue;
@@ -2905,7 +2960,6 @@ hlfir::Entity Fortran::lower::PreparedActualArgument::getActual(
loc, builder, elementalAddr, *oneBasedElementalIndices, mapper,
/*mustRecursivelyInline=*/alwaysFalse);
assert(elementalAddr.getCleanup().empty() && "no clean-up expected");
- elementalAddr.erase();
return hlfir::Entity{addr};
}
diff --git a/flang/test/Lower/array-elemental-calls-char.f90 b/flang/test/Lower/array-elemental-calls-char.f90
index 4ee1165ae3219..dce5c0ae625a4 100644
--- a/flang/test/Lower/array-elemental-calls-char.f90
+++ b/flang/test/Lower/array-elemental-calls-char.f90
@@ -240,8 +240,9 @@ subroutine foo6(c)
! CHECK: %[[VAL_4:.*]] = arith.constant 10 : index
! CHECK: %[[VAL_5:.*]] = fir.shape %[[VAL_4]] : (index) -> !fir.shape<1>
! CHECK: %[[VAL_6:.*]]:2 = hlfir.declare %[[VAL_3]](%[[VAL_5]]) typeparams %[[VAL_2]]#1 dummy_scope %[[VAL_1]] {uniq_name = "_QMchar_elemFfoo6Ec"} : (!fir.ref<!fir.array<10x!fir.char<1,?>>>, !fir.shape<1>, index, !fir.dscope) -> (!fir.box<!fir.array<10x!fir.char<1,?>>>, !fir.ref<!fir.array<10x!fir.char<1,?>>>)
-! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_6]]#1 : (!fir.ref<!fir.array<10x!fir.char<1,?>>>) -> !fir.ref<!fir.char<1,?>>
-! CHECK: %[[VAL_8:.*]]:2 = hlfir.declare %[[VAL_7]] typeparams %[[VAL_2]]#1 {uniq_name = "dummy.tmp"} : (!fir.ref<!fir.char<1,?>>, index) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>)
+! CHECK: %[[VAL_7:.*]] = hlfir.designate %[[VAL_6:.*]]#0 (%c1) typeparams %1#1 : (!fir.box<!fir.array<10x!fir.char<1,?>>>, index, index) -> !fir.boxchar<1>
+! CHECK: %[[VAL_7B:.*]]:2 = fir.unboxchar %[[VAL_7]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+! CHECK: %[[VAL_8:.*]]:2 = hlfir.declare %[[VAL_7B]]#0 typeparams %[[VAL_2]]#1 {uniq_name = "mock.dummy"} : (!fir.ref<!fir.char<1,?>>, index) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>)
! CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_2]]#1 : (index) -> i64
! CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_9]] : (i64) -> i32
! CHECK: %[[VAL_11:.*]] = fir.convert %[[VAL_10]] : (i32) -> i64
@@ -274,3 +275,48 @@ subroutine foo6(c)
! CHECK: }
end module
+
+subroutine bug_145151(c, vector_subscript)
+ interface
+ elemental function f(c_dummy)
+ character(*), intent(in) :: c_dummy
+ character(len(c_dummy, KIND=8)) :: f
+ end
+ end interface
+ integer(8) :: vector_subscript(100)
+ character(*) :: c(100)
+ c = f(c(vector_subscript))
+end subroutine
+! CHECK-LABEL: func.func @_QPbug_145151(
+! CHECK-SAME: %[[ARG0:.*]]: !fir.boxchar<1>
+! CHECK: %[[VAL_1:.*]]:2 = fir.unboxchar %[[ARG0]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+! CHECK: %[[VAL_2:.*]] = fir.convert %[[VAL_1]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.array<100x!fir.char<1,?>>>
+! CHECK: %[[VAL_3:.*]] = arith.constant 100 : index
+! CHECK: %[[VAL_4:.*]] = fir.shape %[[VAL_3]] : (index) -> !fir.shape<1>
+! CHECK: %[[VAL_5:.*]]:2 = hlfir.declare %{{.*}}"_QFbug_145151Ec"} : (!fir.ref<!fir.array<100x!fir.char<1,?>>>,
+! CHECK: %[[VAL_10:.*]]:2 = hlfir.declare %{{.*}}"_QFbug_145151Evector_subscript"} : (!fir.ref<!fir.array<100xi64>>,
+! CHECK: %[[VAL_11:.*]] = arith.constant 100 : index
+! CHECK: %[[VAL_12:.*]] = fir.shape %[[VAL_11]] : (index) -> !fir.shape<1>
+! CHECK: %[[VAL_13:.*]] = arith.constant 1 : index
+! CHECK: %[[VAL_14:.*]] = hlfir.designate %[[VAL_10]]#0 (%[[VAL_13]]) : (!fir.ref<!fir.array<100xi64>>, index) -> !fir.ref<i64>
+! CHECK: %[[VAL_15:.*]] = fir.load %[[VAL_14]] : !fir.ref<i64>
+! CHECK: %[[VAL_16:.*]] = hlfir.designate %[[VAL_5]]#0 (%[[VAL_15]]) typeparams %[[VAL_1]]#1 : (!fir.box<!fir.array<100x!fir.char<1,?>>>, i64, index) -> !fir.boxchar<1>
+! CHECK: %[[VAL_17:.*]]:2 = fir.unboxchar %[[VAL_16]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+! CHECK: %[[VAL_18:.*]]:2 = hlfir.declare %[[VAL_17]]#0 typeparams %[[VAL_1]]#1 {uniq_name = "mock.dummy"} : (!fir.ref<!fir.char<1,?>>, index) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>)
+! CHECK: %[[VAL_19:.*]] = fir.convert %[[VAL_1]]#1 : (index) -> i64
+! CHECK: %[[VAL_22:.*]] = fir.convert %[[VAL_19]] : (i64) -> index
+! CHECK: %[[VAL_23:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_24:.*]] = arith.cmpi sgt, %[[VAL_22]], %[[VAL_23]] : index
+! CHECK: %[[VAL_25:.*]] = arith.select %[[VAL_24]], %[[VAL_22]], %[[VAL_23]] : index
+! CHECK: %[[VAL_26:.*]] = hlfir.elemental %[[VAL_12]] typeparams %[[VAL_25]] unordered : (!fir.shape<1>, index) -> !hlfir.expr<100x!fir.char<1,?>> {
+! CHECK: ^bb0(%[[VAL_27:.*]]: index):
+! CHECK: %[[VAL_28:.*]] = hlfir.designate %[[VAL_10]]#0 (%[[VAL_27]]) : (!fir.ref<!fir.array<100xi64>>, index) -> !fir.ref<i64>
+! CHECK: %[[VAL_29:.*]] = fir.load %[[VAL_28]] : !fir.ref<i64>
+! CHECK: %[[VAL_30:.*]] = hlfir.designate %[[VAL_5]]#0 (%[[VAL_29]]) typeparams %[[VAL_1]]#1 : (!fir.box<!fir.array<100x!fir.char<1,?>>>, i64, index) -> !fir.boxchar<1>
+! CHECK: %[[VAL_41:.*]] = fir.call @_QPf(
+! CHECK: hlfir.yield_element %{{.*}} : !hlfir.expr<!fir.char<1,?>>
+! CHECK: }
+! CHECK: hlfir.assign %[[VAL_26]] to %[[VAL_5]]#0 : !hlfir.expr<100x!fir.char<1,?>>, !fir.box<!fir.array<100x!fir.char<1,?>>>
+! CHECK: hlfir.destroy %[[VAL_26]] : !hlfir.expr<100x!fir.char<1,?>>
+! CHECK: return
+! CHECK: }
>From 383eeee5b4495ee2d943efc0173e322e1bf39002 Mon Sep 17 00:00:00 2001
From: Jean Perier <jperier at nvidia.com>
Date: Fri, 5 Sep 2025 00:15:37 -0700
Subject: [PATCH 2/2] create mock arguments instead of addressing the actual
argument
---
flang/include/flang/Lower/HlfirIntrinsics.h | 16 +-
flang/lib/Lower/ConvertCall.cpp | 227 +++++++++-----
.../test/Lower/HLFIR/elemental-array-ops.f90 | 9 +-
.../Lower/HLFIR/elemental-result-length.f90 | 20 +-
.../array-elemental-calls-char-dynamic.f90 | 291 ++++++++++++++++++
.../test/Lower/array-elemental-calls-char.f90 | 65 +---
6 files changed, 470 insertions(+), 158 deletions(-)
create mode 100644 flang/test/Lower/array-elemental-calls-char-dynamic.f90
diff --git a/flang/include/flang/Lower/HlfirIntrinsics.h b/flang/include/flang/Lower/HlfirIntrinsics.h
index 89aad7f462aba..f01f1c7dcd9bb 100644
--- a/flang/include/flang/Lower/HlfirIntrinsics.h
+++ b/flang/include/flang/Lower/HlfirIntrinsics.h
@@ -50,14 +50,9 @@ struct PreparedActualArgument {
: actual{actual}, isPresent{isPresent} {}
PreparedActualArgument(hlfir::ElementalAddrOp vectorSubscriptedActual)
: actual{vectorSubscriptedActual}, isPresent{std::nullopt} {}
-
void setElementalIndices(mlir::ValueRange &indices) {
oneBasedElementalIndices = &indices;
}
- void resetElementalIndices() { oneBasedElementalIndices = nullptr; }
- bool hasElementalIndices() const {
- return oneBasedElementalIndices != nullptr;
- }
/// Get the prepared actual. If this is an array argument in an elemental
/// call, the current element value will be returned.
@@ -110,6 +105,17 @@ struct PreparedActualArgument {
return typeParams[0];
}
+ void genLengthParameters(mlir::Location loc, fir::FirOpBuilder &builder,
+ llvm::SmallVectorImpl<mlir::Value> &result) {
+ if (auto *actualEntity = std::get_if<hlfir::Entity>(&actual)) {
+ hlfir::genLengthParameters(loc, builder, *actualEntity, result);
+ return;
+ }
+ for (mlir::Value len :
+ std::get<hlfir::ElementalAddrOp>(actual).getTypeparams())
+ result.push_back(len);
+ }
+
/// When the argument is polymorphic, get mold value with the same dynamic
/// type.
mlir::Value getPolymorphicMold(mlir::Location loc) const {
diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index c6a705a007b6a..454570a544222 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -287,6 +287,16 @@ static void remapActualToDummyDescriptors(
}
}
+static void
+getResultLengthFromElementalOp(fir::FirOpBuilder &builder,
+ llvm::SmallVectorImpl<mlir::Value> &lengths) {
+ auto elemental = llvm::dyn_cast_or_null<hlfir::ElementalOp>(
+ builder.getInsertionBlock()->getParentOp());
+ if (elemental)
+ for (mlir::Value len : elemental.getTypeparams())
+ lengths.push_back(len);
+}
+
std::pair<Fortran::lower::LoweredResult, bool>
Fortran::lower::genCallOpAndResult(
mlir::Location loc, Fortran::lower::AbstractConverter &converter,
@@ -296,7 +306,13 @@ Fortran::lower::genCallOpAndResult(
fir::FirOpBuilder &builder = converter.getFirOpBuilder();
using PassBy = Fortran::lower::CallerInterface::PassEntityBy;
bool mustPopSymMap = false;
- if (caller.mustMapInterfaceSymbolsForResult()) {
+
+ llvm::SmallVector<mlir::Value> resultLengths;
+ if (isElemental)
+ getResultLengthFromElementalOp(builder, resultLengths);
+ if (caller.mustMapInterfaceSymbolsForResult() && resultLengths.empty()) {
+ // Do not map the dummy symbols again inside the loop to compute elemental
+ // function result whose length was already computed outside of the loop.
symMap.pushScope();
mustPopSymMap = true;
Fortran::lower::mapCallInterfaceSymbolsForResult(converter, caller, symMap);
@@ -340,7 +356,6 @@ Fortran::lower::genCallOpAndResult(
loc, idxTy, fir::getBase(converter.genExprValue(expr, stmtCtx)));
return fir::factory::genMaxWithZero(builder, loc, convertExpr);
};
- llvm::SmallVector<mlir::Value> resultLengths;
mlir::Value arrayResultShape;
hlfir::EvaluateInMemoryOp evaluateInMemory;
auto allocatedResult = [&]() -> std::optional<fir::ExtendedValue> {
@@ -355,11 +370,16 @@ Fortran::lower::genCallOpAndResult(
assert(!isAssumedSizeExtent && "result cannot be assumed-size");
extents.emplace_back(lowerSpecExpr(e));
});
- caller.walkResultLengths(
- [&](const Fortran::lower::SomeExpr &e, bool isAssumedSizeExtent) {
- assert(!isAssumedSizeExtent && "result cannot be assumed-size");
- lengths.emplace_back(lowerSpecExpr(e));
- });
+ if (resultLengths.empty()) {
+ caller.walkResultLengths(
+ [&](const Fortran::lower::SomeExpr &e, bool isAssumedSizeExtent) {
+ assert(!isAssumedSizeExtent && "result cannot be assumed-size");
+ lengths.emplace_back(lowerSpecExpr(e));
+ });
+ } else {
+ // Use lengths precomputed before elemental loops.
+ lengths = resultLengths;
+ }
// Result length parameters should not be provided to box storage
// allocation and save_results, but they are still useful information to
@@ -903,15 +923,6 @@ struct CallContext {
return false;
}
- int getRankIfElementalProcWithArrayArgs() const {
- if (procRef.IsElemental())
- for (const std::optional<Fortran::evaluate::ActualArgument> &arg :
- procRef.arguments())
- if (arg && arg->Rank() != 0)
- return arg->Rank();
- return 0;
- }
-
/// Is this a statement function reference?
bool isStatementFunctionCall() const {
if (const Fortran::semantics::Symbol *symbol = procRef.proc().GetSymbol())
@@ -2339,6 +2350,47 @@ class ElementalCallBuilder {
}
};
+/// Helper for computing elemental function result specification
+/// expressions that depends on dummy symbols. See
+/// computeDynamicCharacterResultLength below.
+static mlir::Value genMockDummyForElementalResultSpecifications(
+ fir::FirOpBuilder &builder, mlir::Location loc, mlir::Type dummyType,
+ Fortran::lower::PreparedActualArgument &preparedActual) {
+ // One is used as the mock address instead of NULL so that PRESENT inquires
+ // work (this is the only valid thing that specification can do with the
+ // address thanks to Fortran 2023 C15121).
+ mlir::Value one =
+ builder.createIntegerConstant(loc, builder.getIntPtrType(), 1);
+ if (auto boxCharType = llvm::dyn_cast<fir::BoxCharType>(dummyType)) {
+ mlir::Value addr = builder.createConvert(
+ loc, fir::ReferenceType::get(boxCharType.getEleTy()), one);
+ mlir::Value len = preparedActual.genCharLength(loc, builder);
+ return fir::EmboxCharOp::create(builder, loc, boxCharType, addr, len);
+ }
+ if (auto box = llvm::dyn_cast<fir::BaseBoxType>(dummyType)) {
+ mlir::Value addr =
+ builder.createConvert(loc, box.getBaseAddressType(), one);
+ llvm::SmallVector<mlir::Value> lenParams;
+ preparedActual.genLengthParameters(loc, builder, lenParams);
+ mlir::Value mold;
+ if (fir::isPolymorphicType(box))
+ mold = preparedActual.getPolymorphicMold(loc);
+ return fir::EmboxOp::create(builder, loc, box, addr,
+ /*shape=*/mlir::Value{},
+ /*slice=*/mlir::Value{}, lenParams, mold);
+ }
+ // Values of arguments should not be used in elemental procedure specification
+ // expressions as per C15121, so it makes no sense to have a specification
+ // expression requiring a symbol that is passed by value (there is no good
+ // value to create here).
+ assert(fir::isa_ref_type(dummyType) &&
+ (fir::isa_trivial(fir::unwrapRefType(dummyType)) ||
+ fir::isa_char(fir::unwrapRefType(dummyType))) &&
+ "Only expect symbols inquired in elemental procedure result "
+ "specifications to be passed in memory");
+ return builder.createConvert(loc, dummyType, one);
+}
+
class ElementalUserCallBuilder
: public ElementalCallBuilder<ElementalUserCallBuilder> {
public:
@@ -2371,56 +2423,97 @@ class ElementalUserCallBuilder
mlir::Value computeDynamicCharacterResultLength(
Fortran::lower::PreparedActualArguments &loweredActuals,
CallContext &callContext) {
+
fir::FirOpBuilder &builder = callContext.getBuilder();
mlir::Location loc = callContext.loc;
auto &converter = callContext.converter;
- mlir::Type idxTy = builder.getIndexType();
- llvm::SmallVector<CallCleanUp> callCleanUps;
- llvm::SmallVector<mlir::Value> mockIndices;
- mlir::ValueRange mockIndicesRange;
-
- // If this is an elemental call, evaluate the specification expressions
- // using the first elements of dummy arguments. The address of these
- // elements will not be read thanks to Fortran 2023 C15121 (dummy
- // arguments can only be inquired about inside the specification for the
- // result), so no care is needed for the zero size array case.
- bool mustResetElementalIndices = false;
- if (int elementalRank = callContext.getRankIfElementalProcWithArrayArgs()) {
- mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1);
- mockIndices.assign(elementalRank, one);
- mockIndicesRange = mockIndices;
- for (auto &preparedActual : loweredActuals)
- if (preparedActual) {
- assert(
- !preparedActual->hasElementalIndices() &&
- "result length must be computed before the elemental loop nest");
- preparedActual->setElementalIndices(mockIndicesRange);
- }
- mustResetElementalIndices = true;
- }
- prepareUserCallArguments(loweredActuals, caller, callSiteType, callContext,
- callCleanUps);
+ // Gather the dummy argument symbols required directly or indirectly to
+ // evaluate the result symbol specification expressions.
+ llvm::SmallPtrSet<const Fortran::semantics::Symbol *, 4>
+ requiredDummySymbols;
+ const Fortran::semantics::Symbol &result = caller.getResultSymbol();
+ for (Fortran::lower::pft::Variable var :
+ Fortran::lower::pft::getDependentVariableList(result))
+ if (var.hasSymbol()) {
+ const Fortran::semantics::Symbol &sym = var.getSymbol();
+ if (Fortran::semantics::IsDummy(sym) && sym.owner() == result.owner())
+ requiredDummySymbols.insert(&sym);
+ }
- if (mustResetElementalIndices)
- for (auto &preparedActual : loweredActuals)
- if (preparedActual)
- preparedActual->resetElementalIndices();
+ // Prepare mock FIR arguments for each dummy arguments required in the
+ // result specifications. These mock arguments will have the same properties
+ // (dynamic type and type parameters) as the actual arguments, except for
+ // the address. Such mock argument are needed because this evaluation is
+ // happening before the loop for the elemental call (the array result
+ // storage must be allocated before the loops if any is needed, so the
+ // result properties must be known before the loops). So it is not possible
+ // to just pick an element (like the first one) and use that because the
+ // normal argument preparation have effects (vector subscripted actual
+ // argument will require reading the vector subscript and VALUE arguments
+ // preparation involve copies of the data. This could cause segfaults in
+ // case of zero size arrays and is in general pointless extra computation
+ // since the data cannot be used in the specification expression as per
+ // C15121).
+ if (!requiredDummySymbols.empty()) {
+ const Fortran::semantics::SubprogramDetails *iface =
+ caller.getInterfaceDetails();
+ assert(iface && "interface must be explicit when result specification "
+ "depends upon dummy symbols");
+ for (auto [maybePreparedActual, arg, sym] : llvm::zip(
+ loweredActuals, caller.getPassedArguments(), iface->dummyArgs()))
+ if (requiredDummySymbols.contains(sym)) {
+ mlir::Type dummyType = callSiteType.getInput(arg.firArgument);
+
+ if (!maybePreparedActual.has_value()) {
+ mlir::Value mockArgValue =
+ fir::AbsentOp::create(builder, loc, dummyType);
+ caller.placeInput(arg, mockArgValue);
+ continue;
+ }
- callContext.symMap.pushScope();
+ Fortran::lower::PreparedActualArgument &preparedActual =
+ maybePreparedActual.value();
+
+ if (preparedActual.handleDynamicOptional()) {
+ mlir::Value isPresent = preparedActual.getIsPresent();
+ mlir::Value mockArgValue =
+ builder
+ .genIfOp(loc, {dummyType}, isPresent,
+ /*withElseRegion=*/true)
+ .genThen([&]() {
+ mlir::Value mockArgValue =
+ genMockDummyForElementalResultSpecifications(
+ builder, loc, dummyType, preparedActual);
+ fir::ResultOp::create(builder, loc, mockArgValue);
+ })
+ .genElse([&]() {
+ mlir::Value absent =
+ fir::AbsentOp::create(builder, loc, dummyType);
+ fir::ResultOp::create(builder, loc, absent);
+ })
+ .getResults()[0];
+ caller.placeInput(arg, mockArgValue);
+ } else {
+ mlir::Value mockArgValue =
+ genMockDummyForElementalResultSpecifications(
+ builder, loc, dummyType, preparedActual);
+ caller.placeInput(arg, mockArgValue);
+ }
+ }
+ }
+ // Map symbols required by the result specification expressions to SSA
+ // values. This will both finish mapping the mock value created above if
+ // any, and deal with any module/common block variables accessed in the
+ // specification expressions.
// Map prepared argument to dummy symbol to be able to lower spec expr.
- for (const auto &arg : caller.getPassedArguments()) {
- const Fortran::semantics::Symbol *sym = caller.getDummySymbol(arg);
- assert(sym && "expect symbol for dummy argument");
- auto input = caller.getInput(arg);
- fir::ExtendedValue exv = Fortran::lower::translateToExtendedValue(
- loc, builder, hlfir::Entity{input}, callContext.stmtCtx);
- fir::FortranVariableOpInterface variableIface = hlfir::genDeclare(
- loc, builder, exv, "mock.dummy", fir::FortranVariableFlagsAttr{});
- callContext.symMap.addVariableDefinition(*sym, variableIface);
- }
+ callContext.symMap.pushScope();
+ Fortran::lower::mapCallInterfaceSymbolsForResult(converter, caller,
+ callContext.symMap);
+ // Evaluate the result length expression.
+ mlir::Type idxTy = builder.getIndexType();
auto lowerSpecExpr = [&](const auto &expr) -> mlir::Value {
mlir::Value convertExpr = builder.createConvert(
loc, idxTy,
@@ -2805,24 +2898,11 @@ genIntrinsicRef(const Fortran::evaluate::SpecificIntrinsic *intrinsic,
return genIntrinsicRef(intrinsic, *intrinsicEntry, callContext);
}
-namespace {
-/// Helper to erase temporary ElementalAddrOp created for vector subscripted
-/// arguments of elemental procedures using C++ lifetime scopes.
-struct ElementalAddrEraser {
- ~ElementalAddrEraser() {
- for (hlfir::ElementalAddrOp elementalAddr : elementalAddrOps)
- elementalAddr.erase();
- }
- llvm::SmallVector<hlfir::ElementalAddrOp> elementalAddrOps;
-};
-} // namespace
-
/// Main entry point to lower procedure references, regardless of what they are.
static std::optional<hlfir::EntityWithAttributes>
genProcedureRef(CallContext &callContext) {
mlir::Location loc = callContext.loc;
fir::FirOpBuilder &builder = callContext.getBuilder();
- ElementalAddrEraser elementalAddrEraser;
if (auto *intrinsic = callContext.procRef.proc().GetSpecificIntrinsic())
return genIntrinsicRef(intrinsic, callContext);
// Intercept non BIND(C) module procedure reference that have lowering
@@ -2905,12 +2985,6 @@ genProcedureRef(CallContext &callContext) {
Fortran::lower::convertVectorSubscriptedExprToElementalAddr(
loc, callContext.converter, *expr, callContext.symMap,
callContext.stmtCtx);
- // ElementalAddrOp bodies will be copied as needed when generating the
- // elemental calls to generate the operand element addressing and the
- // operation must be erased afterwards (cannot wait on dead code
- // elimination because these operations are invalid outside of
- // hlfir.region_assign contexts).
- elementalAddrEraser.elementalAddrOps.push_back(elementalAddr);
loweredActuals.emplace_back(
Fortran::lower::PreparedActualArgument{elementalAddr});
continue;
@@ -2960,6 +3034,7 @@ hlfir::Entity Fortran::lower::PreparedActualArgument::getActual(
loc, builder, elementalAddr, *oneBasedElementalIndices, mapper,
/*mustRecursivelyInline=*/alwaysFalse);
assert(elementalAddr.getCleanup().empty() && "no clean-up expected");
+ elementalAddr.erase();
return hlfir::Entity{addr};
}
diff --git a/flang/test/Lower/HLFIR/elemental-array-ops.f90 b/flang/test/Lower/HLFIR/elemental-array-ops.f90
index b23c8185b3d22..10450f6876c14 100644
--- a/flang/test/Lower/HLFIR/elemental-array-ops.f90
+++ b/flang/test/Lower/HLFIR/elemental-array-ops.f90
@@ -177,13 +177,8 @@ end subroutine char_return
! CHECK: ^bb0(%[[VAL_18:.*]]: index):
! CHECK: %[[VAL_19:.*]] = hlfir.designate %[[VAL_12]]#0 (%[[VAL_18]]) typeparams %[[VAL_11]] : (!fir.box<!fir.array<?x!fir.char<1,3>>>, index, index) -> !fir.ref<!fir.char<1,3>>
! CHECK: %[[VAL_20:.*]] = fir.emboxchar %[[VAL_19]], %[[VAL_11]] : (!fir.ref<!fir.char<1,3>>, index) -> !fir.boxchar<1>
-! CHECK: %[[VAL_21:.*]] = arith.constant 3 : i64
-! CHECK: %[[VAL_22:.*]] = fir.convert %[[VAL_21]] : (i64) -> index
-! CHECK: %[[VAL_23:.*]] = arith.constant 0 : index
-! CHECK: %[[VAL_24:.*]] = arith.cmpi sgt, %[[VAL_22]], %[[VAL_23]] : index
-! CHECK: %[[VAL_25:.*]] = arith.select %[[VAL_24]], %[[VAL_22]], %[[VAL_23]] : index
-! CHECK: %[[VAL_27:.*]] = fir.call @_QPcallee(%[[VAL_2]], %[[VAL_25]], %[[VAL_20]]) proc_attrs<elemental, pure> fastmath<contract> : (!fir.ref<!fir.char<1,3>>, index, !fir.boxchar<1>) -> !fir.boxchar<1>
-! CHECK: %[[VAL_28:.*]]:2 = hlfir.declare %[[VAL_2]] typeparams %[[VAL_25]] {uniq_name = ".tmp.func_result"} : (!fir.ref<!fir.char<1,3>>, index) -> (!fir.ref<!fir.char<1,3>>, !fir.ref<!fir.char<1,3>>)
+! CHECK: %[[VAL_27:.*]] = fir.call @_QPcallee(%[[VAL_2]], %[[VAL_16]], %[[VAL_20]]) proc_attrs<elemental, pure> fastmath<contract> : (!fir.ref<!fir.char<1,3>>, index, !fir.boxchar<1>) -> !fir.boxchar<1>
+! CHECK: %[[VAL_28:.*]]:2 = hlfir.declare %[[VAL_2]] typeparams %[[VAL_16]] {uniq_name = ".tmp.func_result"} : (!fir.ref<!fir.char<1,3>>, index) -> (!fir.ref<!fir.char<1,3>>, !fir.ref<!fir.char<1,3>>)
! CHECK: %[[MustFree:.*]] = arith.constant false
! CHECK: %[[ResultTemp:.*]] = hlfir.as_expr %[[VAL_28]]#0 move %[[MustFree]] : (!fir.ref<!fir.char<1,3>>, i1) -> !hlfir.expr<!fir.char<1,3>>
! CHECK: hlfir.yield_element %[[ResultTemp]] : !hlfir.expr<!fir.char<1,3>>
diff --git a/flang/test/Lower/HLFIR/elemental-result-length.f90 b/flang/test/Lower/HLFIR/elemental-result-length.f90
index 278ef013d952e..9418a40537683 100644
--- a/flang/test/Lower/HLFIR/elemental-result-length.f90
+++ b/flang/test/Lower/HLFIR/elemental-result-length.f90
@@ -4,7 +4,7 @@ module m1
contains
elemental function fct1(a, b) result(t)
character(*), intent(in) :: a, b
- character(len(a) + len(b)) :: t
+ character(len(a, kind=8) + len(b,kind=8)) :: t
t = a // b
end function
@@ -27,10 +27,10 @@ subroutine sub2(a,b,c)
! CHECK: %[[DUMMYA:.*]]:2 = hlfir.declare %[[UNBOX_A]]#0 typeparams %[[UNBOX_A]]#1 {fortran_attrs = #fir.var_attrs<intent_in>, uniq_name = "_QMm1Ffct1Ea"} : (!fir.ref<!fir.char<1,?>>, index) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>)
! CHECK: %[[UNBOX_B:.*]]:2 = fir.unboxchar %[[B]]#0 : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
! CHECK: %[[DUMMYB:.*]]:2 = hlfir.declare %[[UNBOX_B]]#0 typeparams %[[UNBOX_B]]#1 {fortran_attrs = #fir.var_attrs<intent_in>, uniq_name = "_QMm1Ffct1Eb"} : (!fir.ref<!fir.char<1,?>>, index) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>)
-! CHECK: %[[LEN_A:.*]] = fir.convert %[[UNBOX_A]]#1 : (index) -> i32
-! CHECK: %[[LEN_B:.*]] = fir.convert %[[UNBOX_B]]#1 : (index) -> i32
-! CHECK: %[[LEN_LEN:.*]] = arith.addi %[[LEN_A]], %[[LEN_B]] : i32
-! CHECK: %[[LEN_LEN_IDX:.*]] = fir.convert %[[LEN_LEN]] : (i32) -> index
+! CHECK: %[[LEN_A:.*]] = fir.convert %[[UNBOX_A]]#1 : (index) -> i64
+! CHECK: %[[LEN_B:.*]] = fir.convert %[[UNBOX_B]]#1 : (index) -> i64
+! CHECK: %[[LEN_LEN:.*]] = arith.addi %[[LEN_A]], %[[LEN_B]] : i64
+! CHECK: %[[LEN_LEN_IDX:.*]] = fir.convert %[[LEN_LEN]] : (i64) -> index
! CHECK: %[[CMPI:.*]] = arith.cmpi sgt, %[[LEN_LEN_IDX]], %c0{{.*}} : index
! CHECK: %[[RES_LENGTH:.*]] = arith.select %[[CMPI]], %[[LEN_LEN_IDX]], %c0{{.*}} : index
! CHECK: %[[RES:.*]] = fir.alloca !fir.char<1,?>(%[[RES_LENGTH]] : index) {bindc_name = ".result"}
@@ -50,12 +50,12 @@ subroutine sub4(a,b,c)
! CHECK: %[[C:.*]]:2 = hlfir.declare %[[ARG2]] dummy_scope %{{.*}} {fortran_attrs = #fir.var_attrs<intent_inout>, uniq_name = "_QMm1Fsub4Ec"} : (!fir.box<!fir.array<?x!fir.char<1,?>>>, !fir.dscope) -> (!fir.box<!fir.array<?x!fir.char<1,?>>>, !fir.box<!fir.array<?x!fir.char<1,?>>>)
! CHECK: %[[LEN_A:.*]] = fir.box_elesize %[[A]]#1 : (!fir.box<!fir.array<?x!fir.char<1,?>>>) -> index
! CHECK: %[[LEN_B:.*]] = fir.box_elesize %[[B]]#1 : (!fir.box<!fir.array<?x!fir.char<1,?>>>) -> index
-! CHECK: %[[LEN_A_I32:.*]] = fir.convert %[[LEN_A]] : (index) -> i32
-! CHECK: %[[LEN_B_I32:.*]] = fir.convert %[[LEN_B]] : (index) -> i32
-! CHECK: %[[LEN_LEN:.*]] = arith.addi %[[LEN_A_I32]], %[[LEN_B_I32]] : i32
-! CHECK: %[[LEN_LEN_IDX:.*]] = fir.convert %[[LEN_LEN]] : (i32) -> index
+! CHECK: %[[LEN_A_I32:.*]] = fir.convert %[[LEN_A]] : (index) -> i64
+! CHECK: %[[LEN_B_I32:.*]] = fir.convert %[[LEN_B]] : (index) -> i64
+! CHECK: %[[LEN_LEN:.*]] = arith.addi %[[LEN_A_I32]], %[[LEN_B_I32]] : i64
+! CHECK: %[[LEN_LEN_IDX:.*]] = fir.convert %[[LEN_LEN]] : (i64) -> index
! CHECK: %[[CMPI:.*]] = arith.cmpi sgt, %[[LEN_LEN_IDX]], %c0{{.*}} : index
-! CHECK: %[[LENGTH:.*]] = arith.select %[[CMPI]], %17, %c0{{.*}} : index
+! CHECK: %[[LENGTH:.*]] = arith.select %[[CMPI]], %[[LEN_LEN_IDX]], %c0{{.*}} : index
! CHECK: %{{.*}} = hlfir.elemental %{{.*}} typeparams %[[LENGTH]] unordered : (!fir.shape<1>, index) -> !hlfir.expr<?x!fir.char<1,?>>
end module
diff --git a/flang/test/Lower/array-elemental-calls-char-dynamic.f90 b/flang/test/Lower/array-elemental-calls-char-dynamic.f90
new file mode 100644
index 0000000000000..9671669b08c9a
--- /dev/null
+++ b/flang/test/Lower/array-elemental-calls-char-dynamic.f90
@@ -0,0 +1,291 @@
+! Test lowering of elemental calls to character function where the
+! result length is not a compile time constant.
+! RUN: bbc -emit-hlfir -o - %s | FileCheck %s
+
+! The vector subscript must not be read when computing the result length
+! before the elemental loop because the argument array could be zero sized.
+subroutine test_vector_subscripted_arg(c, vector_subscript)
+ interface
+ elemental function bug_145151_1(c_dummy)
+ character(*), intent(in) :: c_dummy
+ character(len(c_dummy, KIND=8)) :: bug_145151_1
+ end
+ end interface
+ integer(8) :: vector_subscript(:)
+ character(*) :: c(:)
+ c = bug_145151_1(c(vector_subscript))
+end subroutine
+! CHECK-LABEL: func.func @_QPtest_vector_subscripted_arg(
+! CHECK-SAME: %[[ARG0:.*]]: !fir.box<!fir.array<?x!fir.char<1,?>>> {fir.bindc_name = "c"},
+! CHECK-SAME: %[[ARG1:.*]]: !fir.box<!fir.array<?xi64>> {fir.bindc_name = "vector_subscript"}) {
+! CHECK: %[[VAL_0:.*]] = fir.dummy_scope : !fir.dscope
+! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[ARG0]] dummy_scope %[[VAL_0]] {uniq_name = "_QFtest_vector_subscripted_argEc"} : (!fir.box<!fir.array<?x!fir.char<1,?>>>, !fir.dscope) -> (!fir.box<!fir.array<?x!fir.char<1,?>>>, !fir.box<!fir.array<?x!fir.char<1,?>>>)
+! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[ARG1]] dummy_scope %[[VAL_0]] {uniq_name = "_QFtest_vector_subscripted_argEvector_subscript"} : (!fir.box<!fir.array<?xi64>>, !fir.dscope) -> (!fir.box<!fir.array<?xi64>>, !fir.box<!fir.array<?xi64>>)
+! CHECK: %[[VAL_3:.*]] = fir.box_elesize %[[VAL_1]]#1 : (!fir.box<!fir.array<?x!fir.char<1,?>>>) -> index
+! CHECK: %[[VAL_4:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_5:.*]]:3 = fir.box_dims %[[VAL_2]]#0, %[[VAL_4]] : (!fir.box<!fir.array<?xi64>>, index) -> (index, index, index)
+! CHECK: %[[VAL_6:.*]] = fir.shape %[[VAL_5]]#1 : (index) -> !fir.shape<1>
+! CHECK: %[[VAL_7:.*]] = arith.constant 1 : i64
+! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (i64) -> !fir.ref<!fir.char<1,?>>
+! CHECK: %[[VAL_9:.*]]:2 = hlfir.declare %[[VAL_8]] typeparams %[[VAL_3]] {fortran_attrs = #fir.var_attrs<intent_in>, uniq_name = "_QFtest_vector_subscripted_argFbug_145151_1Ec_dummy"} : (!fir.ref<!fir.char<1,?>>, index) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>)
+! CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_3]] : (index) -> i64
+! CHECK: %[[VAL_11:.*]] = fir.convert %[[VAL_10]] : (i64) -> index
+! CHECK: %[[VAL_12:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_13:.*]] = arith.cmpi sgt, %[[VAL_11]], %[[VAL_12]] : index
+! CHECK: %[[VAL_14:.*]] = arith.select %[[VAL_13]], %[[VAL_11]], %[[VAL_12]] : index
+! CHECK: %[[VAL_15:.*]] = hlfir.elemental %[[VAL_6]] typeparams %[[VAL_14]] unordered : (!fir.shape<1>, index) -> !hlfir.expr<?x!fir.char<1,?>> {
+! CHECK: ^bb0(%[[VAL_16:.*]]: index):
+! CHECK: %[[VAL_17:.*]] = hlfir.designate %[[VAL_2]]#0 (%[[VAL_16]]) : (!fir.box<!fir.array<?xi64>>, index) -> !fir.ref<i64>
+! CHECK: %[[VAL_18:.*]] = fir.load %[[VAL_17]] : !fir.ref<i64>
+! CHECK: %[[VAL_19:.*]] = hlfir.designate %[[VAL_1]]#0 (%[[VAL_18]]) typeparams %[[VAL_3]] : (!fir.box<!fir.array<?x!fir.char<1,?>>>, i64, index) -> !fir.boxchar<1>
+! CHECK: %[[VAL_20:.*]] = fir.alloca !fir.char<1,?>(%[[VAL_14]] : index) {bindc_name = ".result"}
+! CHECK: %[[VAL_21:.*]] = fir.call @_QPbug_145151_1(%[[VAL_20]], %[[VAL_14]], %[[VAL_19]]) proc_attrs<elemental, pure> fastmath<contract> : (!fir.ref<!fir.char<1,?>>, index, !fir.boxchar<1>) -> !fir.boxchar<1>
+! CHECK: %[[VAL_22:.*]]:2 = hlfir.declare %[[VAL_20]] typeparams %[[VAL_14]] {uniq_name = ".tmp.func_result"} : (!fir.ref<!fir.char<1,?>>, index) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>)
+! CHECK: %[[VAL_23:.*]] = arith.constant false
+! CHECK: %[[VAL_24:.*]] = hlfir.as_expr %[[VAL_22]]#0 move %[[VAL_23]] : (!fir.boxchar<1>, i1) -> !hlfir.expr<!fir.char<1,?>>
+! CHECK: hlfir.yield_element %[[VAL_24]] : !hlfir.expr<!fir.char<1,?>>
+! CHECK: }
+! CHECK: hlfir.assign %[[VAL_15]] to %[[VAL_1]]#0 : !hlfir.expr<?x!fir.char<1,?>>, !fir.box<!fir.array<?x!fir.char<1,?>>>
+! CHECK: hlfir.destroy %[[VAL_15]] : !hlfir.expr<?x!fir.char<1,?>>
+! CHECK: return
+! CHECK: }
+
+! CHECK-LABEL: fir.global @_QMm_bug_145151_2Ei : i64 {
+! CHECK: %[[VAL_0:.*]] = fir.zero_bits i64
+! CHECK: fir.has_value %[[VAL_0]] : i64
+! CHECK: }
+
+
+
+
+module m_bug_145151_2
+ integer(8) :: i
+end module
+
+! Test that module variables used in the result specification expressions
+! are mapped correctly.
+subroutine test_module_variable(c, x)
+ interface
+ elemental function bug_145151_2(x)
+ use m_bug_145151_2, only : i
+ real, value :: x
+ character(i) :: bug_145151_2
+ end
+ end interface
+ character(*) :: c(:)
+ real :: x(:)
+ c = bug_145151_2(x)
+end subroutine
+! CHECK-LABEL: func.func @_QPtest_module_variable(
+! CHECK-SAME: %[[ARG0:.*]]: !fir.box<!fir.array<?x!fir.char<1,?>>> {fir.bindc_name = "c"},
+! CHECK-SAME: %[[ARG1:.*]]: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x"}) {
+! CHECK: %[[VAL_0:.*]] = fir.dummy_scope : !fir.dscope
+! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[ARG0]] dummy_scope %[[VAL_0]] {uniq_name = "_QFtest_module_variableEc"} : (!fir.box<!fir.array<?x!fir.char<1,?>>>, !fir.dscope) -> (!fir.box<!fir.array<?x!fir.char<1,?>>>, !fir.box<!fir.array<?x!fir.char<1,?>>>)
+! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[ARG1]] dummy_scope %[[VAL_0]] {uniq_name = "_QFtest_module_variableEx"} : (!fir.box<!fir.array<?xf32>>, !fir.dscope) -> (!fir.box<!fir.array<?xf32>>, !fir.box<!fir.array<?xf32>>)
+! CHECK: %[[VAL_3:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_4:.*]]:3 = fir.box_dims %[[VAL_2]]#0, %[[VAL_3]] : (!fir.box<!fir.array<?xf32>>, index) -> (index, index, index)
+! CHECK: %[[VAL_5:.*]] = fir.shape %[[VAL_4]]#1 : (index) -> !fir.shape<1>
+! CHECK: %[[VAL_6:.*]] = fir.address_of(@_QMm_bug_145151_2Ei) : !fir.ref<i64>
+! CHECK: %[[VAL_7:.*]]:2 = hlfir.declare %[[VAL_6]] {uniq_name = "_QMm_bug_145151_2Ei"} : (!fir.ref<i64>) -> (!fir.ref<i64>, !fir.ref<i64>)
+! CHECK: %[[VAL_8:.*]] = fir.load %[[VAL_7]]#0 : !fir.ref<i64>
+! CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_8]] : (i64) -> index
+! CHECK: %[[VAL_10:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_11:.*]] = arith.cmpi sgt, %[[VAL_9]], %[[VAL_10]] : index
+! CHECK: %[[VAL_12:.*]] = arith.select %[[VAL_11]], %[[VAL_9]], %[[VAL_10]] : index
+! CHECK: %[[VAL_13:.*]] = hlfir.elemental %[[VAL_5]] typeparams %[[VAL_12]] unordered : (!fir.shape<1>, index) -> !hlfir.expr<?x!fir.char<1,?>> {
+! CHECK: ^bb0(%[[VAL_14:.*]]: index):
+! CHECK: %[[VAL_15:.*]] = hlfir.designate %[[VAL_2]]#0 (%[[VAL_14]]) : (!fir.box<!fir.array<?xf32>>, index) -> !fir.ref<f32>
+! CHECK: %[[VAL_16:.*]] = fir.load %[[VAL_15]] : !fir.ref<f32>
+! CHECK: %[[VAL_17:.*]] = fir.alloca !fir.char<1,?>(%[[VAL_12]] : index) {bindc_name = ".result"}
+! CHECK: %[[VAL_18:.*]] = fir.call @_QPbug_145151_2(%[[VAL_17]], %[[VAL_12]], %[[VAL_16]]) proc_attrs<elemental, pure> fastmath<contract> : (!fir.ref<!fir.char<1,?>>, index, f32) -> !fir.boxchar<1>
+! CHECK: %[[VAL_19:.*]]:2 = hlfir.declare %[[VAL_17]] typeparams %[[VAL_12]] {uniq_name = ".tmp.func_result"} : (!fir.ref<!fir.char<1,?>>, index) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>)
+! CHECK: %[[VAL_20:.*]] = arith.constant false
+! CHECK: %[[VAL_21:.*]] = hlfir.as_expr %[[VAL_19]]#0 move %[[VAL_20]] : (!fir.boxchar<1>, i1) -> !hlfir.expr<!fir.char<1,?>>
+! CHECK: hlfir.yield_element %[[VAL_21]] : !hlfir.expr<!fir.char<1,?>>
+! CHECK: }
+! CHECK: hlfir.assign %[[VAL_13]] to %[[VAL_1]]#0 : !hlfir.expr<?x!fir.char<1,?>>, !fir.box<!fir.array<?x!fir.char<1,?>>>
+! CHECK: hlfir.destroy %[[VAL_13]] : !hlfir.expr<?x!fir.char<1,?>>
+! CHECK: return
+! CHECK: }
+
+
+! Test that optional arguments are not dereferenced unconditionally when preparing
+! them for inquiries inside the result specification expressions.
+subroutine test_present(res, x, opt)
+ interface
+ elemental function f_opt(x, opt)
+ real, intent(in) :: x
+ real, intent(in), optional :: opt
+ character(merge(10,20, present(opt))) :: f_opt
+ end
+ end interface
+ character(*) :: res(:)
+ real :: x(:)
+ real, optional :: opt(:)
+ res = f_opt(x, opt)
+end subroutine
+! CHECK-LABEL: func.func @_QPtest_present(
+! CHECK-SAME: %[[ARG0:.*]]: !fir.box<!fir.array<?x!fir.char<1,?>>> {fir.bindc_name = "res"},
+! CHECK-SAME: %[[ARG1:.*]]: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x"},
+! CHECK-SAME: %[[ARG2:.*]]: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "opt", fir.optional}) {
+! CHECK: %[[VAL_0:.*]] = fir.dummy_scope : !fir.dscope
+! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[ARG2]] dummy_scope %[[VAL_0]] {fortran_attrs = #fir.var_attrs<optional>, uniq_name = "_QFtest_presentEopt"} : (!fir.box<!fir.array<?xf32>>, !fir.dscope) -> (!fir.box<!fir.array<?xf32>>, !fir.box<!fir.array<?xf32>>)
+! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[ARG0]] dummy_scope %[[VAL_0]] {uniq_name = "_QFtest_presentEres"} : (!fir.box<!fir.array<?x!fir.char<1,?>>>, !fir.dscope) -> (!fir.box<!fir.array<?x!fir.char<1,?>>>, !fir.box<!fir.array<?x!fir.char<1,?>>>)
+! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[ARG1]] dummy_scope %[[VAL_0]] {uniq_name = "_QFtest_presentEx"} : (!fir.box<!fir.array<?xf32>>, !fir.dscope) -> (!fir.box<!fir.array<?xf32>>, !fir.box<!fir.array<?xf32>>)
+! CHECK: %[[VAL_4:.*]] = fir.is_present %[[VAL_1]]#0 : (!fir.box<!fir.array<?xf32>>) -> i1
+! CHECK: %[[VAL_5:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_6:.*]]:3 = fir.box_dims %[[VAL_3]]#0, %[[VAL_5]] : (!fir.box<!fir.array<?xf32>>, index) -> (index, index, index)
+! CHECK: %[[VAL_7:.*]] = fir.shape %[[VAL_6]]#1 : (index) -> !fir.shape<1>
+! CHECK: %[[VAL_8:.*]] = fir.if %[[VAL_4]] -> (!fir.ref<f32>) {
+! CHECK: %[[VAL_9:.*]] = arith.constant 1 : i64
+! CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_9]] : (i64) -> !fir.ref<f32>
+! CHECK: fir.result %[[VAL_10]] : !fir.ref<f32>
+! CHECK: } else {
+! CHECK: %[[VAL_11:.*]] = fir.absent !fir.ref<f32>
+! CHECK: fir.result %[[VAL_11]] : !fir.ref<f32>
+! CHECK: }
+! CHECK: %[[VAL_12:.*]]:2 = hlfir.declare %[[VAL_8]] {fortran_attrs = #fir.var_attrs<intent_in, optional>, uniq_name = "_QFtest_presentFf_optEopt"} : (!fir.ref<f32>) -> (!fir.ref<f32>, !fir.ref<f32>)
+! CHECK: %[[VAL_13:.*]] = arith.constant 10 : i32
+! CHECK: %[[VAL_14:.*]] = arith.constant 20 : i32
+! CHECK: %[[VAL_15:.*]] = fir.is_present %[[VAL_12]]#0 : (!fir.ref<f32>) -> i1
+! CHECK: %[[VAL_16:.*]] = arith.select %[[VAL_15]], %[[VAL_13]], %[[VAL_14]] : i32
+! CHECK: %[[VAL_17:.*]] = fir.convert %[[VAL_16]] : (i32) -> i64
+! CHECK: %[[VAL_18:.*]] = fir.convert %[[VAL_17]] : (i64) -> index
+! CHECK: %[[VAL_19:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_20:.*]] = arith.cmpi sgt, %[[VAL_18]], %[[VAL_19]] : index
+! CHECK: %[[VAL_21:.*]] = arith.select %[[VAL_20]], %[[VAL_18]], %[[VAL_19]] : index
+! CHECK: %[[VAL_22:.*]] = hlfir.elemental %[[VAL_7]] typeparams %[[VAL_21]] unordered : (!fir.shape<1>, index) -> !hlfir.expr<?x!fir.char<1,?>> {
+! CHECK: ^bb0(%[[VAL_23:.*]]: index):
+! CHECK: %[[VAL_24:.*]] = hlfir.designate %[[VAL_3]]#0 (%[[VAL_23]]) : (!fir.box<!fir.array<?xf32>>, index) -> !fir.ref<f32>
+! CHECK: %[[VAL_25:.*]] = fir.if %[[VAL_4]] -> (!fir.ref<f32>) {
+! CHECK: %[[VAL_26:.*]] = hlfir.designate %[[VAL_1]]#0 (%[[VAL_23]]) : (!fir.box<!fir.array<?xf32>>, index) -> !fir.ref<f32>
+! CHECK: fir.result %[[VAL_26]] : !fir.ref<f32>
+! CHECK: } else {
+! CHECK: %[[VAL_27:.*]] = fir.absent !fir.ref<f32>
+! CHECK: fir.result %[[VAL_27]] : !fir.ref<f32>
+! CHECK: }
+! CHECK: %[[VAL_28:.*]] = fir.alloca !fir.char<1,?>(%[[VAL_21]] : index) {bindc_name = ".result"}
+! CHECK: %[[VAL_29:.*]] = fir.call @_QPf_opt(%[[VAL_28]], %[[VAL_21]], %[[VAL_24]], %[[VAL_25]]) proc_attrs<elemental, pure> fastmath<contract> : (!fir.ref<!fir.char<1,?>>, index, !fir.ref<f32>, !fir.ref<f32>) -> !fir.boxchar<1>
+! CHECK: %[[VAL_30:.*]]:2 = hlfir.declare %[[VAL_28]] typeparams %[[VAL_21]] {uniq_name = ".tmp.func_result"} : (!fir.ref<!fir.char<1,?>>, index) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>)
+! CHECK: %[[VAL_31:.*]] = arith.constant false
+! CHECK: %[[VAL_32:.*]] = hlfir.as_expr %[[VAL_30]]#0 move %[[VAL_31]] : (!fir.boxchar<1>, i1) -> !hlfir.expr<!fir.char<1,?>>
+! CHECK: hlfir.yield_element %[[VAL_32]] : !hlfir.expr<!fir.char<1,?>>
+! CHECK: }
+! CHECK: hlfir.assign %[[VAL_22]] to %[[VAL_2]]#0 : !hlfir.expr<?x!fir.char<1,?>>, !fir.box<!fir.array<?x!fir.char<1,?>>>
+! CHECK: hlfir.destroy %[[VAL_22]] : !hlfir.expr<?x!fir.char<1,?>>
+! CHECK: return
+! CHECK: }
+
+! Test that inquiries about the dynamic type of arguments are handled inside the
+! elemental result specification expressions.
+subroutine test_polymorphic(res, p1, p2)
+ type t
+ end type
+ interface
+ elemental function f_poly(p1, p2)
+ import :: t
+ class(t), intent(in) :: p1, p2
+ character(merge(10,20, STORAGE_SIZE(p1).lt.STORAGE_SIZE(p2))) :: f_poly
+ end
+ end interface
+ character(*) :: res(:)
+ class(t), intent(in) :: p1(:), p2(:)
+ res = f_poly(p1, p2)
+end subroutine
+! CHECK-LABEL: func.func @_QPtest_polymorphic(
+! CHECK-SAME: %[[ARG0:.*]]: !fir.box<!fir.array<?x!fir.char<1,?>>> {fir.bindc_name = "res"},
+! CHECK-SAME: %[[ARG1:.*]]: !fir.class<!fir.array<?x!fir.type<_QFtest_polymorphicTt>>> {fir.bindc_name = "p1"},
+! CHECK-SAME: %[[ARG2:.*]]: !fir.class<!fir.array<?x!fir.type<_QFtest_polymorphicTt>>> {fir.bindc_name = "p2"}) {
+! CHECK: %[[VAL_0:.*]] = fir.dummy_scope : !fir.dscope
+! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[ARG1]] dummy_scope %[[VAL_0]] {fortran_attrs = #fir.var_attrs<intent_in>, uniq_name = "_QFtest_polymorphicEp1"} : (!fir.class<!fir.array<?x!fir.type<_QFtest_polymorphicTt>>>, !fir.dscope) -> (!fir.class<!fir.array<?x!fir.type<_QFtest_polymorphicTt>>>, !fir.class<!fir.array<?x!fir.type<_QFtest_polymorphicTt>>>)
+! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[ARG2]] dummy_scope %[[VAL_0]] {fortran_attrs = #fir.var_attrs<intent_in>, uniq_name = "_QFtest_polymorphicEp2"} : (!fir.class<!fir.array<?x!fir.type<_QFtest_polymorphicTt>>>, !fir.dscope) -> (!fir.class<!fir.array<?x!fir.type<_QFtest_polymorphicTt>>>, !fir.class<!fir.array<?x!fir.type<_QFtest_polymorphicTt>>>)
+! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[ARG0]] dummy_scope %[[VAL_0]] {uniq_name = "_QFtest_polymorphicEres"} : (!fir.box<!fir.array<?x!fir.char<1,?>>>, !fir.dscope) -> (!fir.box<!fir.array<?x!fir.char<1,?>>>, !fir.box<!fir.array<?x!fir.char<1,?>>>)
+! CHECK: %[[VAL_4:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_5:.*]]:3 = fir.box_dims %[[VAL_1]]#0, %[[VAL_4]] : (!fir.class<!fir.array<?x!fir.type<_QFtest_polymorphicTt>>>, index) -> (index, index, index)
+! CHECK: %[[VAL_6:.*]] = fir.shape %[[VAL_5]]#1 : (index) -> !fir.shape<1>
+! CHECK: %[[VAL_7:.*]] = arith.constant 1 : i64
+! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (i64) -> !fir.ref<!fir.type<_QFtest_polymorphicTt>>
+! CHECK: %[[VAL_9:.*]] = fir.embox %[[VAL_8]] source_box %[[VAL_1]]#0 : (!fir.ref<!fir.type<_QFtest_polymorphicTt>>, !fir.class<!fir.array<?x!fir.type<_QFtest_polymorphicTt>>>) -> !fir.class<!fir.type<_QFtest_polymorphicTt>>
+! CHECK: %[[VAL_10:.*]] = arith.constant 1 : i64
+! CHECK: %[[VAL_11:.*]] = fir.convert %[[VAL_10]] : (i64) -> !fir.ref<!fir.type<_QFtest_polymorphicTt>>
+! CHECK: %[[VAL_12:.*]] = fir.embox %[[VAL_11]] source_box %[[VAL_2]]#0 : (!fir.ref<!fir.type<_QFtest_polymorphicTt>>, !fir.class<!fir.array<?x!fir.type<_QFtest_polymorphicTt>>>) -> !fir.class<!fir.type<_QFtest_polymorphicTt>>
+! CHECK: %[[VAL_13:.*]]:2 = hlfir.declare %[[VAL_9]] {fortran_attrs = #fir.var_attrs<intent_in>, uniq_name = "_QFtest_polymorphicFf_polyEp1"} : (!fir.class<!fir.type<_QFtest_polymorphicTt>>) -> (!fir.class<!fir.type<_QFtest_polymorphicTt>>, !fir.class<!fir.type<_QFtest_polymorphicTt>>)
+! CHECK: %[[VAL_14:.*]]:2 = hlfir.declare %[[VAL_12]] {fortran_attrs = #fir.var_attrs<intent_in>, uniq_name = "_QFtest_polymorphicFf_polyEp2"} : (!fir.class<!fir.type<_QFtest_polymorphicTt>>) -> (!fir.class<!fir.type<_QFtest_polymorphicTt>>, !fir.class<!fir.type<_QFtest_polymorphicTt>>)
+! CHECK: %[[VAL_15:.*]] = arith.constant 10 : i32
+! CHECK: %[[VAL_16:.*]] = arith.constant 20 : i32
+! CHECK: %[[VAL_17:.*]] = fir.box_elesize %[[VAL_13]]#1 : (!fir.class<!fir.type<_QFtest_polymorphicTt>>) -> i32
+! CHECK: %[[VAL_18:.*]] = arith.constant 8 : i32
+! CHECK: %[[VAL_19:.*]] = arith.muli %[[VAL_17]], %[[VAL_18]] : i32
+! CHECK: %[[VAL_20:.*]] = fir.box_elesize %[[VAL_14]]#1 : (!fir.class<!fir.type<_QFtest_polymorphicTt>>) -> i32
+! CHECK: %[[VAL_21:.*]] = arith.constant 8 : i32
+! CHECK: %[[VAL_22:.*]] = arith.muli %[[VAL_20]], %[[VAL_21]] : i32
+! CHECK: %[[VAL_23:.*]] = arith.cmpi slt, %[[VAL_19]], %[[VAL_22]] : i32
+! CHECK: %[[VAL_24:.*]] = arith.select %[[VAL_23]], %[[VAL_15]], %[[VAL_16]] : i32
+! CHECK: %[[VAL_25:.*]] = fir.convert %[[VAL_24]] : (i32) -> i64
+! CHECK: %[[VAL_26:.*]] = fir.convert %[[VAL_25]] : (i64) -> index
+! CHECK: %[[VAL_27:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_28:.*]] = arith.cmpi sgt, %[[VAL_26]], %[[VAL_27]] : index
+! CHECK: %[[VAL_29:.*]] = arith.select %[[VAL_28]], %[[VAL_26]], %[[VAL_27]] : index
+! CHECK: %[[VAL_30:.*]] = hlfir.elemental %[[VAL_6]] typeparams %[[VAL_29]] unordered : (!fir.shape<1>, index) -> !hlfir.expr<?x!fir.char<1,?>> {
+! CHECK: ^bb0(%[[VAL_31:.*]]: index):
+! CHECK: %[[VAL_32:.*]] = hlfir.designate %[[VAL_1]]#0 (%[[VAL_31]]) : (!fir.class<!fir.array<?x!fir.type<_QFtest_polymorphicTt>>>, index) -> !fir.class<!fir.type<_QFtest_polymorphicTt>>
+! CHECK: %[[VAL_33:.*]] = hlfir.designate %[[VAL_2]]#0 (%[[VAL_31]]) : (!fir.class<!fir.array<?x!fir.type<_QFtest_polymorphicTt>>>, index) -> !fir.class<!fir.type<_QFtest_polymorphicTt>>
+! CHECK: %[[VAL_34:.*]] = fir.alloca !fir.char<1,?>(%[[VAL_29]] : index) {bindc_name = ".result"}
+! CHECK: %[[VAL_35:.*]] = fir.call @_QPf_poly(%[[VAL_34]], %[[VAL_29]], %[[VAL_32]], %[[VAL_33]]) proc_attrs<elemental, pure> fastmath<contract> : (!fir.ref<!fir.char<1,?>>, index, !fir.class<!fir.type<_QFtest_polymorphicTt>>, !fir.class<!fir.type<_QFtest_polymorphicTt>>) -> !fir.boxchar<1>
+! CHECK: %[[VAL_36:.*]]:2 = hlfir.declare %[[VAL_34]] typeparams %[[VAL_29]] {uniq_name = ".tmp.func_result"} : (!fir.ref<!fir.char<1,?>>, index) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>)
+! CHECK: %[[VAL_37:.*]] = arith.constant false
+! CHECK: %[[VAL_38:.*]] = hlfir.as_expr %[[VAL_36]]#0 move %[[VAL_37]] : (!fir.boxchar<1>, i1) -> !hlfir.expr<!fir.char<1,?>>
+! CHECK: hlfir.yield_element %[[VAL_38]] : !hlfir.expr<!fir.char<1,?>>
+! CHECK: }
+! CHECK: hlfir.assign %[[VAL_30]] to %[[VAL_3]]#0 : !hlfir.expr<?x!fir.char<1,?>>, !fir.box<!fir.array<?x!fir.char<1,?>>>
+! CHECK: hlfir.destroy %[[VAL_30]] : !hlfir.expr<?x!fir.char<1,?>>
+! CHECK: return
+! CHECK: }
+
+! Test that no copy of VALUE argument is made before the loop when
+! evaluating the result specification expression (while a copy
+! of the argument elements have to be made inside the loop).
+subroutine test_value(c)
+ interface
+ elemental function f_value(c_dummy)
+ character(*), value :: c_dummy
+ character(len(c_dummy, KIND=8)) :: f_value
+ end
+ end interface
+ character(*) :: c(:)
+ c = f_value(c)
+end subroutine
+! CHECK-LABEL: func.func @_QPtest_value(
+! CHECK-SAME: %[[ARG0:.*]]: !fir.box<!fir.array<?x!fir.char<1,?>>> {fir.bindc_name = "c"}) {
+! CHECK: %[[VAL_0:.*]] = fir.dummy_scope : !fir.dscope
+! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare %[[ARG0]] dummy_scope %[[VAL_0]] {uniq_name = "_QFtest_valueEc"} : (!fir.box<!fir.array<?x!fir.char<1,?>>>, !fir.dscope) -> (!fir.box<!fir.array<?x!fir.char<1,?>>>, !fir.box<!fir.array<?x!fir.char<1,?>>>)
+! CHECK: %[[VAL_2:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_3:.*]]:3 = fir.box_dims %[[VAL_1]]#0, %[[VAL_2]] : (!fir.box<!fir.array<?x!fir.char<1,?>>>, index) -> (index, index, index)
+! CHECK: %[[VAL_4:.*]] = fir.shape %[[VAL_3]]#1 : (index) -> !fir.shape<1>
+! CHECK: %[[VAL_5:.*]] = arith.constant 1 : i64
+! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (i64) -> !fir.ref<!fir.char<1,?>>
+! CHECK: %[[VAL_7:.*]] = fir.box_elesize %[[VAL_1]]#1 : (!fir.box<!fir.array<?x!fir.char<1,?>>>) -> index
+! CHECK: %[[VAL_8:.*]]:2 = hlfir.declare %[[VAL_6]] typeparams %[[VAL_7]] {fortran_attrs = #fir.var_attrs<value>, uniq_name = "_QFtest_valueFf_valueEc_dummy"} : (!fir.ref<!fir.char<1,?>>, index) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>)
+! CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_7]] : (index) -> i64
+! CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_9]] : (i64) -> index
+! CHECK: %[[VAL_11:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_12:.*]] = arith.cmpi sgt, %[[VAL_10]], %[[VAL_11]] : index
+! CHECK: %[[VAL_13:.*]] = arith.select %[[VAL_12]], %[[VAL_10]], %[[VAL_11]] : index
+! CHECK: %[[VAL_14:.*]] = hlfir.elemental %[[VAL_4]] typeparams %[[VAL_13]] unordered : (!fir.shape<1>, index) -> !hlfir.expr<?x!fir.char<1,?>> {
+! CHECK: ^bb0(%[[VAL_15:.*]]: index):
+! CHECK: %[[VAL_16:.*]] = fir.box_elesize %[[VAL_1]]#1 : (!fir.box<!fir.array<?x!fir.char<1,?>>>) -> index
+! CHECK: %[[VAL_17:.*]] = hlfir.designate %[[VAL_1]]#0 (%[[VAL_15]]) typeparams %[[VAL_16]] : (!fir.box<!fir.array<?x!fir.char<1,?>>>, index, index) -> !fir.boxchar<1>
+! CHECK: %[[VAL_18:.*]] = hlfir.as_expr %[[VAL_17]] : (!fir.boxchar<1>) -> !hlfir.expr<!fir.char<1,?>>
+! CHECK: %[[VAL_19:.*]]:3 = hlfir.associate %[[VAL_18]] typeparams %[[VAL_16]] {adapt.valuebyref} : (!hlfir.expr<!fir.char<1,?>>, index) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>, i1)
+! CHECK: %[[VAL_20:.*]] = fir.alloca !fir.char<1,?>(%[[VAL_13]] : index) {bindc_name = ".result"}
+! CHECK: %[[VAL_21:.*]] = fir.call @_QPf_value(%[[VAL_20]], %[[VAL_13]], %[[VAL_19]]#0) proc_attrs<elemental, pure> fastmath<contract> : (!fir.ref<!fir.char<1,?>>, index, !fir.boxchar<1>) -> !fir.boxchar<1>
+! CHECK: %[[VAL_22:.*]]:2 = hlfir.declare %[[VAL_20]] typeparams %[[VAL_13]] {uniq_name = ".tmp.func_result"} : (!fir.ref<!fir.char<1,?>>, index) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>)
+! CHECK: %[[VAL_23:.*]] = arith.constant false
+! CHECK: %[[VAL_24:.*]] = hlfir.as_expr %[[VAL_22]]#0 move %[[VAL_23]] : (!fir.boxchar<1>, i1) -> !hlfir.expr<!fir.char<1,?>>
+! CHECK: hlfir.end_associate %[[VAL_19]]#1, %[[VAL_19]]#2 : !fir.ref<!fir.char<1,?>>, i1
+! CHECK: hlfir.yield_element %[[VAL_24]] : !hlfir.expr<!fir.char<1,?>>
+! CHECK: }
+! CHECK: hlfir.assign %[[VAL_14]] to %[[VAL_1]]#0 : !hlfir.expr<?x!fir.char<1,?>>, !fir.box<!fir.array<?x!fir.char<1,?>>>
+! CHECK: hlfir.destroy %[[VAL_14]] : !hlfir.expr<?x!fir.char<1,?>>
+! CHECK: return
+! CHECK: }
diff --git a/flang/test/Lower/array-elemental-calls-char.f90 b/flang/test/Lower/array-elemental-calls-char.f90
index dce5c0ae625a4..a75b335ba5767 100644
--- a/flang/test/Lower/array-elemental-calls-char.f90
+++ b/flang/test/Lower/array-elemental-calls-char.f90
@@ -240,9 +240,8 @@ subroutine foo6(c)
! CHECK: %[[VAL_4:.*]] = arith.constant 10 : index
! CHECK: %[[VAL_5:.*]] = fir.shape %[[VAL_4]] : (index) -> !fir.shape<1>
! CHECK: %[[VAL_6:.*]]:2 = hlfir.declare %[[VAL_3]](%[[VAL_5]]) typeparams %[[VAL_2]]#1 dummy_scope %[[VAL_1]] {uniq_name = "_QMchar_elemFfoo6Ec"} : (!fir.ref<!fir.array<10x!fir.char<1,?>>>, !fir.shape<1>, index, !fir.dscope) -> (!fir.box<!fir.array<10x!fir.char<1,?>>>, !fir.ref<!fir.array<10x!fir.char<1,?>>>)
-! CHECK: %[[VAL_7:.*]] = hlfir.designate %[[VAL_6:.*]]#0 (%c1) typeparams %1#1 : (!fir.box<!fir.array<10x!fir.char<1,?>>>, index, index) -> !fir.boxchar<1>
-! CHECK: %[[VAL_7B:.*]]:2 = fir.unboxchar %[[VAL_7]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
-! CHECK: %[[VAL_8:.*]]:2 = hlfir.declare %[[VAL_7B]]#0 typeparams %[[VAL_2]]#1 {uniq_name = "mock.dummy"} : (!fir.ref<!fir.char<1,?>>, index) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>)
+! CHECK: %[[VAL_7:.*]] = fir.convert %c1_i64 : (i64) -> !fir.ref<!fir.char<1,?>>
+! CHECK: %[[VAL_8:.*]]:2 = hlfir.declare %[[VAL_7]] typeparams %[[VAL_2]]#1 {fortran_attrs = #fir.var_attrs<intent_in>, uniq_name = "_QMchar_elemFelem_return_charEc"} : (!fir.ref<!fir.char<1,?>>, index) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>)
! CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_2]]#1 : (index) -> i64
! CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_9]] : (i64) -> i32
! CHECK: %[[VAL_11:.*]] = fir.convert %[[VAL_10]] : (i32) -> i64
@@ -253,18 +252,9 @@ subroutine foo6(c)
! CHECK: %[[VAL_16:.*]] = hlfir.elemental %[[VAL_5]] typeparams %[[VAL_15]] unordered : (!fir.shape<1>, index) -> !hlfir.expr<10x!fir.char<1,?>> {
! CHECK: ^bb0(%[[VAL_17:.*]]: index):
! CHECK: %[[VAL_18:.*]] = hlfir.designate %[[VAL_6]]#0 (%[[VAL_17]]) typeparams %[[VAL_2]]#1 : (!fir.box<!fir.array<10x!fir.char<1,?>>>, index, index) -> !fir.boxchar<1>
-! CHECK: %[[VAL_19:.*]]:2 = fir.unboxchar %[[VAL_18]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
-! CHECK: %[[VAL_20:.*]]:2 = hlfir.declare %[[VAL_19]]#0 typeparams %[[VAL_19]]#1 {fortran_attrs = #fir.var_attrs<intent_in>, uniq_name = "_QMchar_elemFelem_return_charEc"} : (!fir.ref<!fir.char<1,?>>, index) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>)
-! CHECK: %[[VAL_21:.*]] = fir.convert %[[VAL_19]]#1 : (index) -> i64
-! CHECK: %[[VAL_22:.*]] = fir.convert %[[VAL_21]] : (i64) -> i32
-! CHECK: %[[VAL_23:.*]] = fir.convert %[[VAL_22]] : (i32) -> i64
-! CHECK: %[[VAL_24:.*]] = fir.convert %[[VAL_23]] : (i64) -> index
-! CHECK: %[[VAL_25:.*]] = arith.constant 0 : index
-! CHECK: %[[VAL_26:.*]] = arith.cmpi sgt, %[[VAL_24]], %[[VAL_25]] : index
-! CHECK: %[[VAL_27:.*]] = arith.select %[[VAL_26]], %[[VAL_24]], %[[VAL_25]] : index
-! CHECK: %[[VAL_28:.*]] = fir.alloca !fir.char<1,?>(%[[VAL_27]] : index) {bindc_name = ".result"}
-! CHECK: %[[VAL_29:.*]] = fir.call @_QMchar_elemPelem_return_char(%[[VAL_28]], %[[VAL_27]], %[[VAL_18]]) proc_attrs<elemental, pure> fastmath<contract> : (!fir.ref<!fir.char<1,?>>, index, !fir.boxchar<1>) -> !fir.boxchar<1>
-! CHECK: %[[VAL_30:.*]]:2 = hlfir.declare %[[VAL_28]] typeparams %[[VAL_27]] {uniq_name = ".tmp.func_result"} : (!fir.ref<!fir.char<1,?>>, index) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>)
+! CHECK: %[[VAL_28:.*]] = fir.alloca !fir.char<1,?>(%[[VAL_15]] : index) {bindc_name = ".result"}
+! CHECK: %[[VAL_29:.*]] = fir.call @_QMchar_elemPelem_return_char(%[[VAL_28]], %[[VAL_15]], %[[VAL_18]]) proc_attrs<elemental, pure> fastmath<contract> : (!fir.ref<!fir.char<1,?>>, index, !fir.boxchar<1>) -> !fir.boxchar<1>
+! CHECK: %[[VAL_30:.*]]:2 = hlfir.declare %[[VAL_28]] typeparams %[[VAL_15]] {uniq_name = ".tmp.func_result"} : (!fir.ref<!fir.char<1,?>>, index) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>)
! CHECK: %[[VAL_31:.*]] = arith.constant false
! CHECK: %[[VAL_32:.*]] = hlfir.as_expr %[[VAL_30]]#0 move %[[VAL_31]] : (!fir.boxchar<1>, i1) -> !hlfir.expr<!fir.char<1,?>>
! CHECK: hlfir.yield_element %[[VAL_32]] : !hlfir.expr<!fir.char<1,?>>
@@ -275,48 +265,3 @@ subroutine foo6(c)
! CHECK: }
end module
-
-subroutine bug_145151(c, vector_subscript)
- interface
- elemental function f(c_dummy)
- character(*), intent(in) :: c_dummy
- character(len(c_dummy, KIND=8)) :: f
- end
- end interface
- integer(8) :: vector_subscript(100)
- character(*) :: c(100)
- c = f(c(vector_subscript))
-end subroutine
-! CHECK-LABEL: func.func @_QPbug_145151(
-! CHECK-SAME: %[[ARG0:.*]]: !fir.boxchar<1>
-! CHECK: %[[VAL_1:.*]]:2 = fir.unboxchar %[[ARG0]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
-! CHECK: %[[VAL_2:.*]] = fir.convert %[[VAL_1]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.array<100x!fir.char<1,?>>>
-! CHECK: %[[VAL_3:.*]] = arith.constant 100 : index
-! CHECK: %[[VAL_4:.*]] = fir.shape %[[VAL_3]] : (index) -> !fir.shape<1>
-! CHECK: %[[VAL_5:.*]]:2 = hlfir.declare %{{.*}}"_QFbug_145151Ec"} : (!fir.ref<!fir.array<100x!fir.char<1,?>>>,
-! CHECK: %[[VAL_10:.*]]:2 = hlfir.declare %{{.*}}"_QFbug_145151Evector_subscript"} : (!fir.ref<!fir.array<100xi64>>,
-! CHECK: %[[VAL_11:.*]] = arith.constant 100 : index
-! CHECK: %[[VAL_12:.*]] = fir.shape %[[VAL_11]] : (index) -> !fir.shape<1>
-! CHECK: %[[VAL_13:.*]] = arith.constant 1 : index
-! CHECK: %[[VAL_14:.*]] = hlfir.designate %[[VAL_10]]#0 (%[[VAL_13]]) : (!fir.ref<!fir.array<100xi64>>, index) -> !fir.ref<i64>
-! CHECK: %[[VAL_15:.*]] = fir.load %[[VAL_14]] : !fir.ref<i64>
-! CHECK: %[[VAL_16:.*]] = hlfir.designate %[[VAL_5]]#0 (%[[VAL_15]]) typeparams %[[VAL_1]]#1 : (!fir.box<!fir.array<100x!fir.char<1,?>>>, i64, index) -> !fir.boxchar<1>
-! CHECK: %[[VAL_17:.*]]:2 = fir.unboxchar %[[VAL_16]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
-! CHECK: %[[VAL_18:.*]]:2 = hlfir.declare %[[VAL_17]]#0 typeparams %[[VAL_1]]#1 {uniq_name = "mock.dummy"} : (!fir.ref<!fir.char<1,?>>, index) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>)
-! CHECK: %[[VAL_19:.*]] = fir.convert %[[VAL_1]]#1 : (index) -> i64
-! CHECK: %[[VAL_22:.*]] = fir.convert %[[VAL_19]] : (i64) -> index
-! CHECK: %[[VAL_23:.*]] = arith.constant 0 : index
-! CHECK: %[[VAL_24:.*]] = arith.cmpi sgt, %[[VAL_22]], %[[VAL_23]] : index
-! CHECK: %[[VAL_25:.*]] = arith.select %[[VAL_24]], %[[VAL_22]], %[[VAL_23]] : index
-! CHECK: %[[VAL_26:.*]] = hlfir.elemental %[[VAL_12]] typeparams %[[VAL_25]] unordered : (!fir.shape<1>, index) -> !hlfir.expr<100x!fir.char<1,?>> {
-! CHECK: ^bb0(%[[VAL_27:.*]]: index):
-! CHECK: %[[VAL_28:.*]] = hlfir.designate %[[VAL_10]]#0 (%[[VAL_27]]) : (!fir.ref<!fir.array<100xi64>>, index) -> !fir.ref<i64>
-! CHECK: %[[VAL_29:.*]] = fir.load %[[VAL_28]] : !fir.ref<i64>
-! CHECK: %[[VAL_30:.*]] = hlfir.designate %[[VAL_5]]#0 (%[[VAL_29]]) typeparams %[[VAL_1]]#1 : (!fir.box<!fir.array<100x!fir.char<1,?>>>, i64, index) -> !fir.boxchar<1>
-! CHECK: %[[VAL_41:.*]] = fir.call @_QPf(
-! CHECK: hlfir.yield_element %{{.*}} : !hlfir.expr<!fir.char<1,?>>
-! CHECK: }
-! CHECK: hlfir.assign %[[VAL_26]] to %[[VAL_5]]#0 : !hlfir.expr<100x!fir.char<1,?>>, !fir.box<!fir.array<100x!fir.char<1,?>>>
-! CHECK: hlfir.destroy %[[VAL_26]] : !hlfir.expr<100x!fir.char<1,?>>
-! CHECK: return
-! CHECK: }
More information about the flang-commits
mailing list