[flang][hlfir] Lower post f77 user calls

[jeanPerier]

Summary

In lowering to HLFIR, deal with user calls involving a mix of:

• dummy with VALUE
• Polymorphism
• contiguous dummy
• assumed shape dummy
• OPTIONAL arguments
• NULL() passed to OPTIONAL arguments.
• elemental calls

Does not deal with assumed ranked dummy arguments.

This patch unifies the preparation of all arguments that must be passed
in memory and are not passed as allocatable/pointers.

For optionals, the same argument preparation is done, except the utility
that generates the IR for the argument preparation is called inside a
fir.if.

The addressing of array arguments in elemental calls is delayed so that
it can also happen during this argument preparation, and be placed in
the fir.if when the array may be absent.

Structure helpers are added to convey a prepared dummy argument and the
data that may be needed to do the clean-up after the call (temporary
storage deallocation or copy-out). And a utility is added to wrap
the preparation code inside a fir.if and convey these values through
the fir.if.

Certain aspects of this patch brings the HLFIR lowering support beyond
what the current lowering to FIR supports (e.g. handling of NULL(), handling
of optional in elemental calls, handling of copy-in/copy-out involving
polymorphic entities).

[clementval]

Looks great. Couple of typos.

flang/lib/Lower/ConvertCall.cpp

611

631

Maybe?

743

744

[jeanPerier]

Fix typos (thanks for the review) and rebase.

[PeteSteinfeld]

Aside from the nits on the comments, all builds and tests correctly and looks good.

flang/lib/Lower/ConvertCall.cpp

630

"conditionnaly" should be "conditionally"

635

Should this be "%conditionallyPrepared"?

691

Should read "%conditionallyPrepared".

828

Should read "descriptors may not ..."

1150

I think that this should say "array operands".

[jeanPerier]

Fix more typos in comments caught by Pete and rebase.

flang/include/flang/Lower/CallInterface.h

struct FirPlaceHolder {
     Property property;
     /// MLIR attributes for this argument
     llvm::SmallVector<mlir::NamedAttribute> attributes;
   };
 
   /// PassedEntity is what is provided back to the CallInterface user.
   /// It describe how the entity is plugged in the interface
   struct PassedEntity {
-    /// Is the dummy argument optional ?
+    /// Is the dummy argument optional?
     bool isOptional() const;
-    /// Can the argument be modified by the callee ?
+    /// Can the argument be modified by the callee?
     bool mayBeModifiedByCall() const;
-    /// Can the argument be read by the callee ?
+    /// Can the argument be read by the callee?
     bool mayBeReadByCall() const;
     /// Is the argument INTENT(OUT)
     bool isIntentOut() const;
-    /// Does the argument have the CONTIGUOUS attribute or have explicit shape ?
+    /// Does the argument have the CONTIGUOUS attribute or have explicit shape?
     bool mustBeMadeContiguous() const;
+    /// Does the dummy argument have the VALUE attribute?
+    bool hasValueAttribute() const;
     /// How entity is passed by.
     PassEntityBy passBy;
     /// What is the entity (SymbolRef for callee/ActualArgument* for caller)
     /// What is the related mlir::func::FuncOp argument(s) (mlir::Value for
     /// callee / index for the caller).
     FortranEntity entity;
     FirValue firArgument;
     FirValue firLength; /* only for AddressAndLength */

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

mlir::Value genVariableRawAddress(mlir::Location loc,
                                   fir::FirOpBuilder &builder,
                                   hlfir::Entity var);
 
 /// Get a fir.boxchar for character scalar or array variable (the shape is lost
 /// for arrays).
 mlir::Value genVariableBoxChar(mlir::Location loc, fir::FirOpBuilder &builder,
                                hlfir::Entity var);
 
+/// Get or create a fir.box or fir.class from a variable.
+hlfir::Entity genVariableBox(mlir::Location loc, fir::FirOpBuilder &builder,
+                             hlfir::Entity var);
+
 /// If the entity is a variable, load its value (dereference pointers and
 /// allocatables if needed). Do nothing if the entity is already a value, and
 /// only dereference pointers and allocatables if it is not a scalar entity
 /// of numerical or logical type.
 Entity loadTrivialScalar(mlir::Location loc, fir::FirOpBuilder &builder,
                          Entity entity);
 
 /// If \p entity is a POINTER or ALLOCATABLE, dereference it and return the

flang/lib/Lower/CallInterface.cpp

 }
 template <typename T>
 bool Fortran::lower::CallInterface<T>::PassedEntity::mayBeModifiedByCall()
     const {
   if (!characteristics)
     return true;
   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);
+  return !hasValueAttribute();
 }
 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>
return dummy->attrs.test(
         Fortran::evaluate::characteristics::DummyDataObject::Attr::Contiguous);
   if (shapeAttrs.test(ShapeAttrs::DeferredShape))
     return false;
   // Explicit shape arrays are contiguous.
   return dummy->type.Rank() > 0;
 }
 
 template <typename T>
+bool Fortran::lower::CallInterface<T>::PassedEntity::hasValueAttribute() const {
+  if (!characteristics)
+    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>
 void Fortran::lower::CallInterface<T>::determineInterface(
     bool isImplicit,
     const Fortran::evaluate::characteristics::Procedure &procedure) {
   CallInterfaceImpl<T> impl(*this);
   if (isImplicit)
     impl.buildImplicitInterface(procedure);
   else
     impl.buildExplicitInterface(procedure);

flang/lib/Lower/ConvertCall.cpp

struct CallContext {
   std::optional<mlir::Type> resultType;
   mlir::Location loc;
 };
 
 /// This structure holds the initial lowered value of an actual argument that
 /// was lowered regardless of the interface, and it holds whether or not it
 /// may be absent at runtime and the dummy is optional.
 struct PreparedActualArgument {
+
+  PreparedActualArgument(hlfir::Entity actual,
+                         std::optional<mlir::Value> isPresent)
+      : actual{actual}, isPresent{isPresent} {}
+  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;
+  }
+  hlfir::Entity getOriginalActual() const { return actual; }
+  void setOriginalActual(hlfir::Entity newActual) { actual = newActual; }
+  bool handleDynamicOptional() const { return isPresent.has_value(); }
+  mlir::Value getIsPresent() const {
+    assert(handleDynamicOptional() && "not a dynamic optional");
+    return *isPresent;
+  }
+
+  void resetOptionalAspect() { isPresent = std::nullopt; }
+
+private:
   hlfir::Entity actual;
-  bool handleDynamicOptional;
+  mlir::ValueRange *oneBasedElementalIndices{nullptr};
+  // When the actual may be dynamically optional, "isPresent"
+  // holds a boolean value indicating the presence of the
+  // actual argument at runtime.
+  std::optional<mlir::Value> isPresent;
 };
 } // namespace
 
 /// Vector of pre-lowered actual arguments. nullopt if the actual is
 /// "statically" absent (if it was not syntactically  provided).
 using PreparedActualArguments =
     llvm::SmallVector<std::optional<PreparedActualArgument>>;
 
 // Helper to transform a fir::ExtendedValue to an hlfir::EntityWithAttributes.
 static hlfir::EntityWithAttributes
 extendedValueToHlfirEntity(mlir::Location loc, fir::FirOpBuilder &builder,
                            const fir::ExtendedValue &exv,
                            llvm::StringRef name) {
   mlir::Value firBase = fir::getBase(exv);
   if (fir::isa_trivial(firBase.getType()))
     return hlfir::EntityWithAttributes{firBase};
   return hlfir::genDeclare(loc, builder, exv, name,
                            fir::FortranVariableFlagsAttr{});
 }
