[flang][hlfir] Fixed byval passing for dynamically optional intrinsic args.

[vzakhari]

Summary

In the context of elemental operation a dynamically optional
intrinsic argument must be lowered such that the elemental
designator is generated under isPresent check.

[tblah]

Thanks for catching this! LGTM

flang/lib/Lower/ConvertCall.cpp

for (auto cleanUp : callCleanUps)
     cleanUp.genCleanUp(loc, builder);
 
   if (!fir::getBase(result))
     return std::nullopt; // subroutine call.
   // TODO: "move" non pointer results into hlfir.expr.
   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 <typename T>
 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<fir::ResultOp>(loc, val);
               })
               .genElse([&]() {
                 mlir::Value zero =
                     fir::factory::createZeroValue(builder, loc, eleType);
                 builder.create<fir::ResultOp>(loc, zero);
genIntrinsicRefCore(Fortran::lower::PreparedActualArguments &loweredActuals,
   auto &converter = callContext.converter;
   fir::FirOpBuilder &builder = callContext.getBuilder();
   mlir::Location loc = callContext.loc;
   for (auto arg : llvm::enumerate(loweredActuals)) {
     if (!arg.value()) {
       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;
     }
     // Helper to get the type of the Fortran expression in case it is a
     // computed value that must be placed in memory (logicals are computed as
     // i1, but must be placed in memory as fir.logical).
     auto getActualFortranElementType = [&]() -> mlir::Type {
for (auto arg : llvm::enumerate(loweredActuals)) {
     };
     // Ad-hoc argument lowering handling.
     fir::ArgLoweringRule argRules =
         fir::lowerIntrinsicArgumentAs(*argLowering, arg.index());
     if (arg.value()->handleDynamicOptional()) {
       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));
         operands.emplace_back(exv);
         continue;
       }
       }
       llvm_unreachable("bad switch");
     }
+
+    hlfir::Entity actual = arg.value()->getActual(loc, builder);
     switch (argRules.lowerAs) {
     case fir::LowerIntrinsicArgAs::Value:
       operands.emplace_back(
           Fortran::lower::convertToValue(loc, converter, actual, stmtCtx));
       continue;
     case fir::LowerIntrinsicArgAs::Addr:
       operands.emplace_back(Fortran::lower::convertToAddress(
           loc, converter, actual, stmtCtx, getActualFortranElementType()));

flang/test/Lower/HLFIR/intrinsic-dynamically-optional.f90

 ! CHECK:           %[[STAT_NOT_NULL:.*]] = arith.cmpi ne, %[[STAT_INT]], %[[C0_3]] : i64
 ! CHECK:           fir.if %[[STAT_NOT_NULL]] {
 ! CHECK:             fir.store %[[RES]] to %[[STAT_ADDR]] : !fir.heap<i32>
 ! CHECK:           }
 !                  [...]
 ! 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.array<3xf32>> {fir.bindc_name = "real"},
+! CHECK-SAME:                                                   %[[VAL_1:.*]]: !fir.ref<!fir.array<3xf32>> {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<optional>, uniq_name = "_QFtest_elemental_optional_as_valueEimaginary"} : (!fir.ref<!fir.array<3xf32>>, !fir.shape<1>) -> (!fir.ref<!fir.array<3xf32>>, !fir.ref<!fir.array<3xf32>>)
+! 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.array<3xf32>>, !fir.shape<1>) -> (!fir.ref<!fir.array<3xf32>>, !fir.ref<!fir.array<3xf32>>)
+! 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.array<3x!fir.complex<4>>>, !fir.shape<1>) -> (!fir.ref<!fir.array<3x!fir.complex<4>>>, !fir.ref<!fir.array<3x!fir.complex<4>>>)
+! CHECK:           %[[VAL_12:.*]] = fir.is_present %[[VAL_4]]#0 : (!fir.ref<!fir.array<3xf32>>) -> 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<!fir.array<3xf32>>, index) -> !fir.ref<f32>
+! CHECK:             %[[VAL_16:.*]] = fir.load %[[VAL_15]] : !fir.ref<f32>
+! CHECK:             %[[VAL_17:.*]] = fir.if %[[VAL_12]] -> (f32) {
+! CHECK:               %[[VAL_18:.*]] = hlfir.designate %[[VAL_4]]#0 (%[[VAL_14]])  : (!fir.ref<!fir.array<3xf32>>, index) -> !fir.ref<f32>
+! CHECK:               %[[VAL_19:.*]] = fir.load %[[VAL_18]] : !fir.ref<f32>
+! 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<!fir.array<3x!fir.complex<4>>>
+! CHECK:           hlfir.destroy %[[VAL_13]] : !hlfir.expr<3x!fir.complex<4>>
+! CHECK:           %[[VAL_24:.*]] = fir.load %[[VAL_11]]#1 : !fir.ref<!fir.array<3x!fir.complex<4>>>
+! CHECK:           return %[[VAL_24]] : !fir.array<3x!fir.complex<4>>
+! CHECK:         }
+
 ! TODO: there seem to be no intrinsics with dynamically optional arguments lowered asInquired