diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp index 9d746fa6dd194..60ad5bd234773 100644 --- a/flang/lib/Lower/ConvertCall.cpp +++ b/flang/lib/Lower/ConvertCall.cpp @@ -1192,20 +1192,26 @@ genUserCall(Fortran::lower::PreparedActualArguments &loweredActuals, return extendedValueToHlfirEntity(loc, builder, result, ".tmp.func_result"); } -/// Create an optional dummy argument value from \p entity that may be -/// absent. This can only be called with numerical or logical scalar \p entity. -/// If \p entity is considered absent according to 15.5.2.12 point 1., the -/// returned value is zero (or false), otherwise it is the value of \p entity. +/// Create an optional dummy argument value from an entity that may be +/// absent. \p actualGetter callback returns hlfir::Entity denoting +/// the lowered actual argument. \p actualGetter can only return numerical +/// or logical scalar entity. +/// If the entity is considered absent according to 15.5.2.12 point 1., the +/// returned value is zero (or false), otherwise it is the value of the entity. +/// \p eleType specifies the entity's Fortran element type. +template static ExvAndCleanup genOptionalValue(fir::FirOpBuilder &builder, - mlir::Location loc, hlfir::Entity entity, - mlir::Value isPresent) { - mlir::Type eleType = entity.getFortranElementType(); - assert(entity.isScalar() && fir::isa_trivial(eleType) && - "must be a numerical or logical scalar"); + mlir::Location loc, mlir::Type eleType, + T actualGetter, mlir::Value isPresent) { return {builder .genIfOp(loc, {eleType}, isPresent, /*withElseRegion=*/true) .genThen([&]() { + hlfir::Entity entity = actualGetter(loc, builder); + assert(eleType == entity.getFortranElementType() && + "result type mismatch in genOptionalValue"); + assert(entity.isScalar() && fir::isa_trivial(eleType) && + "must be a numerical or logical scalar"); mlir::Value val = hlfir::loadTrivialScalar(loc, builder, entity); builder.create(loc, val); @@ -1288,9 +1294,9 @@ genIntrinsicRefCore(Fortran::lower::PreparedActualArguments &loweredActuals, operands.emplace_back(fir::getAbsentIntrinsicArgument()); continue; } - hlfir::Entity actual = arg.value()->getActual(loc, builder); if (!argLowering) { // No argument lowering instruction, lower by value. + hlfir::Entity actual = arg.value()->getActual(loc, builder); operands.emplace_back( Fortran::lower::convertToValue(loc, converter, actual, stmtCtx)); continue; @@ -1316,24 +1322,40 @@ genIntrinsicRefCore(Fortran::lower::PreparedActualArguments &loweredActuals, mlir::Value isPresent = arg.value()->getIsPresent(); switch (argRules.lowerAs) { case fir::LowerIntrinsicArgAs::Value: { - auto [exv, cleanup] = genOptionalValue(builder, loc, actual, isPresent); + // In case of elemental call, getActual() may produce + // a designator denoting the array element to be passed + // to the subprogram. If the actual array is dynamically + // optional the designator must be generated under + // isPresent check, because the box bounds reads will be + // generated in the codegen. These reads are illegal, + // if the dynamically optional argument is absent. + auto getActualCb = [&](mlir::Location loc, + fir::FirOpBuilder &builder) -> hlfir::Entity { + return arg.value()->getActual(loc, builder); + }; + auto [exv, cleanup] = + genOptionalValue(builder, loc, getActualFortranElementType(), + getActualCb, isPresent); addToCleanups(std::move(cleanup)); operands.emplace_back(exv); continue; } case fir::LowerIntrinsicArgAs::Addr: { + hlfir::Entity actual = arg.value()->getActual(loc, builder); auto [exv, cleanup] = genOptionalAddr(builder, loc, actual, isPresent); addToCleanups(std::move(cleanup)); operands.emplace_back(exv); continue; } case fir::LowerIntrinsicArgAs::Box: { + hlfir::Entity actual = arg.value()->getActual(loc, builder); auto [exv, cleanup] = genOptionalBox(builder, loc, actual, isPresent); addToCleanups(std::move(cleanup)); operands.emplace_back(exv); continue; } case fir::LowerIntrinsicArgAs::Inquired: { + hlfir::Entity actual = arg.value()->getActual(loc, builder); auto [exv, cleanup] = hlfir::translateToExtendedValue(loc, builder, actual); addToCleanups(std::move(cleanup)); @@ -1343,6 +1365,8 @@ genIntrinsicRefCore(Fortran::lower::PreparedActualArguments &loweredActuals, } llvm_unreachable("bad switch"); } + + hlfir::Entity actual = arg.value()->getActual(loc, builder); switch (argRules.lowerAs) { case fir::LowerIntrinsicArgAs::Value: operands.emplace_back( diff --git a/flang/test/Lower/HLFIR/intrinsic-dynamically-optional.f90 b/flang/test/Lower/HLFIR/intrinsic-dynamically-optional.f90 index 923d7735f3ec4..39671d7931a17 100644 --- a/flang/test/Lower/HLFIR/intrinsic-dynamically-optional.f90 +++ b/flang/test/Lower/HLFIR/intrinsic-dynamically-optional.f90 @@ -153,5 +153,50 @@ subroutine test_optional_as_addr ! CHECK: return ! CHECK: } +! imaginary component is dyamically optional, lowered as a value +! Test placement of the designator under isPresent check. +function test_elemental_optional_as_value(real, imaginary) + real :: real(3) + real, optional :: imaginary(3) + complex :: test_elemental_optional_as_value(3) + test_elemental_optional_as_value = cmplx(real, imaginary) +end function +! CHECK-LABEL: func.func @_QPtest_elemental_optional_as_value( +! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref> {fir.bindc_name = "real"}, +! CHECK-SAME: %[[VAL_1:.*]]: !fir.ref> {fir.bindc_name = "imaginary", fir.optional}) -> !fir.array<3x!fir.complex<4>> { +! CHECK: %[[VAL_2:.*]] = arith.constant 3 : index +! CHECK: %[[VAL_3:.*]] = fir.shape %[[VAL_2]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_4:.*]]:2 = hlfir.declare %[[VAL_1]](%[[VAL_3]]) {fortran_attrs = #fir.var_attrs, uniq_name = "_QFtest_elemental_optional_as_valueEimaginary"} : (!fir.ref>, !fir.shape<1>) -> (!fir.ref>, !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_0]](%[[VAL_6]]) {uniq_name = "_QFtest_elemental_optional_as_valueEreal"} : (!fir.ref>, !fir.shape<1>) -> (!fir.ref>, !fir.ref>) +! CHECK: %[[VAL_8:.*]] = arith.constant 3 : index +! CHECK: %[[VAL_9:.*]] = fir.alloca !fir.array<3x!fir.complex<4>> {bindc_name = "test_elemental_optional_as_value", uniq_name = "_QFtest_elemental_optional_as_valueEtest_elemental_optional_as_value"} +! CHECK: %[[VAL_10:.*]] = fir.shape %[[VAL_8]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_11:.*]]:2 = hlfir.declare %[[VAL_9]](%[[VAL_10]]) {uniq_name = "_QFtest_elemental_optional_as_valueEtest_elemental_optional_as_value"} : (!fir.ref>>, !fir.shape<1>) -> (!fir.ref>>, !fir.ref>>) +! CHECK: %[[VAL_12:.*]] = fir.is_present %[[VAL_4]]#0 : (!fir.ref>) -> i1 +! CHECK: %[[VAL_13:.*]] = hlfir.elemental %[[VAL_6]] unordered : (!fir.shape<1>) -> !hlfir.expr<3x!fir.complex<4>> { +! CHECK: ^bb0(%[[VAL_14:.*]]: index): +! CHECK: %[[VAL_15:.*]] = hlfir.designate %[[VAL_7]]#0 (%[[VAL_14]]) : (!fir.ref>, index) -> !fir.ref +! CHECK: %[[VAL_16:.*]] = fir.load %[[VAL_15]] : !fir.ref +! CHECK: %[[VAL_17:.*]] = fir.if %[[VAL_12]] -> (f32) { +! CHECK: %[[VAL_18:.*]] = hlfir.designate %[[VAL_4]]#0 (%[[VAL_14]]) : (!fir.ref>, index) -> !fir.ref +! CHECK: %[[VAL_19:.*]] = fir.load %[[VAL_18]] : !fir.ref +! CHECK: fir.result %[[VAL_19]] : f32 +! CHECK: } else { +! CHECK: %[[VAL_20:.*]] = arith.constant 0.000000e+00 : f32 +! CHECK: fir.result %[[VAL_20]] : f32 +! CHECK: } +! CHECK: %[[VAL_21:.*]] = fir.undefined !fir.complex<4> +! CHECK: %[[VAL_22:.*]] = fir.insert_value %[[VAL_21]], %[[VAL_16]], [0 : index] : (!fir.complex<4>, f32) -> !fir.complex<4> +! CHECK: %[[VAL_23:.*]] = fir.insert_value %[[VAL_22]], %[[VAL_17]], [1 : index] : (!fir.complex<4>, f32) -> !fir.complex<4> +! CHECK: hlfir.yield_element %[[VAL_23]] : !fir.complex<4> +! CHECK: } +! CHECK: hlfir.assign %[[VAL_13]] to %[[VAL_11]]#0 : !hlfir.expr<3x!fir.complex<4>>, !fir.ref>> +! CHECK: hlfir.destroy %[[VAL_13]] : !hlfir.expr<3x!fir.complex<4>> +! CHECK: %[[VAL_24:.*]] = fir.load %[[VAL_11]]#1 : !fir.ref>> +! CHECK: return %[[VAL_24]] : !fir.array<3x!fir.complex<4>> +! CHECK: } + ! TODO: there seem to be no intrinsics with dynamically optional arguments lowered asInquired