From 6956c9ac8086f9aa056796d9f8dee3e883bd4ae6 Mon Sep 17 00:00:00 2001 From: Jean Perier Date: Tue, 3 Oct 2023 01:57:27 -0700 Subject: [PATCH 1/4] [flang][NFC] Remove getOriginalActual from PreparedActualArgument Change in order to support vector subscripted entity passed by address in elemental calls. PreparedActualArguments will hold an hlfir::Entity or an hlfir::ElementalAddrOp. --- flang/include/flang/Lower/HlfirIntrinsics.h | 42 ++++++++++++++++++++- flang/lib/Lower/ConvertCall.cpp | 41 +++++++------------- flang/lib/Lower/HlfirIntrinsics.cpp | 4 +- 3 files changed, 56 insertions(+), 31 deletions(-) diff --git a/flang/include/flang/Lower/HlfirIntrinsics.h b/flang/include/flang/Lower/HlfirIntrinsics.h index df1f1ac9a7cf5..3e720669f2cf6 100644 --- a/flang/include/flang/Lower/HlfirIntrinsics.h +++ b/flang/include/flang/Lower/HlfirIntrinsics.h @@ -19,6 +19,7 @@ #define FORTRAN_LOWER_HLFIRINTRINSICS_H #include "flang/Optimizer/Builder/HLFIRTools.h" +#include "flang/Optimizer/HLFIR/HLFIROps.h" #include "llvm/ADT/SmallVector.h" #include #include @@ -56,8 +57,45 @@ struct PreparedActualArgument { *oneBasedElementalIndices); return actual; } - hlfir::Entity getOriginalActual() const { return actual; } - void setOriginalActual(hlfir::Entity newActual) { actual = newActual; } + + void derefPointersAndAllocatables(mlir::Location loc, + fir::FirOpBuilder &builder) { + actual = hlfir::derefPointersAndAllocatables(loc, builder, actual); + } + + void loadTrivialScalar(mlir::Location loc, fir::FirOpBuilder &builder) { + actual = hlfir::loadTrivialScalar(loc, builder, actual); + } + + /// Ensure an array expression argument is fully evaluated in memory before + /// the call. Useful for impure elemental calls. + hlfir::AssociateOp associateIfArrayExpr(mlir::Location loc, + fir::FirOpBuilder &builder) { + if (!actual.isVariable() && actual.isArray()) { + mlir::Type storageType = actual.getType(); + hlfir::AssociateOp associate = hlfir::genAssociateExpr( + loc, builder, actual, storageType, "adapt.impure_arg_eval"); + actual = hlfir::Entity{associate}; + return associate; + } + return {}; + } + + bool isArray() const { return actual.isArray(); } + + mlir::Value genShape(mlir::Location loc, fir::FirOpBuilder &builder) const { + return hlfir::genShape(loc, builder, actual); + } + + mlir::Value genCharLength(mlir::Location loc, + fir::FirOpBuilder &builder) const { + return hlfir::genCharLength(loc, builder, actual); + } + + /// When the argument is polymorphic, get mold value with the same dynamic + /// type. + mlir::Value getPolymorphicMold(mlir::Location loc) const { return actual; } + bool handleDynamicOptional() const { return isPresent.has_value(); } mlir::Value getIsPresent() const { assert(handleDynamicOptional() && "not a dynamic optional"); diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp index 169ef71d005cc..f65300ea20d98 100644 --- a/flang/lib/Lower/ConvertCall.cpp +++ b/flang/lib/Lower/ConvertCall.cpp @@ -1619,37 +1619,33 @@ class ElementalCallBuilder { for (unsigned i = 0; i < numArgs; ++i) { auto &preparedActual = loweredActuals[i]; if (preparedActual) { - hlfir::Entity actual = preparedActual->getOriginalActual(); // Elemental procedure dummy arguments cannot be pointer/allocatables // (C15100), so it is safe to dereference any pointer or allocatable // actual argument now instead of doing this inside the elemental // region. - actual = hlfir::derefPointersAndAllocatables(loc, builder, actual); + preparedActual->derefPointersAndAllocatables(loc, builder); // Better to load scalars outside of the loop when possible. if (!preparedActual->handleDynamicOptional() && impl().canLoadActualArgumentBeforeLoop(i)) - actual = hlfir::loadTrivialScalar(loc, builder, actual); + preparedActual->loadTrivialScalar(loc, builder); // TODO: merge shape instead of using the first one. - if (!shape && actual.isArray()) { + if (!shape && preparedActual->isArray()) { if (preparedActual->handleDynamicOptional()) optionalWithShape = &*preparedActual; else - shape = hlfir::genShape(loc, builder, actual); + shape = preparedActual->genShape(loc, builder); } // 15.8.3 p1. Elemental procedure with intent(out)/intent(inout) // arguments must be called in element order. if (impl().argMayBeModifiedByCall(i)) mustBeOrdered = true; - // Propagates pointer dereferences and scalar loads. - preparedActual->setOriginalActual(actual); } } if (!shape && optionalWithShape) { // If all array operands appear in optional positions, then none of them // is allowed to be absent as per 15.5.2.12 point 3. (6). Just pick the // first operand. - shape = - hlfir::genShape(loc, builder, optionalWithShape->getOriginalActual()); + shape = optionalWithShape->genShape(loc, builder); // TODO: There is an opportunity to add a runtime check here that // this array is present as required. Also, the optionality of all actual // could be checked and reset given the Fortran requirement. @@ -1663,20 +1659,12 @@ class ElementalCallBuilder { // intent(inout) arguments. Note that the scalar arguments are handled // above. if (mustBeOrdered) { - for (unsigned i = 0; i < numArgs; ++i) { - auto &preparedActual = loweredActuals[i]; - if (preparedActual) { - hlfir::Entity actual = preparedActual->getOriginalActual(); - if (!actual.isVariable() && actual.isArray()) { - mlir::Type storageType = actual.getType(); - hlfir::AssociateOp associate = hlfir::genAssociateExpr( - loc, builder, actual, storageType, "adapt.impure_arg_eval"); - preparedActual->setOriginalActual(hlfir::Entity{associate}); - - fir::FirOpBuilder *bldr = &builder; - callContext.stmtCtx.attachCleanup( - [=]() { bldr->create(loc, associate); }); - } + for (auto &preparedActual : loweredActuals) { + if (hlfir::AssociateOp associate = + preparedActual->associateIfArrayExpr(loc, builder)) { + fir::FirOpBuilder *bldr = &builder; + callContext.stmtCtx.attachCleanup( + [=]() { bldr->create(loc, associate); }); } } } @@ -1852,9 +1840,8 @@ class ElementalIntrinsicCallBuilder if (intrinsic) if (intrinsic->name == "adjustr" || intrinsic->name == "adjustl" || intrinsic->name == "merge") - return hlfir::genCharLength( - callContext.loc, callContext.getBuilder(), - loweredActuals[0].value().getOriginalActual()); + return loweredActuals[0].value().genCharLength( + callContext.loc, callContext.getBuilder()); // Character MIN/MAX is the min/max of the arguments length that are // present. TODO(callContext.loc, @@ -1874,7 +1861,7 @@ class ElementalIntrinsicCallBuilder // the same declared and dynamic types. So any of them can be used // for the mold. assert(!loweredActuals.empty()); - return loweredActuals.front()->getOriginalActual(); + return loweredActuals.front()->getPolymorphicMold(callContext.loc); } return {}; diff --git a/flang/lib/Lower/HlfirIntrinsics.cpp b/flang/lib/Lower/HlfirIntrinsics.cpp index 20e570044e8d4..9f764b6142522 100644 --- a/flang/lib/Lower/HlfirIntrinsics.cpp +++ b/flang/lib/Lower/HlfirIntrinsics.cpp @@ -152,7 +152,7 @@ mlir::Value HlfirTransformationalIntrinsic::loadBoxAddress( if (!arg) return mlir::Value{}; - hlfir::Entity actual = arg->getOriginalActual(); + hlfir::Entity actual = arg->getActual(loc, builder); if (!arg->handleDynamicOptional()) { if (actual.isMutableBox()) { @@ -193,7 +193,7 @@ llvm::SmallVector HlfirTransformationalIntrinsic::getOperandVector( operands.emplace_back(); continue; } - hlfir::Entity actual = arg->getOriginalActual(); + hlfir::Entity actual = arg->getActual(loc, builder); mlir::Value valArg; if (!argLowering) { From 4444c39b4564d114cecd7272b21aa7e32886f4c9 Mon Sep 17 00:00:00 2001 From: Jean Perier Date: Tue, 3 Oct 2023 03:18:20 -0700 Subject: [PATCH 2/4] [flang][hlfir] Pass vector subscripted elemental call arg by address I missed that vector subscripted arguments must still be passed by address in an elemental call where the dummy argument does not have the VALUE attribute. Update PreparedActualArgument to hold an hlfir::Entity or an hlfir::ElementalOp and to inline the elementalOp body in `getActual`. --- flang/include/flang/Lower/HlfirIntrinsics.h | 63 ++++++++++------ flang/lib/Lower/ConvertCall.cpp | 40 +++++++++- .../elemental-call-vector-subscripts.f90 | 73 +++++++++++++++++++ 3 files changed, 151 insertions(+), 25 deletions(-) create mode 100644 flang/test/Lower/HLFIR/elemental-call-vector-subscripts.f90 diff --git a/flang/include/flang/Lower/HlfirIntrinsics.h b/flang/include/flang/Lower/HlfirIntrinsics.h index 3e720669f2cf6..088f8bccef4aa 100644 --- a/flang/include/flang/Lower/HlfirIntrinsics.h +++ b/flang/include/flang/Lower/HlfirIntrinsics.h @@ -19,6 +19,7 @@ #define FORTRAN_LOWER_HLFIRINTRINSICS_H #include "flang/Optimizer/Builder/HLFIRTools.h" +#include "flang/Optimizer/Builder/Todo.h" #include "flang/Optimizer/HLFIR/HLFIROps.h" #include "llvm/ADT/SmallVector.h" #include @@ -47,54 +48,70 @@ struct PreparedActualArgument { PreparedActualArgument(hlfir::Entity actual, std::optional isPresent) : actual{actual}, isPresent{isPresent} {} + PreparedActualArgument(hlfir::ElementalAddrOp vectorSubscriptedActual) + : actual{vectorSubscriptedActual}, isPresent{std::nullopt} {} void setElementalIndices(mlir::ValueRange &indices) { oneBasedElementalIndices = &indices; } - hlfir::Entity getActual(mlir::Location loc, - fir::FirOpBuilder &builder) const { - if (oneBasedElementalIndices) - return hlfir::getElementAt(loc, builder, actual, - *oneBasedElementalIndices); - return actual; - } + + /// Get the prepared actual. If this is an array argument in an elemental + /// call, the current element value will be returned. + hlfir::Entity getActual(mlir::Location loc, fir::FirOpBuilder &builder) const; void derefPointersAndAllocatables(mlir::Location loc, fir::FirOpBuilder &builder) { - actual = hlfir::derefPointersAndAllocatables(loc, builder, actual); + if (auto *actualEntity = std::get_if(&actual)) + actual = hlfir::derefPointersAndAllocatables(loc, builder, *actualEntity); } void loadTrivialScalar(mlir::Location loc, fir::FirOpBuilder &builder) { - actual = hlfir::loadTrivialScalar(loc, builder, actual); + if (auto *actualEntity = std::get_if(&actual)) + actual = hlfir::loadTrivialScalar(loc, builder, *actualEntity); } /// Ensure an array expression argument is fully evaluated in memory before /// the call. Useful for impure elemental calls. hlfir::AssociateOp associateIfArrayExpr(mlir::Location loc, fir::FirOpBuilder &builder) { - if (!actual.isVariable() && actual.isArray()) { - mlir::Type storageType = actual.getType(); - hlfir::AssociateOp associate = hlfir::genAssociateExpr( - loc, builder, actual, storageType, "adapt.impure_arg_eval"); - actual = hlfir::Entity{associate}; - return associate; + if (auto *actualEntity = std::get_if(&actual)) { + if (!actualEntity->isVariable() && actualEntity->isArray()) { + mlir::Type storageType = actualEntity->getType(); + hlfir::AssociateOp associate = hlfir::genAssociateExpr( + loc, builder, *actualEntity, storageType, "adapt.impure_arg_eval"); + actual = hlfir::Entity{associate}; + return associate; + } } return {}; } - bool isArray() const { return actual.isArray(); } + bool isArray() const { + return std::holds_alternative(actual) || + std::get(actual).isArray(); + } - mlir::Value genShape(mlir::Location loc, fir::FirOpBuilder &builder) const { - return hlfir::genShape(loc, builder, actual); + mlir::Value genShape(mlir::Location loc, fir::FirOpBuilder &builder) { + if (auto *actualEntity = std::get_if(&actual)) + return hlfir::genShape(loc, builder, *actualEntity); + return std::get(actual).getShape(); } - mlir::Value genCharLength(mlir::Location loc, - fir::FirOpBuilder &builder) const { - return hlfir::genCharLength(loc, builder, actual); + mlir::Value genCharLength(mlir::Location loc, fir::FirOpBuilder &builder) { + if (auto *actualEntity = std::get_if(&actual)) + return hlfir::genCharLength(loc, builder, *actualEntity); + auto typeParams = std::get(actual).getTypeparams(); + assert(typeParams.size() == 1 && + "failed to retrieve vector subscripted character length"); + return typeParams[0]; } /// When the argument is polymorphic, get mold value with the same dynamic /// type. - mlir::Value getPolymorphicMold(mlir::Location loc) const { return actual; } + mlir::Value getPolymorphicMold(mlir::Location loc) const { + if (auto *actualEntity = std::get_if(&actual)) + return *actualEntity; + TODO(loc, "polymorphic vector subscripts"); + } bool handleDynamicOptional() const { return isPresent.has_value(); } mlir::Value getIsPresent() const { @@ -105,7 +122,7 @@ struct PreparedActualArgument { void resetOptionalAspect() { isPresent = std::nullopt; } private: - hlfir::Entity actual; + std::variant actual; mlir::ValueRange *oneBasedElementalIndices{nullptr}; // When the actual may be dynamically optional, "isPresent" // holds a boolean value indicating the presence of the diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp index f65300ea20d98..ab2401feefc4a 100644 --- a/flang/lib/Lower/ConvertCall.cpp +++ b/flang/lib/Lower/ConvertCall.cpp @@ -29,6 +29,7 @@ #include "flang/Optimizer/Builder/Todo.h" #include "flang/Optimizer/Dialect/FIROpsSupport.h" #include "flang/Optimizer/HLFIR/HLFIROps.h" +#include "mlir/IR/IRMapping.h" #include "llvm/Support/CommandLine.h" #include "llvm/Support/Debug.h" #include @@ -2124,7 +2125,7 @@ genProcedureRef(CallContext &callContext) { Fortran::lower::CallerInterface caller(callContext.procRef, callContext.converter); mlir::FunctionType callSiteType = caller.genFunctionType(); - + const bool isElemental = callContext.isElementalProcWithArrayArgs(); Fortran::lower::PreparedActualArguments loweredActuals; // Lower the actual arguments for (const Fortran::lower::CallInterface< @@ -2149,6 +2150,20 @@ genProcedureRef(CallContext &callContext) { } } + if (isElemental && !arg.hasValueAttribute() && + Fortran::evaluate::HasVectorSubscript(*expr)) { + // Vector subscripted arguments are copied in calls, except in elemental + // calls without VALUE attribute where Fortran 2018 15.5.2.4 point 21 + // does not apply and the address of each element must be passed. + hlfir::ElementalAddrOp elementalAddr = + Fortran::lower::convertVectorSubscriptedExprToElementalAddr( + loc, callContext.converter, *expr, callContext.symMap, + callContext.stmtCtx); + loweredActuals.emplace_back( + Fortran::lower::PreparedActualArgument{elementalAddr}); + continue; + } + auto loweredActual = Fortran::lower::convertExprToHLFIR( loc, callContext.converter, *expr, callContext.symMap, callContext.stmtCtx); @@ -2165,7 +2180,7 @@ genProcedureRef(CallContext &callContext) { // Optional dummy argument for which there is no actual argument. loweredActuals.emplace_back(std::nullopt); } - if (callContext.isElementalProcWithArrayArgs()) { + if (isElemental) { bool isImpure = false; if (const Fortran::semantics::Symbol *procSym = callContext.procRef.proc().GetSymbol()) @@ -2176,6 +2191,27 @@ genProcedureRef(CallContext &callContext) { return genUserCall(loweredActuals, caller, callSiteType, callContext); } +hlfir::Entity Fortran::lower::PreparedActualArgument::getActual( + mlir::Location loc, fir::FirOpBuilder &builder) const { + if (auto *actualEntity = std::get_if(&actual)) { + if (oneBasedElementalIndices) + return hlfir::getElementAt(loc, builder, *actualEntity, + *oneBasedElementalIndices); + return *actualEntity; + } + assert(oneBasedElementalIndices && "expect elemental context"); + hlfir::ElementalAddrOp elementalAddr = + std::get(actual); + mlir::IRMapping mapper; + auto alwaysFalse = [](hlfir::ElementalOp) -> bool { return false; }; + mlir::Value addr = hlfir::inlineElementalOp( + loc, builder, elementalAddr, *oneBasedElementalIndices, mapper, + /*mustRecursivelyInline=*/alwaysFalse); + assert(elementalAddr.getCleanup().empty() && "no clean-up expected"); + elementalAddr.erase(); + return hlfir::Entity{addr}; +} + bool Fortran::lower::isIntrinsicModuleProcRef( const Fortran::evaluate::ProcedureRef &procRef) { const Fortran::semantics::Symbol *symbol = procRef.proc().GetSymbol(); diff --git a/flang/test/Lower/HLFIR/elemental-call-vector-subscripts.f90 b/flang/test/Lower/HLFIR/elemental-call-vector-subscripts.f90 new file mode 100644 index 0000000000000..8d2e5cf00fb54 --- /dev/null +++ b/flang/test/Lower/HLFIR/elemental-call-vector-subscripts.f90 @@ -0,0 +1,73 @@ +! Test passing of vector subscripted entities inside elemental +! procedures. +! RUN: bbc --emit-hlfir -o - %s | FileCheck %s + +subroutine test() + interface + elemental subroutine foo(x, y) + real, intent(in) :: x + real, value :: y + end subroutine + end interface + real :: x(10) + call foo(x([1,3,7]), 0.) +end subroutine +! CHECK-LABEL: func.func @_QPtest() { +! CHECK: %[[VAL_0:.*]] = arith.constant 10 : index +! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.array<10xf32> {bindc_name = "x", uniq_name = "_QFtestEx"} +! CHECK: %[[VAL_2:.*]] = fir.shape %[[VAL_0]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_1]](%[[VAL_2]]) {uniq_name = "_QFtestEx"} : (!fir.ref>, !fir.shape<1>) -> (!fir.ref>, !fir.ref>) +! CHECK: %[[VAL_4:.*]] = fir.address_of(@_QQro.3xi8.0) : !fir.ref> +! CHECK: %[[VAL_5:.*]] = arith.constant 3 : index +! CHECK: %[[VAL_6:.*]] = fir.shape %[[VAL_5]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_7:.*]]:2 = hlfir.declare %[[VAL_4]](%[[VAL_6]]) +! CHECK: %[[VAL_8:.*]] = arith.constant 3 : index +! CHECK: %[[VAL_9:.*]] = arith.constant 0.000000e+00 : f32 +! CHECK: %[[VAL_10:.*]] = arith.constant 1 : index +! CHECK: fir.do_loop %[[VAL_11:.*]] = %[[VAL_10]] to %[[VAL_8]] step %[[VAL_10]] unordered { +! CHECK: %[[VAL_12:.*]] = hlfir.designate %[[VAL_7]]#0 (%[[VAL_11]]) : (!fir.ref>, index) -> !fir.ref +! CHECK: %[[VAL_13:.*]] = fir.load %[[VAL_12]] : !fir.ref +! CHECK: %[[VAL_14:.*]] = hlfir.designate %[[VAL_3]]#0 (%[[VAL_13]]) : (!fir.ref>, i64) -> !fir.ref +! CHECK: fir.call @_QPfoo(%[[VAL_14]], %[[VAL_9]]) {{.*}}: (!fir.ref, f32) -> () +! CHECK: } +! CHECK: return +! CHECK: } + +subroutine test_value() + interface + elemental subroutine foo_value(x, y) + real, value :: x + real, value :: y + end subroutine + end interface + real :: x(10) + call foo_value(x([1,3,7]), 0.) +end subroutine + +! CHECK-LABEL: func.func @_QPtest_value() { +! CHECK: %[[VAL_0:.*]] = arith.constant 10 : index +! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.array<10xf32> {bindc_name = "x", uniq_name = "_QFtest_valueEx"} +! CHECK: %[[VAL_2:.*]] = fir.shape %[[VAL_0]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_1]](%[[VAL_2]]) {uniq_name = "_QFtest_valueEx"} : (!fir.ref>, !fir.shape<1>) -> (!fir.ref>, !fir.ref>) +! CHECK: %[[VAL_4:.*]] = fir.address_of(@_QQro.3xi8.0) : !fir.ref> +! CHECK: %[[VAL_5:.*]] = arith.constant 3 : index +! CHECK: %[[VAL_6:.*]] = fir.shape %[[VAL_5]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_7:.*]]:2 = hlfir.declare %[[VAL_4]](%[[VAL_6]]) +! CHECK: %[[VAL_8:.*]] = arith.constant 3 : index +! CHECK: %[[VAL_9:.*]] = fir.shape %[[VAL_8]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_10:.*]] = hlfir.elemental %[[VAL_9]] unordered : (!fir.shape<1>) -> !hlfir.expr<3xf32> { +! CHECK: ^bb0(%[[VAL_11:.*]]: index): +! CHECK: %[[VAL_12:.*]] = hlfir.designate %[[VAL_7]]#0 (%[[VAL_11]]) : (!fir.ref>, index) -> !fir.ref +! CHECK: %[[VAL_13:.*]] = fir.load %[[VAL_12]] : !fir.ref +! CHECK: %[[VAL_14:.*]] = hlfir.designate %[[VAL_3]]#0 (%[[VAL_13]]) : (!fir.ref>, i64) -> !fir.ref +! CHECK: %[[VAL_15:.*]] = fir.load %[[VAL_14]] : !fir.ref +! CHECK: hlfir.yield_element %[[VAL_15]] : f32 +! CHECK: } +! CHECK: %[[VAL_16:.*]] = arith.constant 0.000000e+00 : f32 +! CHECK: %[[VAL_17:.*]] = arith.constant 1 : index +! CHECK: fir.do_loop %[[VAL_18:.*]] = %[[VAL_17]] to %[[VAL_8]] step %[[VAL_17]] unordered { +! CHECK: %[[VAL_19:.*]] = hlfir.apply %[[VAL_10]], %[[VAL_18]] : (!hlfir.expr<3xf32>, index) -> f32 +! CHECK: fir.call @_QPfoo_value(%[[VAL_19]], %[[VAL_16]]) {{.*}}: (f32, f32) -> () +! CHECK: } +! CHECK: hlfir.destroy %[[VAL_10]] : !hlfir.expr<3xf32> +! CHECK: return From a0179e060fd12881efa1d9fcdba3b14a4ce83d35 Mon Sep 17 00:00:00 2001 From: Jean Perier Date: Wed, 4 Oct 2023 01:44:09 -0700 Subject: [PATCH 3/4] add back if removed by mistake --- flang/lib/Lower/ConvertCall.cpp | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp index ab2401feefc4a..4c1339371bec6 100644 --- a/flang/lib/Lower/ConvertCall.cpp +++ b/flang/lib/Lower/ConvertCall.cpp @@ -1661,11 +1661,13 @@ class ElementalCallBuilder { // above. if (mustBeOrdered) { for (auto &preparedActual : loweredActuals) { - if (hlfir::AssociateOp associate = - preparedActual->associateIfArrayExpr(loc, builder)) { - fir::FirOpBuilder *bldr = &builder; - callContext.stmtCtx.attachCleanup( - [=]() { bldr->create(loc, associate); }); + if (preparedActual) { + if (hlfir::AssociateOp associate = + preparedActual->associateIfArrayExpr(loc, builder)) { + fir::FirOpBuilder *bldr = &builder; + callContext.stmtCtx.attachCleanup( + [=]() { bldr->create(loc, associate); }); + } } } } From c68299f8be0ba5d3ed8ed73b08c0a98756a1c532 Mon Sep 17 00:00:00 2001 From: Jean Perier Date: Wed, 4 Oct 2023 02:41:41 -0700 Subject: [PATCH 4/4] test IsVariable before HasVectorSubscript I mistakenly thought that HasVectorSubscript would only return true for variables, but it return true for expressions containing vector subscripted designator in general. Fix and add a test. --- flang/lib/Lower/ConvertCall.cpp | 1 + .../elemental-call-vector-subscripts.f90 | 20 +++++++++++++++++++ 2 files changed, 21 insertions(+) diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp index 4c1339371bec6..90025ba9c687a 100644 --- a/flang/lib/Lower/ConvertCall.cpp +++ b/flang/lib/Lower/ConvertCall.cpp @@ -2153,6 +2153,7 @@ genProcedureRef(CallContext &callContext) { } if (isElemental && !arg.hasValueAttribute() && + Fortran::evaluate::IsVariable(*expr) && Fortran::evaluate::HasVectorSubscript(*expr)) { // Vector subscripted arguments are copied in calls, except in elemental // calls without VALUE attribute where Fortran 2018 15.5.2.4 point 21 diff --git a/flang/test/Lower/HLFIR/elemental-call-vector-subscripts.f90 b/flang/test/Lower/HLFIR/elemental-call-vector-subscripts.f90 index 8d2e5cf00fb54..b8f7ee9338fbd 100644 --- a/flang/test/Lower/HLFIR/elemental-call-vector-subscripts.f90 +++ b/flang/test/Lower/HLFIR/elemental-call-vector-subscripts.f90 @@ -71,3 +71,23 @@ elemental subroutine foo_value(x, y) ! CHECK: } ! CHECK: hlfir.destroy %[[VAL_10]] : !hlfir.expr<3xf32> ! CHECK: return + +subroutine test_not_a_variable(i) + interface + elemental subroutine foo2(j) + integer(8), intent(in) :: j + end subroutine + end interface + integer(8) :: i(:) + call foo2((i(i))) +end subroutine +! CHECK-LABEL: func.func @_QPtest_not_a_variable( +! CHECK: hlfir.elemental +! CHECK: %[[VAL_16:.*]] = hlfir.elemental +! CHECK: %[[VAL_20:.*]] = arith.constant 1 : index +! CHECK: fir.do_loop %[[VAL_21:.*]] = {{.*}} +! CHECK: %[[VAL_22:.*]] = hlfir.apply %[[VAL_16]], %[[VAL_21]] : (!hlfir.expr, index) -> i64 +! CHECK: %[[VAL_23:.*]]:3 = hlfir.associate %[[VAL_22]] {uniq_name = "adapt.valuebyref"} : (i64) -> (!fir.ref, !fir.ref, i1) +! CHECK: fir.call @_QPfoo2(%[[VAL_23]]#1){{.*}}: (!fir.ref) -> () +! CHECK: hlfir.end_associate %[[VAL_23]]#1, %[[VAL_23]]#2 : !fir.ref, i1 +! CHECK: }