+namespace {
+/// Structure to hold the clean-up related to a dummy argument preparation
+/// that may have to be done after a call (copy-out or temporary deallocation).
+struct CallCleanUp {
+  struct CopyIn {
+    void genCleanUp(mlir::Location loc, fir::FirOpBuilder &builder) {
+      builder.create<hlfir::CopyOutOp>(loc, copiedIn, wasCopied, copyBackVar);
+    }
+    mlir::Value copiedIn;
+    mlir::Value wasCopied;
+    // copyBackVar may be null if copy back is not needed.
+    mlir::Value copyBackVar;
+  };
+  struct ExprAssociate {
+    void genCleanUp(mlir::Location loc, fir::FirOpBuilder &builder) {
+      builder.create<hlfir::EndAssociateOp>(loc, tempVar, mustFree);
+    }
+    mlir::Value tempVar;
+    mlir::Value mustFree;
+  };
+  void genCleanUp(mlir::Location loc, fir::FirOpBuilder &builder) {
+    std::visit([&](auto &c) { c.genCleanUp(loc, builder); }, cleanUp);
+  }
+  std::variant<CopyIn, ExprAssociate> cleanUp;
+};
+
+/// Structure representing a prepared dummy arguments.
+/// It holds the value to be passed in the call and any related
+/// clean-ups to be done after the call.
+struct PreparedDummyArgument {
+  void setCopyInCleanUp(mlir::Value copiedIn, mlir::Value wasCopied,
+                        mlir::Value copyBackVar) {
+    assert(!maybeCleanUp.has_value() && "clean-up already set");
+    maybeCleanUp =
+        CallCleanUp{CallCleanUp::CopyIn{copiedIn, wasCopied, copyBackVar}};
+  }
+  void setExprAssociateCleanUp(mlir::Value tempVar, mlir::Value wasCopied) {
+    assert(!maybeCleanUp.has_value() && "clean-up already set");
+    maybeCleanUp = CallCleanUp{CallCleanUp::ExprAssociate{tempVar, wasCopied}};
+  }
+
+  mlir::Value dummy;
+  std::optional<CallCleanUp> maybeCleanUp;
+};
+
+/// Structure to help conditionnaly preparing a dummy argument based
+/// on the actual argument present.
+/// It helps "wrapping" the dummy and the clean-up information in
+/// an if (present) {...}:
+///
+///  %conditionnalyPrepared = fir.if (%present) {
+///    fir.result %preparedDummy
+///  } else {
+///    fir.result %absent
+///  }
+///
+struct ConditionallyPreparedDummy {
+  /// Create ConditionallyPreparedDummy from a preparedDummy that must
+  /// be wrapped in a fir.if.
+  ConditionallyPreparedDummy(PreparedDummyArgument &preparedDummy) {
+    thenResultValues.push_back(preparedDummy.dummy);
+    if (preparedDummy.maybeCleanUp) {
+      if (const auto *copyInCleanUp = std::get_if<CallCleanUp::CopyIn>(
+              &preparedDummy.maybeCleanUp->cleanUp)) {
+        thenResultValues.push_back(copyInCleanUp->copiedIn);
+        thenResultValues.push_back(copyInCleanUp->wasCopied);
+        if (copyInCleanUp->copyBackVar)
+          thenResultValues.push_back(copyInCleanUp->copyBackVar);
+      } else {
+        const auto &exprAssociate = std::get<CallCleanUp::ExprAssociate>(
+            preparedDummy.maybeCleanUp->cleanUp);
+        thenResultValues.push_back(exprAssociate.tempVar);
+        thenResultValues.push_back(exprAssociate.mustFree);
+      }
+    }
+  }
+
+  /// Get the result types of the wrapping fir.if that must be created.
+  llvm::SmallVector<mlir::Type> getIfResulTypes() const {
+    llvm::SmallVector<mlir::Type> types;
+    for (mlir::Value res : thenResultValues)
+      types.push_back(res.getType());
+    return types;
+  }
+
+  /// Generate the "fir.result %preparedDummy" in the then branch of the
+  /// wrapping fir.if.
+  void genThenResult(mlir::Location loc, fir::FirOpBuilder &builder) const {
+    builder.create<fir::ResultOp>(loc, thenResultValues);
+  }
+
+  /// Generate the "fir.result %absent" in the else branch of the
+  /// wrapping fir.if.
+  void genElseResult(mlir::Location loc, fir::FirOpBuilder &builder) const {
+    llvm::SmallVector<mlir::Value> elseResultValues;
+    mlir::Type i1Type = builder.getI1Type();
+    for (mlir::Value res : thenResultValues) {
+      mlir::Type type = res.getType();
+      if (type == i1Type)
+        elseResultValues.push_back(builder.createBool(loc, false));
+      else
+        elseResultValues.push_back(builder.create<fir::AbsentOp>(loc, type));
+    }
+    builder.create<fir::ResultOp>(loc, elseResultValues);
+  }
+
+  /// Once the fir.if has been created, get the resulting %conditionnalyPrepared
+  /// dummy argument.
+  PreparedDummyArgument
+  getPreparedDummy(fir::IfOp ifOp,
+                   const PreparedDummyArgument &unconditionalDummy) {
+    PreparedDummyArgument preparedDummy;
+    preparedDummy.dummy = ifOp.getResults()[0];
+    if (unconditionalDummy.maybeCleanUp) {
+      if (const auto *copyInCleanUp = std::get_if<CallCleanUp::CopyIn>(
+              &unconditionalDummy.maybeCleanUp->cleanUp)) {
+        mlir::Value copyBackVar;
+        if (copyInCleanUp->copyBackVar)
+          copyBackVar = ifOp.getResults().back();
+        preparedDummy.setCopyInCleanUp(ifOp.getResults()[1],
+                                       ifOp.getResults()[2], copyBackVar);
+      } else {
+        preparedDummy.setExprAssociateCleanUp(ifOp.getResults()[1],
+                                              ifOp.getResults()[2]);
+      }
+    }
+    return preparedDummy;
+  }
+
+  llvm::SmallVector<mlir::Value> thenResultValues;
+};
+} // namespace
+
+/// When dummy is not ALLOCATABLE, POINTER and is not passed in register,
+/// prepare the actual argument according to the interface. Do as needed:
+/// - address element if this is an array argument in an elemental call.
+/// - set dynamic type to the dummy type if the dummy is not polymorphic.
+/// - copy-in into contiguous variable if the dummy must be contiguous
+/// - copy into a temporary if the dummy has the VALUE attribute.
+/// - package the prepared dummy as required (fir.box, fir.class,
+///   fir.box_char...).
+/// This function should only be called with an actual that is present.
+/// The optional aspects must be handled by this function user.
+static PreparedDummyArgument preparePresentUserCallActualArgument(
+    mlir::Location loc, fir::FirOpBuilder &builder,
+    const PreparedActualArgument &preparedActual, mlir::Type dummyType,
+    const Fortran::lower::CallerInterface::PassedEntity &arg,
+    const Fortran::lower::SomeExpr &expr,
+    Fortran::evaluate::FoldingContext &foldingContext) {
+
+  // Step 1: get the actual argument, which includes addressing the
+  // element if this is an array in an elemental call.
+  hlfir::Entity actual = preparedActual.getActual(loc, builder);
+
+  const bool passingPolymorphicToNonPolymorphic =
+      actual.isPolymorphic() && !fir::isPolymorphicType(dummyType);
+
+  // When passing a CLASS(T) to TYPE(T), only the "T" part must be
+  // passed. Unless the entity will is a scalar passed by raw address, a
+  // new descriptor must be made to using the dummy argument type as
+  // dynamic type. This must be done before any copy/copy-in because the
+  // dynamic type matters to determine the contiguity.
+  const bool mustSetDynamicTypeToDummyType =
+      passingPolymorphicToNonPolymorphic &&
+      (actual.isArray() || dummyType.isa<fir::BaseBoxType>());
+
+  // The simple contiguity of the actual is "lost" when passing a polymorphic
+  // to a non polymorphic entity because the dummy dynamic type matters for
+  // the contiguity.
+  const bool mustDoCopyInOut =
+      actual.isArray() && arg.mustBeMadeContiguous() &&
+      (passingPolymorphicToNonPolymorphic ||
+       !Fortran::evaluate::IsSimplyContiguous(expr, foldingContext));
+
+  // Step 2: prepare the storage for the dummy arguments, ensuring that it
+  // matches the dummy requirements (e.g., must be contiguous or must be
+  // a temporary).
+  PreparedDummyArgument preparedDummy;
+  hlfir::Entity entity =
+      hlfir::derefPointersAndAllocatables(loc, builder, actual);
+  if (entity.isVariable()) {
+    if (mustSetDynamicTypeToDummyType) {
+      // Note: this is important to do this before any copy-in or copy so
+      // that the dummy is contiguous according to the dummy type.
+      mlir::Type boxType =
+          fir::BoxType::get(hlfir::getFortranElementOrSequenceType(dummyType));
+      entity = hlfir::Entity{builder.create<fir::ReboxOp>(
+          loc, boxType, entity, /*shape=*/mlir::Value{},
+          /*slice=*/mlir::Value{})};
+    }
+    if (arg.hasValueAttribute()) {
+      // Make a copy in a temporary.
+      auto copy = builder.create<hlfir::AsExprOp>(loc, entity);
+      hlfir::AssociateOp associate = hlfir::genAssociateExpr(
+          loc, builder, hlfir::Entity{copy}, dummyType, "adapt.valuebyref");
+      entity = hlfir::Entity{associate.getBase()};
+      // Register the temporary destruction after the call.
+      preparedDummy.setExprAssociateCleanUp(
+          associate.getFirBase(), associate.getMustFreeStrorageFlag());
+    } else if (mustDoCopyInOut) {
+      // Copy-in non contiguous variables.
+      assert(entity.getType().isa<fir::BaseBoxType>() &&
+             "expect non simply contiguous variables to be boxes");
+      auto copyIn = builder.create<hlfir::CopyInOp>(
+          loc, entity, /*var_is_present=*/mlir::Value{});
+      entity = hlfir::Entity{copyIn.getCopiedIn()};
+      // Register the copy-out after the call.
+      preparedDummy.setCopyInCleanUp(
+          copyIn.getCopiedIn(), copyIn.getWasCopied(),
+          arg.mayBeModifiedByCall() ? copyIn.getVar() : mlir::Value{});
+    }
+  } else {
+    // The actual is an expression value, place it into a temporary
+    // and register the temporary destruction after the call.
+    if (mustSetDynamicTypeToDummyType)
+      TODO(loc, "passing polymorphic array expression to non polymorphic "
+                "contiguous dummy");
+    hlfir::AssociateOp associate = hlfir::genAssociateExpr(
+        loc, builder, entity, dummyType, "adapt.valuebyref");
+    entity = hlfir::Entity{associate.getBase()};
+    preparedDummy.setExprAssociateCleanUp(associate.getFirBase(),
+                                          associate.getMustFreeStrorageFlag());
+  }
+
+  // Step 3: now that the dummy argument storage has been prepared, package
+  // it according to the interface.
+  mlir::Value addr;
+  if (dummyType.isa<fir::BoxCharType>()) {
+    addr = hlfir::genVariableBoxChar(loc, builder, entity);
+  } else if (dummyType.isa<fir::BaseBoxType>()) {
+    entity = hlfir::genVariableBox(loc, builder, entity);
+    // Ensures the box has the right attributes and that it holds an
+    // addendum if needed.
+    mlir::Type boxEleType =
+        entity.getType().cast<fir::BaseBoxType>().getEleTy();
+    // For now, assume it is not OK to pass the allocatable/pointer
+    // descriptor to a non pointer/allocatable dummy. That is a strict
+    // interpretation of 18.3.6 point 4 that stipulates the descriptor
+    // has the dummy attributes in BIND(C) contexts.
+    const bool actualBoxHasAllocatableOrPointerFlag =
+        fir::isa_ref_type(boxEleType);
+    // On the callee side, the current code generated for unlimited
+    // polymorphic might unconditionally read the addendum. Intrinsic type
+    // descriptor may not have an addendum, the rebox below will create a
+    // descriptor with an addendum in such case.
+    const bool actualBoxHasAddendum =
+        fir::unwrapRefType(boxEleType).isa<fir::RecordType, mlir::NoneType>();
+    const bool needToAddAddendum =
+        fir::isUnlimitedPolymorphicType(dummyType) && !actualBoxHasAddendum;
+    if (needToAddAddendum || actualBoxHasAllocatableOrPointerFlag)
+      entity = hlfir::Entity{builder.create<fir::ReboxOp>(
+          loc, dummyType, entity, /*shape=*/mlir::Value{},
+          /*slice=*/mlir::Value{})};
+    addr = entity;
+  } else {
+    addr = hlfir::genVariableRawAddress(loc, builder, entity);
+  }
+  preparedDummy.dummy = builder.createConvert(loc, dummyType, addr);
+  return preparedDummy;
+}
+
+/// When dummy is not ALLOCATABLE, POINTER and is not passed in register,
+/// prepare the actual argument according to the interface, taking care
+/// of any optional aspect.
+static PreparedDummyArgument prepareUserCallActualArgument(
+    mlir::Location loc, fir::FirOpBuilder &builder,
+    const PreparedActualArgument &preparedActual, mlir::Type dummyType,
+    const Fortran::lower::CallerInterface::PassedEntity &arg,
+    const Fortran::lower::SomeExpr &expr,
+    Fortran::evaluate::FoldingContext &foldingContext) {
+  if (!preparedActual.handleDynamicOptional())
+    return preparePresentUserCallActualArgument(
+        loc, builder, preparedActual, dummyType, arg, expr, foldingContext);
+
+  // Conditional dummy argument preparation. The actual may be absent
+  // at runtime, causing any addressing, copy, and packaging to have
+  // undefined behavior.
+  // To simplify the handling of this case, the "normal" dummy preparation
+  // helper is used, except its generated code is wrapped inside a
+  // fir.if(present).
+  mlir::Value isPresent = preparedActual.getIsPresent();
+  mlir::OpBuilder::InsertPoint insertPt = builder.saveInsertionPoint();
+
+  // Code generated in a preparation block that will become the
+  // "then" block in "if (present) then {} else {}". The reason
+  // for this unusual if/then/else generation is that the number
+  // and types of the if results will depend on how the argument
+  // is prepared, and forecasting that here would be brittle.
+  auto badIfOp = builder.create<fir::IfOp>(loc, dummyType, isPresent,
+                                           /*withElseRegion=*/false);
+  mlir::Block *preparationBlock = &badIfOp.getThenRegion().front();
+  builder.setInsertionPointToStart(preparationBlock);
+  PreparedDummyArgument unconditionalDummy =
+      preparePresentUserCallActualArgument(
+          loc, builder, preparedActual, dummyType, arg, expr, foldingContext);
+  builder.restoreInsertionPoint(insertPt);
+
+  // TODO: when forwarding an optional to an optional of the same kind
+  // (i.e, unconditionalDummy.dummy was not created in preparationBlock),
+  // the if/then/else generation could be skipped to improve the generated
+  // code.
+
+  // Now that the result types of the ifOp can be deduced, generate
+  // the "real" ifOp (operation result types cannot be changed, so
+  // badIfOp cannot be modified and used here).
+  llvm::SmallVector<mlir::Type> ifOpResultTypes;
+  ConditionallyPreparedDummy conditionalDummy(unconditionalDummy);
+  auto ifOp = builder.create<fir::IfOp>(loc, conditionalDummy.getIfResulTypes(),
+                                        isPresent,
+                                        /*withElseRegion=*/true);
+  // Move "preparationBlock" into the "then" of the new
+  // fir.if operation and create fir.result propagating
+  // unconditionalDummy.
+  preparationBlock->moveBefore(&ifOp.getThenRegion().back());
+  ifOp.getThenRegion().back().erase();
+  builder.setInsertionPointToEnd(&ifOp.getThenRegion().front());
+  conditionalDummy.genThenResult(loc, builder);
+
+  // Generate "else" branch with returning absent values.
+  builder.setInsertionPointToStart(&ifOp.getElseRegion().front());
+  conditionalDummy.genElseResult(loc, builder);
+
+  // Build dummy from IfOpResults.
+  builder.setInsertionPointAfter(ifOp);
+  PreparedDummyArgument result =
+      conditionalDummy.getPreparedDummy(ifOp, unconditionalDummy);
+  badIfOp->erase();
+  return result;
+}
 
 /// Lower calls to user procedures with actual arguments that have been
 /// pre-lowered but not yet prepared according to the interface.
 /// This can be called for elemental procedures, but only with scalar
 /// arguments: if there are array arguments, it must be provided with
 /// the array argument elements value and will return the corresponding
 /// scalar result value.
 static std::optional<hlfir::EntityWithAttributes>
 genUserCall(PreparedActualArguments &loweredActuals,
             Fortran::lower::CallerInterface &caller,
             mlir::FunctionType callSiteType, CallContext &callContext) {
   using PassBy = Fortran::lower::CallerInterface::PassEntityBy;
   mlir::Location loc = callContext.loc;
   fir::FirOpBuilder &builder = callContext.getBuilder();
-  llvm::SmallVector<hlfir::AssociateOp> exprAssociations;
+  llvm::SmallVector<CallCleanUp> callCleanUps;
   for (auto [preparedActual, arg] :
        llvm::zip(loweredActuals, caller.getPassedArguments())) {
     mlir::Type argTy = callSiteType.getInput(arg.firArgument);
     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");
 
-    if (preparedActual->handleDynamicOptional)
-      TODO(loc, "passing optional arguments in HLFIR");
-
-    const bool isSimplyContiguous =
-        actual.isScalar() ||
-        Fortran::evaluate::IsSimplyContiguous(
-            *expr, callContext.converter.getFoldingContext());
-
     switch (arg.passBy) {
     case PassBy::Value: {
       // True pass-by-value semantics.
+      assert(!preparedActual->handleDynamicOptional() && "cannot be optional");
+      hlfir::Entity actual = preparedActual->getActual(loc, builder);
       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::BaseAddressValueAttribute:
+    case PassBy::CharBoxValueAttribute:
+    case PassBy::Box:
     case PassBy::BaseAddress:
     case PassBy::BoxChar: {
-      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");
-        exprAssociations.push_back(associate);
-        entity = hlfir::Entity{associate.getBase()};
-      }
-      mlir::Value addr =
-          arg.passBy == PassBy::BaseAddress
-              ? hlfir::genVariableRawAddress(loc, builder, entity)
-              : hlfir::genVariableBoxChar(loc, builder, entity);
-      caller.placeInput(arg, builder.createConvert(loc, argTy, addr));
-    } break;
-    case PassBy::CharBoxValueAttribute: {
-      TODO(loc, "HLFIR PassBy::CharBoxValueAttribute");
+      PreparedDummyArgument preparedDummy = prepareUserCallActualArgument(
+          loc, builder, *preparedActual, argTy, arg, *expr,
+          callContext.converter.getFoldingContext());
+      if (preparedDummy.maybeCleanUp.has_value())
+        callCleanUps.emplace_back(std::move(*preparedDummy.maybeCleanUp));
+      caller.placeInput(arg, preparedDummy.dummy);
     } break;
     case PassBy::AddressAndLength:
       // PassBy::AddressAndLength is only used for character results. Results
       // are not handled here.
       fir::emitFatalError(
           loc, "unexpected PassBy::AddressAndLength for actual arguments");
       break;
     case PassBy::CharProcTuple: {
       TODO(loc, "HLFIR PassBy::CharProcTuple");
     } break;
-    case PassBy::Box: {
-      TODO(loc, "HLFIR PassBy::Box");
-    } break;
     case PassBy::MutableBox: {
+      hlfir::Entity actual = preparedActual->getActual(loc, builder);
       if (Fortran::evaluate::UnwrapExpr<Fortran::evaluate::NullPointer>(
               *expr)) {
         // If expr is NULL(), the mutableBox created must be a deallocated
         // pointer with the dummy argument characteristics (see table 16.5
         // in Fortran 2018 standard).
         // No length parameters are set for the created box because any non
         // deferred type parameters of the dummy will be evaluated on the
         // callee side, and it is illegal to use NULL without a MOLD if any
genUserCall(PreparedActualArguments &loweredActuals,
   // Prepare lowered arguments according to the interface
   // and map the lowered values to the dummy
   // arguments.
   fir::ExtendedValue result = Fortran::lower::genCallOpAndResult(
       loc, callContext.converter, callContext.symMap, callContext.stmtCtx,
       caller, callSiteType, callContext.resultType);
 
   /// Clean-up associations and copy-in.
-  for (auto associate : exprAssociations)
-    builder.create<hlfir::EndAssociateOp>(loc, associate);
+  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");
 }
 
 /// Lower calls to intrinsic procedures with actual arguments that have been
 /// pre-lowered but have not yet been prepared according to the interface.
 static hlfir::EntityWithAttributes genIntrinsicRefCore(
     PreparedActualArguments &loweredActuals,
     const Fortran::evaluate::SpecificIntrinsic &intrinsic,
     const Fortran::lower::IntrinsicArgumentLoweringRules *argLowering,
     CallContext &callContext) {
   llvm::SmallVector<fir::ExtendedValue> operands;
   auto &stmtCtx = callContext.stmtCtx;
   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(Fortran::lower::getAbsentIntrinsicArgument());
       continue;
     }
-    hlfir::Entity actual = arg.value()->actual;
-    if (arg.value()->handleDynamicOptional)
+    if (arg.value()->handleDynamicOptional())
       TODO(loc, "intrinsic dynamically optional arguments");
+    hlfir::Entity actual = arg.value()->getActual(loc, builder);
     if (!argLowering) {
       // No argument lowering instruction, lower by value.
       operands.emplace_back(
           Fortran::lower::convertToValue(loc, converter, actual, stmtCtx));
       continue;
     }
     // Ad-hoc argument lowering handling.
     Fortran::lower::ArgLoweringRule argRules =
case Fortran::lower::LowerIntrinsicArgAs::Box:
           Fortran::lower::convertToBox(loc, converter, actual, stmtCtx));
       continue;
     case Fortran::lower::LowerIntrinsicArgAs::Inquired:
       TODO(loc, "as inquired arguments in HLFIR");
       continue;
     }
     llvm_unreachable("bad switch");
   }
-  fir::FirOpBuilder &builder = callContext.getBuilder();
   // genIntrinsicCall needs the scalar type, even if this is a transformational
   // procedure returning an array.
   std::optional<mlir::Type> scalarResultType;
   if (callContext.resultType)
     scalarResultType = hlfir::getFortranElementType(*callContext.resultType);
   // Let the intrinsic library lower the intrinsic procedure call.
   auto [resultExv, mustBeFreed] = Fortran::lower::genIntrinsicCall(
       callContext.getBuilder(), loc, intrinsic.name, scalarResultType,
public:
   std::optional<hlfir::EntityWithAttributes>
   genElementalCall(PreparedActualArguments &loweredActuals, bool isImpure,
                    CallContext &callContext) {
     mlir::Location loc = callContext.loc;
     fir::FirOpBuilder &builder = callContext.getBuilder();
     unsigned numArgs = loweredActuals.size();
     // Step 1: dereference pointers/allocatables and compute elemental shape.
     mlir::Value shape;
+    PreparedActualArgument *optionalWithShape;
     // 10.1.4 p5. Impure elemental procedures must be called in element order.
     bool mustBeOrdered = isImpure;
     for (unsigned i = 0; i < numArgs; ++i) {
       auto &preparedActual = loweredActuals[i];
       if (preparedActual) {
-        hlfir::Entity &actual = preparedActual->actual;
+        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);
         // Better to load scalars outside of the loop when possible.
-        if (!preparedActual->handleDynamicOptional &&
+        if (!preparedActual->handleDynamicOptional() &&
             impl().canLoadActualArgumentBeforeLoop(i))
           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");
+          if (preparedActual->handleDynamicOptional())
+            optionalWithShape = &*preparedActual;
+          else
             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 (impl().argMayBeModifiedByCall(i))
           mustBeOrdered = true;
-      }
+        // Propagates pointer dereferences and scalar loads.
+        preparedActual->setOriginalActual(actual);
+      }
+    if (!shape && optionalWithShape) {
+      // If all arrays operand 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 operands.
+      shape =
+          hlfir::genShape(loc, builder, optionalWithShape->getOriginalActual());
+      // 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.
+      optionalWithShape->resetOptionalAspect();
     }
     assert(shape &&
            "elemental array calls must have at least one array arguments");
     if (mustBeOrdered)
       TODO(loc, "ordered elemental calls in HLFIR");
     // Push a new local scope so that any temps made inside the elemental
     // iterations are cleaned up inside the iterations.
     if (!callContext.resultType) {
       // Subroutine case. Generate call inside loop nest.
-      auto [innerLoop, oneBasedIndices] =
+      auto [innerLoop, oneBasedIndicesVector] =
           hlfir::genLoopNest(loc, builder, shape);
+      mlir::ValueRange oneBasedIndices = oneBasedIndicesVector;
       auto insPt = builder.saveInsertionPoint();
       builder.setInsertionPointToStart(innerLoop.getBody());
       callContext.stmtCtx.pushScope();
       for (auto &preparedActual : loweredActuals)
         if (preparedActual)
-          preparedActual->actual = hlfir::getElementAt(
-              loc, builder, preparedActual->actual, oneBasedIndices);
+          preparedActual->setElementalIndices(oneBasedIndices);
       impl().genElementalKernel(loweredActuals, callContext);
       callContext.stmtCtx.finalizeAndPop();
       builder.restoreInsertionPoint(insPt);
       return std::nullopt;
     }
     // Function case: generate call inside hlfir.elemental
     mlir::Type elementType =
         hlfir::getFortranElementType(*callContext.resultType);
if (elementType.isa<fir::CharacterType>() ||
             loc,
             "compute elemental PDT function result length parameters in HLFIR");
     }
     auto genKernel = [&](mlir::Location l, fir::FirOpBuilder &b,
                          mlir::ValueRange oneBasedIndices) -> hlfir::Entity {
       callContext.stmtCtx.pushScope();
       for (auto &preparedActual : loweredActuals)
         if (preparedActual)
-          preparedActual->actual = hlfir::getElementAt(
-              l, b, preparedActual->actual, oneBasedIndices);
+          preparedActual->setElementalIndices(oneBasedIndices);
       auto res = *impl().genElementalKernel(loweredActuals, callContext);
       callContext.stmtCtx.finalizeAndPop();
       // Note that an hlfir.destroy is not emitted for the result since it
       // is still used by the hlfir.yield_element that also marks its last
       // use.
       return res;
     };
     mlir::Value elemental = hlfir::genElementalOp(loc, builder, elementType,
bool canLoadActualArgumentBeforeLoop(int) const {
     return isFunction;
   }
 
   mlir::Value
   computeDynamicCharacterResultLength(PreparedActualArguments &loweredActuals,
                                       CallContext &callContext) {
     if (intrinsic.name == "adjustr" || intrinsic.name == "adjustl" ||
         intrinsic.name == "merge")
-      return hlfir::genCharLength(callContext.loc, callContext.getBuilder(),
-                                  loweredActuals[0].value().actual);
+      return hlfir::genCharLength(
+          callContext.loc, callContext.getBuilder(),
+          loweredActuals[0].value().getOriginalActual());
     // Character MIN/MAX is the min/max of the arguments length that are
     // present.
     TODO(callContext.loc,
          "compute elemental character min/max function result length in HLFIR");
   }
 
 private:
   const Fortran::evaluate::SpecificIntrinsic &intrinsic;
   const Fortran::lower::IntrinsicArgumentLoweringRules *argLowering;
   const bool isFunction;
 };
 } // namespace
 
+static std::optional<mlir::Value>
+genIsPresentIfArgMaybeOptional(mlir::Location loc, hlfir::Entity actual,
+                               const Fortran::lower::SomeExpr &expr,
+                               CallContext &callContext,
+                               bool passAsAllocatableOrPointer) {
+  if (!Fortran::evaluate::MayBePassedAsAbsentOptional(
+          expr, callContext.converter.getFoldingContext()))
+    return std::nullopt;
+  fir::FirOpBuilder &builder = callContext.getBuilder();
+  if (!passAsAllocatableOrPointer &&
+      Fortran::evaluate::IsAllocatableOrPointerObject(
+          expr, callContext.converter.getFoldingContext())) {
+    // Passing Allocatable/Pointer to non-pointer/non-allocatable OPTIONAL.
+    // Fortran 2018 15.5.2.12 point 1: If unallocated/disassociated, it is
+    // as if the argument was absent. The main care here is to not do a
+    // copy-in/copy-out because the temp address, even though pointing to a
+    // null size storage, would not be a nullptr and therefore the argument
+    // would not be considered absent on the callee side. Note: if the
+    // allocatable/pointer is also optional, it cannot be absent as per
+    // 15.5.2.12 point 7. and 8. We rely on this to un-conditionally read
+    // the allocatable/pointer descriptor here.
+    mlir::Value addr = genVariableRawAddress(loc, builder, actual);
+    return builder.genIsNotNullAddr(loc, addr);
+  }
+  // TODO: what if passing allocatable target to optional intent(in) pointer?
+  // May fall into the category above if the allocatable is not optional.
+
+  // Passing an optional to an optional.
+  return builder.create<fir::IsPresentOp>(loc, builder.getI1Type(), actual)
+      .getResult();
+}
+
 /// Lower an intrinsic procedure reference.
 static hlfir::EntityWithAttributes
 genIntrinsicRef(const Fortran::evaluate::SpecificIntrinsic &intrinsic,
                 CallContext &callContext) {
   mlir::Location loc = callContext.loc;
   auto &converter = callContext.converter;
   if (Fortran::lower::intrinsicRequiresCustomOptionalHandling(
           callContext.procRef, intrinsic, converter))
     TODO(loc, "special cases of intrinsic with optional arguments");
 
   PreparedActualArguments loweredActuals;
   const Fortran::lower::IntrinsicArgumentLoweringRules *argLowering =
       Fortran::lower::getIntrinsicArgumentLowering(intrinsic.name);
   for (const auto &arg : llvm::enumerate(callContext.procRef.arguments())) {
     auto *expr =
         Fortran::evaluate::UnwrapExpr<Fortran::lower::SomeExpr>(arg.value());
     if (!expr) {
       // Absent optional.
       loweredActuals.push_back(std::nullopt);
       continue;
     }
     auto loweredActual = Fortran::lower::convertExprToHLFIR(
         loc, callContext.converter, *expr, callContext.symMap,
         callContext.stmtCtx);
-    bool handleDynamicOptional = false;
+    std::optional<mlir::Value> isPresent;
     if (argLowering) {
       Fortran::lower::ArgLoweringRule argRules =
           Fortran::lower::lowerIntrinsicArgumentAs(*argLowering, arg.index());
-      handleDynamicOptional = argRules.handleDynamicOptional &&
-                              Fortran::evaluate::MayBePassedAsAbsentOptional(
-                                  *expr, converter.getFoldingContext());
+      if (argRules.handleDynamicOptional)
+        isPresent = genIsPresentIfArgMaybeOptional(
+            loc, loweredActual, *expr, callContext,
+            /*passAsAllocatableOrPointer=*/false);
     }
-    loweredActuals.push_back(
-        PreparedActualArgument{loweredActual, handleDynamicOptional});
+    loweredActuals.push_back(PreparedActualArgument{loweredActual, isPresent});
   }
 
   if (callContext.isElementalProcWithArrayArgs()) {
     // All intrinsic elemental functions are pure.
     const bool isFunction = callContext.resultType.has_value();
     return ElementalIntrinsicCallBuilder{intrinsic, argLowering, isFunction}
         .genElementalCall(loweredActuals, /*isImpure=*/!isFunction, callContext)
         .value();
genProcedureRef(CallContext &callContext) {
   // 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");
-
-      const bool handleDynamicOptional =
+      if (Fortran::evaluate::UnwrapExpr<Fortran::evaluate::NullPointer>(
+              *expr)) {
+        if (arg.passBy !=
+            Fortran::lower::CallerInterface::PassEntityBy::MutableBox) {
+          assert(
               arg.isOptional() &&
-          Fortran::evaluate::MayBePassedAsAbsentOptional(
-              *expr, callContext.converter.getFoldingContext());
+              "NULL must be passed only to pointer, allocatable, or OPTIONAL");
+          // Trying to lower NULL() outside of any context would lead to
+          // trouble. NULL() here is equivalent to not providing the
+          // actual argument.
+          loweredActuals.emplace_back(std::nullopt);
+          continue;
+        }
+      }
+
       auto loweredActual = Fortran::lower::convertExprToHLFIR(
           loc, callContext.converter, *expr, callContext.symMap,
           callContext.stmtCtx);
+      std::optional<mlir::Value> isPresent;
+      if (arg.isOptional())
+        isPresent = genIsPresentIfArgMaybeOptional(
+            loc, loweredActual, *expr, callContext,
+            arg.passBy ==
+                Fortran::lower::CallerInterface::PassEntityBy::MutableBox);
+
       loweredActuals.emplace_back(
-          PreparedActualArgument{loweredActual, handleDynamicOptional});
+          PreparedActualArgument{loweredActual, isPresent});
     } else {
       // Optional dummy argument for which there is no actual argument.
       loweredActuals.emplace_back(std::nullopt);
     }
   if (callContext.isElementalProcWithArrayArgs()) {
     bool isImpure = false;
     if (const Fortran::semantics::Symbol *procSym =
             callContext.procRef.proc().GetSymbol())

flang/lib/Lower/ConvertExprToHLFIR.cpp

visitComponentImpl(const Fortran::evaluate::Component &component,
 
     hlfir::genLengthParameters(getLoc(), getBuilder(), *partInfo.base,
                                partInfo.typeParams);
     mlir::Type baseType = partInfo.base->getElementOrSequenceType();
 
     // Lower the information about the component (type, length parameters and
     // shape).
     const Fortran::semantics::Symbol &componentSym = component.GetLastSymbol();
+    if (componentSym.test(Fortran::semantics::Symbol::Flag::ParentComp))
+      TODO(getLoc(), "Parent component reference in HLFIR");
     partInfo.componentName = componentSym.name().ToString();
     auto recordType =
         hlfir::getFortranElementType(baseType).cast<fir::RecordType>();
     if (recordType.isDependentType())
       TODO(getLoc(), "Designate derived type with length parameters in HLFIR");
     mlir::Type fieldType = recordType.getType(partInfo.componentName);
     mlir::Type fieldBaseType =
         hlfir::getFortranElementOrSequenceType(fieldType);

flang/lib/Optimizer/Builder/HLFIRTools.cpp

mlir::Value hlfir::genVariableBoxChar(mlir::Location loc,
   auto boxCharType =
       fir::BoxCharType::get(builder.getContext(), charType.getFKind());
   auto scalarAddr =
       builder.createConvert(loc, fir::ReferenceType::get(charType), addr);
   return builder.create<fir::EmboxCharOp>(loc, boxCharType, scalarAddr,
                                           lengths[0]);
 }
 
+hlfir::Entity hlfir::genVariableBox(mlir::Location loc,
+                                    fir::FirOpBuilder &builder,
+                                    hlfir::Entity var) {
+  assert(var.isVariable() && "must be a variable");
+  var = hlfir::derefPointersAndAllocatables(loc, builder, var);
+  if (var.getType().isa<fir::BaseBoxType>())
+    return var;
+  // Note: if the var is not a fir.box/fir.class at that point, it has default
+  // lower bounds and is not polymorphic.
+  mlir::Value shape =
+      var.isArray() ? hlfir::genShape(loc, builder, var) : mlir::Value{};
+  llvm::SmallVector<mlir::Value> typeParams;
+  auto maybeCharType =
+      var.getFortranElementType().dyn_cast<fir::CharacterType>();
+  if (!maybeCharType || maybeCharType.hasDynamicLen())
+    hlfir::genLengthParameters(loc, builder, var, typeParams);
+  mlir::Type boxType = fir::BoxType::get(var.getElementOrSequenceType());
+  auto embox =
+      builder.create<fir::EmboxOp>(loc, boxType, var, shape,
+                                   /*slice=*/mlir::Value{}, typeParams);
+  return hlfir::Entity{embox.getResult()};
+}
+
 hlfir::Entity hlfir::loadTrivialScalar(mlir::Location loc,
                                        fir::FirOpBuilder &builder,
                                        Entity entity) {
   entity = derefPointersAndAllocatables(loc, builder, entity);
   if (entity.isVariable() && entity.isScalar() &&
       fir::isa_trivial(entity.getFortranElementType())) {
     return Entity{builder.create<fir::LoadOp>(loc, entity)};
   }

flang/lib/Optimizer/Dialect/FIROps.cpp

 //===----------------------------------------------------------------------===//
 // BoxAddrOp
 //===----------------------------------------------------------------------===//
 
 void fir::BoxAddrOp::build(mlir::OpBuilder &builder,
                            mlir::OperationState &result, mlir::Value val) {
   mlir::Type type =
       llvm::TypeSwitch<mlir::Type, mlir::Type>(val.getType())
-          .Case<fir::BoxType>([&](fir::BoxType ty) -> mlir::Type {
+          .Case<fir::BaseBoxType>([&](fir::BaseBoxType ty) -> mlir::Type {
             mlir::Type eleTy = ty.getEleTy();
             if (fir::isa_ref_type(eleTy))
               return eleTy;
             return fir::ReferenceType::get(eleTy);
           })
           .Case<fir::BoxCharType>([&](fir::BoxCharType ty) -> mlir::Type {
             return fir::ReferenceType::get(ty.getEleTy());
           })

flang/lib/Optimizer/HLFIR/IR/HLFIROps.cpp

 
 //===----------------------------------------------------------------------===//
 // CopyInOp
 //===----------------------------------------------------------------------===//
 
 void hlfir::CopyInOp::build(mlir::OpBuilder &builder,
                             mlir::OperationState &odsState, mlir::Value var,
                             mlir::Value var_is_present) {
-  return build(builder, odsState, var.getType(), var, var_is_present);
+  return build(builder, odsState, {var.getType(), builder.getI1Type()}, var,
+               var_is_present);
 }
 
 #define GET_OP_CLASSES
 #include "flang/Optimizer/HLFIR/HLFIROps.cpp.inc"

flang/test/Lower/HLFIR/calls-assumed-shape.f90

+! Test lowering of calls involving assumed shape arrays or arrays with
+! VALUE attribute.
+! RUN: bbc -emit-fir -hlfir -polymorphic-type -o - %s | FileCheck %s
+
+subroutine test_assumed_to_assumed(x)
+  interface
+    subroutine takes_assumed(x)
+      real :: x(:)
+    end subroutine
+  end interface
+  real :: x(:)
+  call takes_assumed(x)
+end subroutine
+! CHECK-LABEL: func.func @_QPtest_assumed_to_assumed(
+! CHECK:  %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {uniq_name = "_QFtest_assumed_to_assumedEx"} : (!fir.box<!fir.array<?xf32>>) -> (!fir.box<!fir.array<?xf32>>, !fir.box<!fir.array<?xf32>>)
+! CHECK:  fir.call @_QPtakes_assumed(%[[VAL_1]]#0) {{.*}} : (!fir.box<!fir.array<?xf32>>) -> ()
+
+subroutine test_ptr_to_assumed(p)
+  interface
+    subroutine takes_assumed(x)
+      real :: x(:)
+    end subroutine
+  end interface
+  real, pointer :: p(:)
+  call takes_assumed(p)
+end subroutine
+! CHECK-LABEL: func.func @_QPtest_ptr_to_assumed(
+! CHECK:  %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFtest_ptr_to_assumedEp"} : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>) -> (!fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>, !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>)
+! CHECK:  %[[VAL_2:.*]] = fir.load %[[VAL_1]]#0 : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
+! CHECK:  %[[VAL_3:.*]] = fir.rebox %[[VAL_2]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.box<!fir.array<?xf32>>
+! CHECK:  fir.call @_QPtakes_assumed(%[[VAL_3]]) {{.*}} : (!fir.box<!fir.array<?xf32>>) -> ()
+
+subroutine test_ptr_to_contiguous_assumed(p)
+  interface
+    subroutine takes_contiguous_assumed(x)
+      real, contiguous :: x(:)
+    end subroutine
+  end interface
+  real, pointer :: p(:)
+  call takes_contiguous_assumed(p)
+end subroutine
+! CHECK-LABEL: func.func @_QPtest_ptr_to_contiguous_assumed(
+! CHECK:  %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFtest_ptr_to_contiguous_assumedEp"} : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>) -> (!fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>, !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>)
+! CHECK:  %[[VAL_2:.*]] = fir.load %[[VAL_1]]#0 : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
+! CHECK:  %[[VAL_3:.*]]:2 = hlfir.copy_in %[[VAL_2]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> (!fir.box<!fir.ptr<!fir.array<?xf32>>>, i1)
+! CHECK:  %[[VAL_4:.*]] = fir.rebox %[[VAL_3]]#0 : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.box<!fir.array<?xf32>>
+! CHECK:  fir.call @_QPtakes_contiguous_assumed(%[[VAL_4]]) {{.*}} : (!fir.box<!fir.array<?xf32>>) -> ()
+! CHECK:  hlfir.copy_out %[[VAL_3]]#0, %[[VAL_3]]#1 to %[[VAL_2]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, i1, !fir.box<!fir.ptr<!fir.array<?xf32>>>) -> ()
+
+subroutine test_ptr_to_contiguous_assumed_classstar(p)
+  interface
+    subroutine takes_contiguous_assumed_classstar(x)
+      class(*), contiguous :: x(:)
+    end subroutine
+  end interface
+  real, pointer :: p(:)
+  call takes_contiguous_assumed_classstar(p)
+end subroutine
+! CHECK-LABEL: func.func @_QPtest_ptr_to_contiguous_assumed_classstar(
+! CHECK:  %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFtest_ptr_to_contiguous_assumed_classstarEp"} : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>) -> (!fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>, !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>)
+! CHECK:  %[[VAL_2:.*]] = fir.load %[[VAL_1]]#0 : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
+! CHECK:  %[[VAL_3:.*]]:2 = hlfir.copy_in %[[VAL_2]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> (!fir.box<!fir.ptr<!fir.array<?xf32>>>, i1)
+! CHECK:  %[[VAL_4:.*]] = fir.rebox %[[VAL_3]]#0 : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.class<!fir.array<?xnone>>
+! CHECK:  fir.call @_QPtakes_contiguous_assumed_classstar(%[[VAL_4]]) {{.*}} : (!fir.class<!fir.array<?xnone>>) -> ()
+! CHECK:  hlfir.copy_out %[[VAL_3]]#0, %[[VAL_3]]#1 to %[[VAL_2]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, i1, !fir.box<!fir.ptr<!fir.array<?xf32>>>) -> ()
+
+subroutine test_ptr_to_assumed_typestar(p)
+  interface
+    subroutine takes_assumed_typestar(x)
+      type(*) :: x(:)
+    end subroutine
+  end interface
+  real, pointer :: p(:)
+  call takes_assumed_typestar(p)
+end subroutine
+! CHECK-LABEL: func.func @_QPtest_ptr_to_assumed_typestar(
+! CHECK:  %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFtest_ptr_to_assumed_typestarEp"} : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>) -> (!fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>, !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>)
+! CHECK:  %[[VAL_2:.*]] = fir.load %[[VAL_1]]#0 : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
+! CHECK:  %[[VAL_3:.*]] = fir.rebox %[[VAL_2]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.box<!fir.array<?xnone>>
+! CHECK:  fir.call @_QPtakes_assumed_typestar(%[[VAL_3]]) {{.*}} : (!fir.box<!fir.array<?xnone>>) -> ()
+
+subroutine test_explicit_char_to_box(e)
+  interface
+    subroutine takes_assumed_character(x)
+      character(*) :: x(:)
+    end subroutine
+  end interface
+  character(10) :: e(20)
+  call takes_assumed_character(e)
+end subroutine
+! CHECK-LABEL: func.func @_QPtest_explicit_char_to_box(
+! CHECK:  %[[VAL_1:.*]]:2 = fir.unboxchar %[[VAL_0]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+! CHECK:  %[[VAL_2:.*]] = arith.constant 10 : index
+! CHECK:  %[[VAL_3:.*]] = fir.convert %[[VAL_1]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.array<20x!fir.char<1,10>>>
+! CHECK:  %[[VAL_4:.*]] = arith.constant 20 : index
+! CHECK:  %[[VAL_5:.*]] = fir.shape %[[VAL_4]] : (index) -> !fir.shape<1>
+! CHECK:  %[[VAL_6:.*]]:2 = hlfir.declare %[[VAL_3]](%[[VAL_5:[a-z0-9]*]]) typeparams %[[VAL_2:[a-z0-9]*]] {uniq_name = "_QFtest_explicit_char_to_boxEe"} : (!fir.ref<!fir.array<20x!fir.char<1,10>>>, !fir.shape<1>, index) -> (!fir.ref<!fir.array<20x!fir.char<1,10>>>, !fir.ref<!fir.array<20x!fir.char<1,10>>>)
+! CHECK:  %[[VAL_7:.*]] = fir.embox %[[VAL_6]]#0(%[[VAL_5]]) : (!fir.ref<!fir.array<20x!fir.char<1,10>>>, !fir.shape<1>) -> !fir.box<!fir.array<20x!fir.char<1,10>>>
+! CHECK:  %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (!fir.box<!fir.array<20x!fir.char<1,10>>>) -> !fir.box<!fir.array<?x!fir.char<1,?>>>
+! CHECK:  fir.call @_QPtakes_assumed_character(%[[VAL_8]]) {{.*}} : (!fir.box<!fir.array<?x!fir.char<1,?>>>) -> ()
+
+subroutine test_explicit_by_val(x)
+  interface
+    subroutine takes_explicit_by_value(x)
+      real, value :: x(10)
+    end subroutine
+  end interface
+  real :: x(10)
+  call takes_explicit_by_value(x)
+end subroutine
+! CHECK-LABEL: func.func @_QPtest_explicit_by_val(
+! CHECK:  %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]](%[[VAL_2:[a-z0-9]*]]) {uniq_name = "_QFtest_explicit_by_valEx"} : (!fir.ref<!fir.array<10xf32>>, !fir.shape<1>) -> (!fir.ref<!fir.array<10xf32>>, !fir.ref<!fir.array<10xf32>>)
+! CHECK:  %[[VAL_4:.*]] = hlfir.as_expr %[[VAL_3]]#0 : (!fir.ref<!fir.array<10xf32>>) -> !hlfir.expr<10xf32>
+! CHECK:  %[[VAL_5:.*]]:3 = hlfir.associate %[[VAL_4]](%[[VAL_2]]) {uniq_name = "adapt.valuebyref"} : (!hlfir.expr<10xf32>, !fir.shape<1>) -> (!fir.ref<!fir.array<10xf32>>, !fir.ref<!fir.array<10xf32>>, i1)
+! CHECK:  fir.call @_QPtakes_explicit_by_value(%[[VAL_5]]#1) {{.*}} : (!fir.ref<!fir.array<10xf32>>) -> ()
+! CHECK:  hlfir.end_associate %[[VAL_5]]#1, %[[VAL_5]]#2 : !fir.ref<!fir.array<10xf32>>, i1

flang/test/Lower/HLFIR/calls-optional.f90

+! Test lowering of user calls involving passing an actual argument
+! that is syntactically present, but may be absent at runtime (is
+! an optional or a pointer/allocatable).
+!
+! RUN: bbc -emit-fir -hlfir -polymorphic-type -o - %s | FileCheck %s
+
+subroutine optional_copy_in_out(x)
+  interface
+    subroutine takes_optional_explicit(x)
+      real, optional :: x(*)
+    end subroutine
+  end interface
+  real, optional :: x(:)
+  call  takes_optional_explicit(x)
+end subroutine
+! CHECK-LABEL: func.func @_QPoptional_copy_in_out(
+! CHECK:  %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs<optional>, uniq_name = "_QFoptional_copy_in_outEx"} : (!fir.box<!fir.array<?xf32>>) -> (!fir.box<!fir.array<?xf32>>, !fir.box<!fir.array<?xf32>>)
+! CHECK:  %[[VAL_2:.*]] = fir.is_present %[[VAL_1]]#0 : (!fir.box<!fir.array<?xf32>>) -> i1
+! CHECK:  %[[VAL_3:.*]]:4 = fir.if %[[VAL_2]] -> (!fir.ref<!fir.array<?xf32>>, !fir.box<!fir.array<?xf32>>, i1, !fir.box<!fir.array<?xf32>>) {
+! CHECK:    %[[VAL_4:.*]]:2 = hlfir.copy_in %[[VAL_1]]#0 : (!fir.box<!fir.array<?xf32>>) -> (!fir.box<!fir.array<?xf32>>, i1)
+! CHECK:    %[[VAL_5:.*]] = fir.box_addr %[[VAL_4]]#0 : (!fir.box<!fir.array<?xf32>>) -> !fir.ref<!fir.array<?xf32>>
+! CHECK:    fir.result %[[VAL_5]], %[[VAL_4]]#0, %[[VAL_4]]#1, %[[VAL_1]]#0 : !fir.ref<!fir.array<?xf32>>, !fir.box<!fir.array<?xf32>>, i1, !fir.box<!fir.array<?xf32>>
+! CHECK:  } else {
+! CHECK:    %[[VAL_6:.*]] = fir.absent !fir.ref<!fir.array<?xf32>>
+! CHECK:    %[[VAL_7:.*]] = fir.absent !fir.box<!fir.array<?xf32>>
+! CHECK:    %[[VAL_8:.*]] = arith.constant false
+! CHECK:    %[[VAL_9:.*]] = fir.absent !fir.box<!fir.array<?xf32>>
+! CHECK:    fir.result %[[VAL_6]], %[[VAL_7]], %[[VAL_8]], %[[VAL_9]] : !fir.ref<!fir.array<?xf32>>, !fir.box<!fir.array<?xf32>>, i1, !fir.box<!fir.array<?xf32>>
+! CHECK:  }
+! CHECK:  fir.call @_QPtakes_optional_explicit(%[[VAL_3]]#0) {{.*}} : (!fir.ref<!fir.array<?xf32>>) -> ()
+! CHECK:  hlfir.copy_out %[[VAL_3]]#1, %[[VAL_3]]#2 to %[[VAL_3]]#3 : (!fir.box<!fir.array<?xf32>>, i1, !fir.box<!fir.array<?xf32>>) -> ()
+
+subroutine optional_value_copy(x)
+  interface
+    subroutine takes_optional_explicit_value(x)
+      real, value, optional :: x(100)
+    end subroutine
+  end interface
+  real, optional :: x(100)
+  call  takes_optional_explicit_value(x)
+end subroutine
+! CHECK-LABEL: func.func @_QPoptional_value_copy(
+! CHECK:  %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]](%[[VAL_2:[a-z0-9]*]]) {fortran_attrs = #fir.var_attrs<optional>, uniq_name = "_QFoptional_value_copyEx"} : (!fir.ref<!fir.array<100xf32>>, !fir.shape<1>) -> (!fir.ref<!fir.array<100xf32>>, !fir.ref<!fir.array<100xf32>>)
+! CHECK:  %[[VAL_4:.*]] = fir.is_present %[[VAL_3]]#0 : (!fir.ref<!fir.array<100xf32>>) -> i1
+! CHECK:  %[[VAL_5:.*]]:3 = fir.if %[[VAL_4]] -> (!fir.ref<!fir.array<100xf32>>, !fir.ref<!fir.array<100xf32>>, i1) {
+! CHECK:    %[[VAL_6:.*]] = hlfir.as_expr %[[VAL_3]]#0 : (!fir.ref<!fir.array<100xf32>>) -> !hlfir.expr<100xf32>
+! CHECK:    %[[VAL_7:.*]]:3 = hlfir.associate %[[VAL_6]](%[[VAL_2]]) {uniq_name = "adapt.valuebyref"} : (!hlfir.expr<100xf32>, !fir.shape<1>) -> (!fir.ref<!fir.array<100xf32>>, !fir.ref<!fir.array<100xf32>>, i1)
+! CHECK:    fir.result %[[VAL_7]]#1, %[[VAL_7]]#1, %[[VAL_7]]#2 : !fir.ref<!fir.array<100xf32>>, !fir.ref<!fir.array<100xf32>>, i1
+! CHECK:  } else {
+! CHECK:    %[[VAL_8:.*]] = fir.absent !fir.ref<!fir.array<100xf32>>
+! CHECK:    %[[VAL_9:.*]] = fir.absent !fir.ref<!fir.array<100xf32>>
+! CHECK:    %[[VAL_10:.*]] = arith.constant false
+! CHECK:    fir.result %[[VAL_8]], %[[VAL_9]], %[[VAL_10]] : !fir.ref<!fir.array<100xf32>>, !fir.ref<!fir.array<100xf32>>, i1
+! CHECK:  }
+! CHECK:  fir.call @_QPtakes_optional_explicit_value(%[[VAL_5]]#0) {{.*}} : (!fir.ref<!fir.array<100xf32>>) -> ()
+! CHECK:  hlfir.end_associate %[[VAL_5]]#1, %[[VAL_5]]#2 : !fir.ref<!fir.array<100xf32>>, i1
+
+subroutine elem_pointer_to_optional(x, y)
+  interface
+    elemental subroutine elem_takes_two_optional(x, y)
+      real, optional, intent(in) :: y, x
+    end subroutine
+  end interface
+  real :: x(:)
+  real, pointer :: y(:)
+  call elem_takes_two_optional(x, y)
+end subroutine
+! CHECK-LABEL: func.func @_QPelem_pointer_to_optional(
+! CHECK:  %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {uniq_name = "_QFelem_pointer_to_optionalEx"} : (!fir.box<!fir.array<?xf32>>) -> (!fir.box<!fir.array<?xf32>>, !fir.box<!fir.array<?xf32>>)
+! CHECK:  %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_1:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFelem_pointer_to_optionalEy"} : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>) -> (!fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>, !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>)
+! CHECK:  %[[VAL_4:.*]] = fir.load %[[VAL_3]]#1 : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
+! CHECK:  %[[VAL_5:.*]] = fir.box_addr %[[VAL_4]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.ptr<!fir.array<?xf32>>
+! CHECK:  %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (!fir.ptr<!fir.array<?xf32>>) -> i64
+! CHECK:  %[[VAL_7:.*]] = arith.constant 0 : i64
+! CHECK:  %[[VAL_8:.*]] = arith.cmpi ne, %[[VAL_6]], %[[VAL_7]] : i64
+! CHECK:  %[[VAL_9:.*]] = arith.constant 0 : index
+! CHECK:  %[[VAL_10:.*]]:3 = fir.box_dims %[[VAL_2]]#0, %[[VAL_9]] : (!fir.box<!fir.array<?xf32>>, index) -> (index, index, index)
+! CHECK:  %[[VAL_11:.*]] = fir.load %[[VAL_3]]#0 : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
+! CHECK:  %[[VAL_12:.*]] = arith.constant 1 : index
+! CHECK:  fir.do_loop %[[VAL_13:.*]] = %[[VAL_12]] to %[[VAL_10]]#1 step %[[VAL_12]] {
+! CHECK:    %[[VAL_14:.*]] = hlfir.designate %[[VAL_2]]#0 (%[[VAL_13]])  : (!fir.box<!fir.array<?xf32>>, index) -> !fir.ref<f32>
+! CHECK:    %[[VAL_15:.*]] = fir.if %[[VAL_8]] -> (!fir.ref<f32>) {
+! CHECK:      %[[VAL_16:.*]] = arith.constant 0 : index
+! CHECK:      %[[VAL_17:.*]]:3 = fir.box_dims %[[VAL_11]], %[[VAL_16]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, index) -> (index, index, index)
+! CHECK:      %[[VAL_18:.*]] = arith.constant 1 : index
+! CHECK:      %[[VAL_19:.*]] = arith.subi %[[VAL_17]]#0, %[[VAL_18]] : index
+! CHECK:      %[[VAL_20:.*]] = arith.addi %[[VAL_13]], %[[VAL_19]] : index
+! CHECK:      %[[VAL_21:.*]] = hlfir.designate %[[VAL_11]] (%[[VAL_20]])  : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, index) -> !fir.ref<f32>
+! CHECK:      fir.result %[[VAL_21]] : !fir.ref<f32>
+! CHECK:    } else {
+! CHECK:      %[[VAL_22:.*]] = fir.absent !fir.ref<f32>
+! CHECK:      fir.result %[[VAL_22]] : !fir.ref<f32>
+! CHECK:    }
+! CHECK:    fir.call @_QPelem_takes_two_optional(%[[VAL_14]], %[[VAL_15]]) {{.*}} : (!fir.ref<f32>, !fir.ref<f32>) -> ()
+! CHECK:  }
+
+subroutine optional_cannot_be_absent_optional(x)
+  interface
+    elemental subroutine elem_takes_one_optional(x)
+      real, optional, intent(in) :: x
+    end subroutine
+  end interface
+  real, optional :: x(:)
+  ! If all array arguments in an call are optional, they must be all present.
+  call elem_takes_one_optional(x)
+end subroutine
+! CHECK-LABEL: func.func @_QPoptional_cannot_be_absent_optional(
+! CHECK:  %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs<optional>, uniq_name = "_QFoptional_cannot_be_absent_optionalEx"} : (!fir.box<!fir.array<?xf32>>) -> (!fir.box<!fir.array<?xf32>>, !fir.box<!fir.array<?xf32>>)
+! CHECK:  %[[VAL_2:.*]] = arith.constant 0 : index
+! CHECK:  %[[VAL_3:.*]]:3 = fir.box_dims %[[VAL_1]]#0, %[[VAL_2]] : (!fir.box<!fir.array<?xf32>>, index) -> (index, index, index)
+! CHECK:  %[[VAL_4:.*]] = arith.constant 1 : index
+! CHECK:  fir.do_loop %[[VAL_5:.*]] = %[[VAL_4]] to %[[VAL_3]]#1 step %[[VAL_4]] {
+! CHECK:    %[[VAL_6:.*]] = hlfir.designate %[[VAL_1]]#0 (%[[VAL_5]])  : (!fir.box<!fir.array<?xf32>>, index) -> !fir.ref<f32>
+! CHECK:    fir.call @_QPelem_takes_one_optional(%[[VAL_6]]) {{.*}} : (!fir.ref<f32>) -> ()
+! CHECK:  }
+
+subroutine optional_elem_poly(x, y)
+  interface
+    elemental subroutine elem_optional_poly(x, y)
+      class(*), optional, intent(in) :: x, y
+    end subroutine
+  end interface
+  real :: x(:)
+  real, optional :: y(:)
+  call elem_optional_poly(x, y)
+end subroutine
+! CHECK-LABEL: func.func @_QPoptional_elem_poly(
+! CHECK:  %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0:[a-z0-9]*]] {uniq_name = "_QFoptional_elem_polyEx"} : (!fir.box<!fir.array<?xf32>>) -> (!fir.box<!fir.array<?xf32>>, !fir.box<!fir.array<?xf32>>)
+! CHECK:  %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_1:[a-z0-9]*]] {fortran_attrs = #fir.var_attrs<optional>, uniq_name = "_QFoptional_elem_polyEy"} : (!fir.box<!fir.array<?xf32>>) -> (!fir.box<!fir.array<?xf32>>, !fir.box<!fir.array<?xf32>>)
+! CHECK:  %[[VAL_4:.*]] = fir.is_present %[[VAL_3]]#0 : (!fir.box<!fir.array<?xf32>>) -> i1
+! CHECK:  %[[VAL_5:.*]] = arith.constant 0 : index
+! CHECK:  %[[VAL_6:.*]]:3 = fir.box_dims %[[VAL_2]]#0, %[[VAL_5]] : (!fir.box<!fir.array<?xf32>>, index) -> (index, index, index)
+! CHECK:  %[[VAL_7:.*]] = arith.constant 1 : index
+! CHECK:  fir.do_loop %[[VAL_8:.*]] = %[[VAL_7]] to %[[VAL_6]]#1 step %[[VAL_7]] {
+! CHECK:    %[[VAL_9:.*]] = hlfir.designate %[[VAL_2]]#0 (%[[VAL_8]])  : (!fir.box<!fir.array<?xf32>>, index) -> !fir.ref<f32>
+! CHECK:    %[[VAL_10:.*]] = fir.embox %[[VAL_9]] : (!fir.ref<f32>) -> !fir.box<f32>
+! CHECK:    %[[VAL_11:.*]] = fir.rebox %[[VAL_10]] : (!fir.box<f32>) -> !fir.class<none>
+! CHECK:    %[[VAL_12:.*]] = fir.if %[[VAL_4]] -> (!fir.class<none>) {
+! CHECK:      %[[VAL_13:.*]] = hlfir.designate %[[VAL_3]]#0 (%[[VAL_8]])  : (!fir.box<!fir.array<?xf32>>, index) -> !fir.ref<f32>
+! CHECK:      %[[VAL_14:.*]] = fir.embox %[[VAL_13]] : (!fir.ref<f32>) -> !fir.box<f32>
+! CHECK:      %[[VAL_15:.*]] = fir.rebox %[[VAL_14]] : (!fir.box<f32>) -> !fir.class<none>
+! CHECK:      fir.result %[[VAL_15]] : !fir.class<none>
+! CHECK:    } else {
+! CHECK:      %[[VAL_16:.*]] = fir.absent !fir.class<none>
+! CHECK:      fir.result %[[VAL_16]] : !fir.class<none>
+! CHECK:    }
+! CHECK:    fir.call @_QPelem_optional_poly(%[[VAL_11]], %[[VAL_12]]) {{.*}} : (!fir.class<none>, !fir.class<none>) -> ()
+! CHECK:  }
+
+subroutine test_passing_null()
+  interface
+    subroutine takes_optional_assumed(x)
+      real, optional :: x(:)
+    end subroutine
+  end interface
+  call takes_optional_assumed(null())
+ ! NULL(MOLD) lowering is a TODO in HLFIR.
+ ! call takes_optional_assumed(null(p))
+end subroutine
+! CHECK-LABEL: func.func @_QPtest_passing_null() {
+! CHECK:  %[[VAL_0:.*]] = fir.absent !fir.box<!fir.array<?xf32>>
+! CHECK:  fir.call @_QPtakes_optional_assumed(%[[VAL_0]]) {{.*}} : (!fir.box<!fir.array<?xf32>>) -> ()

flang/test/Lower/HLFIR/elemental-intrinsics.f90

subroutine elemental_with_char_args(x,y)
   print *, scan(x, y)
 end subroutine
 ! CHECK-LABEL: func.func @_QPelemental_with_char_args(
 ! CHECK:  %[[VAL_6:.*]]:2 = hlfir.declare %[[VAL_3:[a-z0-9]*]](%[[VAL_5:[a-z0-9]*]]) typeparams %[[VAL_2:[a-z0-9]*]]#1  {{.*}}Ex
 ! CHECK:  %[[VAL_7:.*]]:2 = hlfir.declare %[[VAL_1:[a-z0-9]*]]  {{.*}}Ey
 ! CHECK:  %[[VAL_13:.*]] = hlfir.elemental %[[VAL_5]] : (!fir.shape<1>) -> !hlfir.expr<100xi32> {
 ! CHECK:  ^bb0(%[[VAL_14:.*]]: index):
 ! CHECK:    %[[VAL_15:.*]] = hlfir.designate %[[VAL_6]]#0 (%[[VAL_14]])  typeparams %[[VAL_2]]#1 : (!fir.box<!fir.array<100x!fir.char<1,?>>>, index, index) -> !fir.boxchar<1>
+! CHECK:    %[[VAL_18:.*]]:2 = fir.unboxchar %[[VAL_15]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
 ! CHECK:    %[[VAL_16:.*]] = fir.box_elesize %[[VAL_7]]#1 : (!fir.box<!fir.array<?x!fir.char<1,?>>>) -> index
 ! CHECK:    %[[VAL_17:.*]] = hlfir.designate %[[VAL_7]]#0 (%[[VAL_14]])  typeparams %[[VAL_16]] : (!fir.box<!fir.array<?x!fir.char<1,?>>>, index, index) -> !fir.boxchar<1>
-! CHECK:    %[[VAL_18:.*]]:2 = fir.unboxchar %[[VAL_15]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
 ! CHECK:    %[[VAL_19:.*]]:2 = fir.unboxchar %[[VAL_17]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
 ! CHECK:    %[[VAL_20:.*]] = arith.constant false
 ! CHECK:    %[[VAL_21:.*]] = fir.convert %[[VAL_18]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<i8>
 ! CHECK:    %[[VAL_22:.*]] = fir.convert %[[VAL_2]]#1 : (index) -> i64
 ! CHECK:    %[[VAL_23:.*]] = fir.convert %[[VAL_19]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<i8>
 ! CHECK:    %[[VAL_24:.*]] = fir.convert %[[VAL_16]] : (index) -> i64
 ! CHECK:    %[[VAL_25:.*]] = fir.call @_FortranAScan1(%[[VAL_21]], %[[VAL_22]], %[[VAL_23]], %[[VAL_24]], %[[VAL_20]])
 ! CHECK:    %[[VAL_26:.*]] = fir.convert %[[VAL_25]] : (i64) -> i32

 end subroutine
 ! CHECK-LABEL: func.func @_QPtest_merge(
 ! CHECK:  %[[VAL_5:.*]]:2 = hlfir.declare %[[VAL_2:[a-z0-9]*]](%[[VAL_4:[a-z0-9]*]])  {{.*}}Emask
 ! CHECK:  %[[VAL_10:.*]]:2 = hlfir.declare %[[VAL_7:[a-z0-9]*]](%[[VAL_9:[a-z0-9]*]]) typeparams %[[VAL_6:[a-z0-9]*]]#1  {{.*}}Ex
 ! CHECK:  %[[VAL_15:.*]]:2 = hlfir.declare %[[VAL_12:[a-z0-9]*]](%[[VAL_14:[a-z0-9]*]]) typeparams %[[VAL_11:[a-z0-9]*]]#1  {{.*}}Ey
 ! CHECK:  %[[VAL_16:.*]] = hlfir.elemental %[[VAL_9]] typeparams %[[VAL_6]]#1 : (!fir.shape<1>, index) -> !hlfir.expr<100x!fir.char<1,?>> {
 ! CHECK:  ^bb0(%[[VAL_17:.*]]: index):
 ! CHECK:    %[[VAL_18:.*]] = hlfir.designate %[[VAL_10]]#0 (%[[VAL_17]])  typeparams %[[VAL_6]]#1 : (!fir.box<!fir.array<100x!fir.char<1,?>>>, index, index) -> !fir.boxchar<1>
-! CHECK:    %[[VAL_19:.*]] = hlfir.designate %[[VAL_15]]#0 (%[[VAL_17]])  typeparams %[[VAL_11]]#1 : (!fir.box<!fir.array<100x!fir.char<1,?>>>, index, index) -> !fir.boxchar<1>
-! CHECK:    %[[VAL_20:.*]] = hlfir.designate %[[VAL_5]]#0 (%[[VAL_17]])  : (!fir.ref<!fir.array<100x!fir.logical<4>>>, index) -> !fir.ref<!fir.logical<4>>
 ! CHECK:    %[[VAL_21:.*]]:2 = fir.unboxchar %[[VAL_18]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+! CHECK:    %[[VAL_19:.*]] = hlfir.designate %[[VAL_15]]#0 (%[[VAL_17]])  typeparams %[[VAL_11]]#1 : (!fir.box<!fir.array<100x!fir.char<1,?>>>, index, index) -> !fir.boxchar<1>
 ! CHECK:    %[[VAL_22:.*]]:2 = fir.unboxchar %[[VAL_19]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+! CHECK:    %[[VAL_20:.*]] = hlfir.designate %[[VAL_5]]#0 (%[[VAL_17]])  : (!fir.ref<!fir.array<100x!fir.logical<4>>>, index) -> !fir.ref<!fir.logical<4>>
 ! CHECK:    %[[VAL_23:.*]] = fir.load %[[VAL_20]] : !fir.ref<!fir.logical<4>>
 ! CHECK:    %[[VAL_24:.*]] = fir.convert %[[VAL_23]] : (!fir.logical<4>) -> i1
 ! CHECK:    %[[VAL_25:.*]] = arith.select %[[VAL_24]], %[[VAL_21]]#0, %[[VAL_22]]#0 : !fir.ref<!fir.char<1,?>>
 ! CHECK:    %[[VAL_26:.*]]:2 = hlfir.declare %[[VAL_25]] typeparams %[[VAL_6]]#1 {uniq_name = ".tmp.intrinsic_result"} : (!fir.ref<!fir.char<1,?>>, index) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>)
 ! CHECK:    %[[VAL_27:.*]] = hlfir.as_expr %[[VAL_26]]#0 : (!fir.boxchar<1>) -> !hlfir.expr<!fir.char<1,?>>
 ! CHECK:    hlfir.yield_element %[[VAL_27]] : !hlfir.expr<!fir.char<1,?>>
 ! CHECK:  }