[flang] Lower procedure ref to user defined elemental procedures (part 1)

[jeanPerier]

Summary

Lower procedure ref to user defined elemental procedure when:

• there are no arguments that may be dynamically optional
• for functions, the result has no length parameters
• the reference can be unordered
• there are not character by value arguments

This uses the recently added hlfir.elemental operation and tools.
The "core" of the argument preparation is shared between elemental
and non elemental calls (genUserCalls is code moved without any
functional changes)

Depends on D140099

[PeteSteinfeld]

All builds and tests correctly and looks good. But Valentin should take a look and approve.

[clementval]

LGTM

flang/include/flang/Optimizer/Builder/HLFIRTools.h

 /// Compute the lower and upper bounds of an entity.
 llvm::SmallVector<std::pair<mlir::Value, mlir::Value>>
 genBounds(mlir::Location loc, fir::FirOpBuilder &builder, Entity entity);
 
 /// Compute fir.shape<> (no lower bounds) for an entity.
 mlir::Value genShape(mlir::Location loc, fir::FirOpBuilder &builder,
                      Entity entity);
 
+/// Generate a vector of extents with index type from a fir.shape
+/// of fir.shape_shift value.
+llvm::SmallVector<mlir::Value> getIndexExtents(mlir::Location loc,
+                                               fir::FirOpBuilder &builder,
+                                               mlir::Value shape);
+
 /// Read length parameters into result if this entity has any.
 void genLengthParameters(mlir::Location loc, fir::FirOpBuilder &builder,
                          Entity entity,
                          llvm::SmallVectorImpl<mlir::Value> &result);
 
 /// Return the fir base, shape, and type parameters for a variable. Note that
 /// type parameters are only added if the entity is not a box and the type
 /// parameters is not a constant in the base type. This matches the arguments
hlfir::ElementalOp genElementalOp(mlir::Location loc,
                                   mlir::ValueRange typeParams,
                                   const ElementalKernelGenerator &genKernel);
 
 /// Generate a fir.do_loop nest looping from 1 to extents[i].
 /// Return the inner fir.do_loop and the indices of the loops.
 std::pair<fir::DoLoopOp, llvm::SmallVector<mlir::Value>>
 genLoopNest(mlir::Location loc, fir::FirOpBuilder &builder,
             mlir::ValueRange extents);
+inline std::pair<fir::DoLoopOp, llvm::SmallVector<mlir::Value>>
+genLoopNest(mlir::Location loc, fir::FirOpBuilder &builder, mlir::Value shape) {
+  return genLoopNest(loc, builder, getIndexExtents(loc, builder, shape));
+}
 
 /// Inline the body of an hlfir.elemental at the current insertion point
 /// given a list of one based indices. This generates the computation
 /// of one element of the elemental expression. Return the YieldElementOp
 /// whose value argument is the element value.
 /// The original hlfir::ElementalOp is left untouched.
 hlfir::YieldElementOp inlineElementalOp(mlir::Location loc,
                                         fir::FirOpBuilder &builder,
                                         hlfir::ElementalOp elemental,
                                         mlir::ValueRange oneBasedIndices);
 
 } // namespace hlfir
 
 #endif // FORTRAN_OPTIMIZER_BUILDER_HLFIRTOOLS_H

flang/lib/Lower/CallInterface.cpp

if (!characteristics)
     return false;
   return characteristics->IsOptional();
 }
 template <typename T>
 bool Fortran::lower::CallInterface<T>::PassedEntity::mayBeModifiedByCall()
     const {
   if (!characteristics)
     return true;
-  return characteristics->GetIntent() != Fortran::common::Intent::In;
+  if (characteristics->GetIntent() == Fortran::common::Intent::In)
+    return false;
+  const auto *dummy =
+      std::get_if<Fortran::evaluate::characteristics::DummyDataObject>(
+          &characteristics->u);
+  return !dummy ||
+         !dummy->attrs.test(
+             Fortran::evaluate::characteristics::DummyDataObject::Attr::Value);
 }
 template <typename T>
 bool Fortran::lower::CallInterface<T>::PassedEntity::mayBeReadByCall() const {
   if (!characteristics)
     return true;
   return characteristics->GetIntent() != Fortran::common::Intent::Out;
 }
 template <typename T>

flang/lib/Lower/ConvertCall.cpp

if (const Fortran::semantics::Symbol *symbol = procRef.proc().GetSymbol())
     if (const auto *details =
             symbol->detailsIf<Fortran::semantics::SubprogramDetails>())
       return details->stmtFunction().has_value();
   return false;
 }
 
 namespace {
 class CallBuilder {
+private:
+  struct PreparedActualArgument {
+    hlfir::Entity actual;
+    bool handleDynamicOptional;
+  };
+  using PreparedActualArguments =
+      llvm::SmallVector<llvm::Optional<PreparedActualArgument>>;
+  using PassBy = Fortran::lower::CallerInterface::PassEntityBy;
+
 public:
   CallBuilder(mlir::Location loc, Fortran::lower::AbstractConverter &converter,
               Fortran::lower::SymMap &symMap,
               Fortran::lower::StatementContext &stmtCtx)
       : converter{converter}, symMap{symMap}, stmtCtx{stmtCtx}, loc{loc} {}
 
   llvm::Optional<hlfir::EntityWithAttributes>
   gen(const Fortran::evaluate::ProcedureRef &procRef,
       llvm::Optional<mlir::Type> resultType) {
     mlir::Location loc = getLoc();
-    fir::FirOpBuilder &builder = getBuilder();
+    if (auto *specific = procRef.proc().GetSpecificIntrinsic()) {
       if (isElementalProcWithArrayArgs(procRef))
-      TODO(loc, "lowering elemental call to HLFIR");
-    if (auto *specific = procRef.proc().GetSpecificIntrinsic())
+        TODO(loc, "lowering elemental intrinsic call to HLFIR");
       return genIntrinsicRef(procRef, resultType, *specific);
+    }
     if (isStatementFunctionCall(procRef))
       TODO(loc, "lowering Statement function call to HLFIR");
 
     Fortran::lower::CallerInterface caller(procRef, converter);
-    using PassBy = Fortran::lower::CallerInterface::PassEntityBy;
     mlir::FunctionType callSiteType = caller.genFunctionType();
 
-    llvm::SmallVector<llvm::Optional<hlfir::EntityWithAttributes>>
-        loweredActuals;
+    PreparedActualArguments loweredActuals;
     // Lower the actual arguments
     for (const Fortran::lower::CallInterface<
              Fortran::lower::CallerInterface>::PassedEntity &arg :
          caller.getPassedArguments())
       if (const auto *actual = arg.entity) {
         const auto *expr = actual->UnwrapExpr();
         if (!expr)
           TODO(loc, "assumed type actual argument");
-        loweredActuals.emplace_back(Fortran::lower::convertExprToHLFIR(
-            loc, getConverter(), *expr, getSymMap(), getStmtCtx()));
+
+        const bool handleDynamicOptional =
+            arg.isOptional() && Fortran::evaluate::MayBePassedAsAbsentOptional(
+                                    *expr, getConverter().getFoldingContext());
+        auto loweredActual = Fortran::lower::convertExprToHLFIR(
+            loc, getConverter(), *expr, getSymMap(), getStmtCtx());
+        loweredActuals.emplace_back(
+            PreparedActualArgument{loweredActual, handleDynamicOptional});
       } else {
         // Optional dummy argument for which there is no actual argument.
         loweredActuals.emplace_back(std::nullopt);
       }
+    if (isElementalProcWithArrayArgs(procRef)) {
+      bool isImpure = false;
+      if (const Fortran::semantics::Symbol *procSym =
+              procRef.proc().GetSymbol())
+        isImpure = !Fortran::semantics::IsPureProcedure(*procSym);
+      return genElementalUserCall(loweredActuals, caller, resultType,
+                                  callSiteType, isImpure);
+    }
+    return genUserCall(loweredActuals, caller, resultType, callSiteType);
+  }
 
+private:
+  llvm::Optional<hlfir::EntityWithAttributes>
+  genUserCall(PreparedActualArguments &loweredActuals,
+              Fortran::lower::CallerInterface &caller,
+              llvm::Optional<mlir::Type> resultType,
+              mlir::FunctionType callSiteType) {
+    mlir::Location loc = getLoc();
+    fir::FirOpBuilder &builder = getBuilder();
     llvm::SmallVector<hlfir::AssociateOp> exprAssociations;
-    for (auto [actual, arg] :
+    for (auto [preparedActual, arg] :
          llvm::zip(loweredActuals, caller.getPassedArguments())) {
       mlir::Type argTy = callSiteType.getInput(arg.firArgument);
-      if (!actual) {
+      if (!preparedActual) {
         // Optional dummy argument for which there is no actual argument.
         caller.placeInput(arg, builder.create<fir::AbsentOp>(loc, argTy));
         continue;
       }
-
+      hlfir::Entity actual = preparedActual->actual;
       const auto *expr = arg.entity->UnwrapExpr();
       if (!expr)
         TODO(loc, "assumed type actual argument");
 
-      const bool actualMayBeDynamicallyAbsent =
-          arg.isOptional() && Fortran::evaluate::MayBePassedAsAbsentOptional(
-                                  *expr, getConverter().getFoldingContext());
-      if (actualMayBeDynamicallyAbsent)
+      if (preparedActual->handleDynamicOptional)
         TODO(loc, "passing optional arguments in HLFIR");
 
       const bool isSimplyContiguous =
-          actual->isScalar() || Fortran::evaluate::IsSimplyContiguous(
-                                    *expr, getConverter().getFoldingContext());
+          actual.isScalar() || Fortran::evaluate::IsSimplyContiguous(
 
       switch (arg.passBy) {
       case PassBy::Value: {
         // True pass-by-value semantics.
-        auto value = hlfir::loadTrivialScalar(loc, builder, *actual);
+        auto value = hlfir::loadTrivialScalar(loc, builder, actual);
         if (!value.isValue())
           TODO(loc, "Passing CPTR an CFUNCTPTR VALUE in HLFIR");
         caller.placeInput(arg, builder.createConvert(loc, argTy, value));
       } break;
       case PassBy::BaseAddressValueAttribute: {
         // VALUE attribute or pass-by-reference to a copy semantics. (byval*)
         TODO(loc, "HLFIR PassBy::BaseAddressValueAttribute");
       } break;
       case PassBy::BaseAddress:
       case PassBy::BoxChar: {
-        hlfir::Entity entity = *actual;
+        hlfir::Entity entity = actual;
         if (entity.isVariable()) {
           entity = hlfir::derefPointersAndAllocatables(loc, builder, entity);
           // Copy-in non contiguous variable
           if (!isSimplyContiguous)
             TODO(loc, "HLFIR copy-in/copy-out");
         } else {
           hlfir::AssociateOp associate = hlfir::genAssociateExpr(
               loc, builder, entity, argTy, "adapt.valuebyref");
fir::ExtendedValue result = Fortran::lower::genCallOpAndResult(
         loc, getConverter(), getSymMap(), getStmtCtx(), caller, callSiteType,
         resultType);
 
     /// Clean-up associations and copy-in.
     for (auto associate : exprAssociations)
       builder.create<hlfir::EndAssociateOp>(loc, associate);
     if (!fir::getBase(result))
       return std::nullopt; // subroutine call.
-    return extendedValueToHlfirEntity(result, ".tmp.func_result");
     // TODO: "move" non pointer results into hlfir.expr.
+    return extendedValueToHlfirEntity(result, ".tmp.func_result");
+  }
+
+  llvm::Optional<hlfir::EntityWithAttributes>
+  genElementalUserCall(PreparedActualArguments &loweredActuals,
+                       Fortran::lower::CallerInterface &caller,
+                       llvm::Optional<mlir::Type> resultType,
+                       mlir::FunctionType callSiteType, bool isImpure) {
+    mlir::Location loc = getLoc();
+    fir::FirOpBuilder &builder = getBuilder();
+    assert(loweredActuals.size() == caller.getPassedArguments().size());
+    unsigned numArgs = loweredActuals.size();
+    // Step 1: dereference pointers/allocatables and compute elemental shape.
+    mlir::Value shape;
+    // 10.1.4 p5. Impure elemental procedures must be called in element order.
+    bool mustBeOrdered = isImpure;
+    for (unsigned i = 0; i < numArgs; ++i) {
+      const auto &arg = caller.getPassedArguments()[i];
+      auto &preparedActual = loweredActuals[i];
+      if (preparedActual) {
+        hlfir::Entity &actual = preparedActual->actual;
+        // 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);
+        // Better to load scalars outside of the loop when possible.
+        if (!preparedActual->handleDynamicOptional &&
+            (arg.passBy == PassBy::Value ||
+             arg.passBy == PassBy::BaseAddressValueAttribute))
+          actual = hlfir::loadTrivialScalar(loc, builder, actual);
+        // TODO: merge shape instead of using the first one.
+        if (!shape && actual.isArray()) {
+          if (preparedActual->handleDynamicOptional)
+            TODO(loc, "deal with optional with shapes in HLFIR elemental call");
+          shape = hlfir::genShape(loc, builder, actual);
+        }
+        // 15.8.3 p1. Elemental procedure with intent(out)/intent(inout)
+        // arguments must be called in element order.
+        if (arg.mayBeModifiedByCall())
+          mustBeOrdered = true;
+      }
+    }
+    assert(shape &&
+           "elemental array calls must have at least one array arguments");
+    if (mustBeOrdered)
+      TODO(loc, "ordered elemental calls in HLFIR");
+    if (!resultType) {
+      // Subroutine case. Generate call inside loop nest.
+      auto [innerLoop, oneBasedIndices] =
+          hlfir::genLoopNest(loc, builder, shape);
+      auto insPt = builder.saveInsertionPoint();
+      builder.setInsertionPointToStart(innerLoop.getBody());
+      for (auto &preparedActual : loweredActuals)
+        if (preparedActual)
+          preparedActual->actual = hlfir::getElementAt(
+              loc, builder, preparedActual->actual, oneBasedIndices);
+      genUserCall(loweredActuals, caller, resultType, callSiteType);
+      builder.restoreInsertionPoint(insPt);
+      return std::nullopt;
+    }
+    // Function case: generate call inside hlfir.elemental
+    mlir::Type elementType = hlfir::getFortranElementType(*resultType);
+    // Get result length parameters.
+    llvm::SmallVector<mlir::Value> typeParams;
+    if (elementType.isa<fir::CharacterType>() ||
+        fir::isRecordWithTypeParameters(elementType))
+      TODO(loc, "compute elemental function result length parameters in HLFIR");
+    auto genKernel = [&](mlir::Location l, fir::FirOpBuilder &b,
+                         mlir::ValueRange oneBasedIndices) -> hlfir::Entity {
+      for (auto &preparedActual : loweredActuals)
+        if (preparedActual)
+          preparedActual->actual = hlfir::getElementAt(
+              l, b, preparedActual->actual, oneBasedIndices);
+      return *genUserCall(loweredActuals, caller, resultType, callSiteType);
+    };
+    // TODO: deal with hlfir.elemental result destruction.
+    return hlfir::EntityWithAttributes{hlfir::genElementalOp(
+        loc, builder, elementType, shape, typeParams, genKernel)};
   }
 
-private:
   hlfir::EntityWithAttributes
   genIntrinsicRef(const Fortran::evaluate::ProcedureRef &procRef,
                   llvm::Optional<mlir::Type> resultType,
                   const Fortran::evaluate::SpecificIntrinsic &intrinsic) {
     mlir::Location loc = getLoc();
     if (Fortran::lower::intrinsicRequiresCustomOptionalHandling(
             procRef, intrinsic, converter))
       TODO(loc, "special cases of intrinsic with optional arguments");

flang/lib/Optimizer/Builder/HLFIRTools.cpp

if (typeExtent != fir::SequenceType::getUnknownExtent()) {
           builder.createIntegerConstant(loc, idxTy, extents.size());
       auto dimInfo =
           builder.create<fir::BoxDimsOp>(loc, idxTy, idxTy, idxTy, entity, dim);
       extents.push_back(dimInfo.getExtent());
     }
   return builder.create<fir::ShapeOp>(loc, extents);
 }
 
+llvm::SmallVector<mlir::Value>
+hlfir::getIndexExtents(mlir::Location loc, fir::FirOpBuilder &builder,
+                       mlir::Value shape) {
+  llvm::SmallVector<mlir::Value> extents;
+  if (auto s = shape.getDefiningOp<fir::ShapeOp>()) {
+    auto e = s.getExtents();
+    extents.insert(extents.end(), e.begin(), e.end());
+  } else if (auto s = shape.getDefiningOp<fir::ShapeShiftOp>()) {
+    auto e = s.getExtents();
+    extents.insert(extents.end(), e.begin(), e.end());
+  } else {
+    // TODO: add fir.get_extent ops on fir.shape<> ops.
+    TODO(loc, "get extents from fir.shape without fir::ShapeOp parent op");
+  }
+  mlir::Type indexType = builder.getIndexType();
+  for (auto &extent : extents)
+    extent = builder.createConvert(loc, indexType, extent);
+  return extents;
+}
+
 void hlfir::genLengthParameters(mlir::Location loc, fir::FirOpBuilder &builder,
                                 Entity entity,
                                 llvm::SmallVectorImpl<mlir::Value> &result) {
   if (!entity.hasLengthParameters())
     return;
   if (entity.getType().isa<hlfir::ExprType>()) {
     mlir::Value expr = entity;
     if (auto reassoc = expr.getDefiningOp<hlfir::NoReassocOp>())

flang/lib/Optimizer/HLFIR/Transforms/BufferizeHLFIR.cpp

static mlir::Value getBufferizedExprMustFreeFlag(mlir::Value bufferizedExpr) {
   assert(tupleType.size() == 2 && "unexpected tuple type");
   if (auto insert = bufferizedExpr.getDefiningOp<fir::InsertValueOp>())
     if (auto insert0 = insert.getAdt().getDefiningOp<fir::InsertValueOp>())
       if (insert0.getVal().getType() == tupleType.getType(1))
         return insert0.getVal();
   TODO(bufferizedExpr.getLoc(), "general extract storage case");
 }
 
-static llvm::SmallVector<mlir::Value>
-getIndexExtents(mlir::Location loc, fir::FirOpBuilder &builder,
-                mlir::Value shape) {
-  llvm::SmallVector<mlir::Value> extents;
-  if (auto s = shape.getDefiningOp<fir::ShapeOp>()) {
-    auto e = s.getExtents();
-    extents.insert(extents.end(), e.begin(), e.end());
-  } else if (auto s = shape.getDefiningOp<fir::ShapeShiftOp>()) {
-    auto e = s.getExtents();
-    extents.insert(extents.end(), e.begin(), e.end());
-  } else {
-    // TODO: add fir.get_extent ops on fir.shape<> ops.
-    TODO(loc, "get extents from fir.shape without fir::ShapeOp parent op");
-  }
-  mlir::Type indexType = builder.getIndexType();
-  for (auto &extent : extents)
-    extent = builder.createConvert(loc, indexType, extent);
-  return extents;
-}
-
 static std::pair<hlfir::Entity, mlir::Value>
 createTempFromMold(mlir::Location loc, fir::FirOpBuilder &builder,
                    hlfir::Entity mold) {
   llvm::SmallVector<mlir::Value> lenParams;
   hlfir::genLengthParameters(loc, builder, mold, lenParams);
   llvm::StringRef tmpName{".tmp"};
   mlir::Value alloc;
   mlir::Value isHeapAlloc;
   mlir::Value shape{};
   if (mold.isArray()) {
     mlir::Type sequenceType =
         hlfir::getFortranElementOrSequenceType(mold.getType());
     shape = hlfir::genShape(loc, builder, mold);
-    auto extents = getIndexExtents(loc, builder, shape);
+    auto extents = hlfir::getIndexExtents(loc, builder, shape);
     alloc = builder.createHeapTemporary(loc, sequenceType, tmpName, extents,
                                         lenParams);
     isHeapAlloc = builder.createBool(loc, true);
   } else {
     alloc = builder.createTemporary(loc, mold.getFortranElementType(), tmpName,
                                     /*shape*/ std::nullopt, lenParams);
     isHeapAlloc = builder.createBool(loc, false);
   }
matchAndRewrite(hlfir::ElementalOp elemental, OpAdaptor adaptor,
     auto module = elemental->getParentOfType<mlir::ModuleOp>();
     fir::FirOpBuilder builder(rewriter, fir::getKindMapping(module));
     // The body of the elemental op may contain operation that will require
     // to be translated. Notify the rewriter about the cloned operations.
     HLFIRListener listener{builder, rewriter};
     builder.setListener(&listener);
 
     mlir::Value shape = adaptor.getShape();
-    auto extents = getIndexExtents(loc, builder, shape);
+    auto extents = hlfir::getIndexExtents(loc, builder, shape);
     auto [temp, cleanup] =
         createArrayTemp(loc, builder, elemental.getType(), shape, extents,
                         adaptor.getTypeparams());
     // Generate a loop nest looping around the fir.elemental shape and clone
     // fir.elemental region inside the inner loop.
     auto [innerLoop, oneBasedLoopIndices] =
         hlfir::genLoopNest(loc, builder, extents);
     auto insPt = builder.saveInsertionPoint();

flang/test/Lower/HLFIR/elemental-user-procedure-ref.f90

+! Test lowering of user defined elemental procedure reference to HLFIR
+! RUN: bbc -emit-fir -hlfir -o - %s 2>&1 | FileCheck %s
+
+subroutine by_addr(x, y)
+  integer :: x
+  real :: y(100)
+  interface
+    real elemental function elem(a, b)
+      integer, intent(in) :: a
+      real, intent(in) :: b
+    end function
+  end interface
+  call baz(elem(x, y))
+end subroutine
+! CHECK-LABEL: func.func @_QPby_addr(
+! CHECK:  %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0:.*]] {{.*}}x
+! CHECK:  %[[VAL_5:.*]]:2 = hlfir.declare %[[VAL_1:.*]](%[[VAL_4:[^)]*]]) {{.*}}y
+! CHECK:  %[[VAL_6:.*]] = hlfir.elemental %[[VAL_4]] : (!fir.shape<1>) -> !hlfir.expr<100xf32> {
+! CHECK:  ^bb0(%[[VAL_7:.*]]: index):
+! CHECK:    %[[VAL_8:.*]] = hlfir.designate %[[VAL_5]]#0 (%[[VAL_7]])  : (!fir.ref<!fir.array<100xf32>>, index) -> !fir.ref<f32>
+! CHECK:    %[[VAL_9:.*]] = fir.call @_QPelem(%[[VAL_2]]#1, %[[VAL_8]]) fastmath<contract> : (!fir.ref<i32>, !fir.ref<f32>) -> f32
+! CHECK:    hlfir.yield_element %[[VAL_9]] : f32
+! CHECK:  }
+
+subroutine by_value(x, y)
+  integer :: x
+  real :: y(10, 20)
+  interface
+    real elemental function elem_val(a, b)
+      integer, value :: a
+      real, value :: b
+    end function
+  end interface
+  call baz(elem_val(x, y))
+end subroutine
+! CHECK-LABEL: func.func @_QPby_value(
+! CHECK:  %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0:.*]] {{.*}}x
+! CHECK:  %[[VAL_6:.*]]:2 = hlfir.declare %[[VAL_1:.*]](%[[VAL_5:[^)]*]]) {{.*}}y
+! CHECK:  %[[VAL_7:.*]] = fir.load %[[VAL_2]]#0 : !fir.ref<i32>
+! CHECK:  %[[VAL_8:.*]] = hlfir.elemental %[[VAL_5]] : (!fir.shape<2>) -> !hlfir.expr<10x20xf32> {
+! CHECK:  ^bb0(%[[VAL_9:.*]]: index, %[[VAL_10:.*]]: index):
+! CHECK:    %[[VAL_11:.*]] = hlfir.designate %[[VAL_6]]#0 (%[[VAL_9]], %[[VAL_10]])  : (!fir.ref<!fir.array<10x20xf32>>, index, index) -> !fir.ref<f32>
+! CHECK:    %[[VAL_12:.*]] = fir.load %[[VAL_11]] : !fir.ref<f32>
+! CHECK:    %[[VAL_13:.*]] = fir.call @_QPelem_val(%[[VAL_7]], %[[VAL_12]]) fastmath<contract> : (i32, f32) -> f32
+! CHECK:    hlfir.yield_element %[[VAL_13]] : f32
+! CHECK:  }
+
+subroutine by_boxaddr(x, y)
+  character(*) :: x
+  character(*) :: y(100)
+  interface
+    real elemental function char_elem(a, b)
+      character(*), intent(in) :: a
+      character(*), intent(in) :: b
+    end function
+  end interface
+  call baz2(char_elem(x, y))
+end subroutine
+! CHECK-LABEL: func.func @_QPby_boxaddr(
+! CHECK:  %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_2:.*]]#0 typeparams %[[VAL_2]]#1 {{.*}}x
+! CHECK:  %[[VAL_6:.*]] = arith.constant 100 : index
+! CHECK:  %[[VAL_8:.*]]:2 = hlfir.declare %[[VAL_5:.*]](%[[VAL_7:.*]]) typeparams %[[VAL_4:.*]]#1 {{.*}}y
+! CHECK:  %[[VAL_9:.*]] = hlfir.elemental %[[VAL_7]] : (!fir.shape<1>) -> !hlfir.expr<100xf32> {
+! CHECK:  ^bb0(%[[VAL_10:.*]]: index):
+! CHECK:    %[[VAL_11:.*]] = hlfir.designate %[[VAL_8]]#0 (%[[VAL_10]])  typeparams %[[VAL_4]]#1 : (!fir.box<!fir.array<100x!fir.char<1,?>>>, index, index) -> !fir.boxchar<1>
+! CHECK:    %[[VAL_12:.*]] = fir.call @_QPchar_elem(%[[VAL_3]]#0, %[[VAL_11]]) fastmath<contract> : (!fir.boxchar<1>, !fir.boxchar<1>) -> f32
+! CHECK:    hlfir.yield_element %[[VAL_12]] : f32
+! CHECK:  }
+
+subroutine sub(x, y)
+  integer :: x
+  real :: y(10, 20)
+  interface
+    elemental subroutine elem_sub(a, b)
+      integer, intent(in) :: a
+      real, intent(in) :: b
+    end subroutine
+  end interface
+  call elem_sub(x, y)
+end subroutine
+! CHECK-LABEL: func.func @_QPsub(
+! CHECK:  %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0:.*]] {{.*}}x
+! CHECK:  %[[VAL_3:.*]] = arith.constant 10 : index
+! CHECK:  %[[VAL_4:.*]] = arith.constant 20 : index
+! CHECK:  %[[VAL_6:.*]]:2 = hlfir.declare %[[VAL_1:.*]](%[[VAL_5:[^)]*]]) {{.*}}y
+! CHECK:  %[[VAL_7:.*]] = arith.constant 1 : index
+! CHECK:  fir.do_loop %[[VAL_8:.*]] = %[[VAL_7]] to %[[VAL_4]] step %[[VAL_7]] {
+! CHECK:    fir.do_loop %[[VAL_9:.*]] = %[[VAL_7]] to %[[VAL_3]] step %[[VAL_7]] {
+! CHECK:      %[[VAL_10:.*]] = hlfir.designate %[[VAL_6]]#0 (%[[VAL_9]], %[[VAL_8]])  : (!fir.ref<!fir.array<10x20xf32>>, index, index) -> !fir.ref<f32>
+! CHECK:      fir.call @_QPelem_sub(%[[VAL_2]]#1, %[[VAL_10]]) fastmath<contract> : (!fir.ref<i32>, !fir.ref<f32>) -> ()
+! CHECK:    }
+! CHECK:  }