[flang-commits] [flang] 87cd6f9 - [flang][hlfir] Lower post f77 user calls
Jean Perier via flang-commits
flang-commits at lists.llvm.org
Wed Feb 1 02:44:04 PST 2023
Author: Jean Perier
Date: 2023-02-01T11:43:29+01:00
New Revision: 87cd6f934650c2403d776be0cc7f5c065479f77d
URL: https://github.com/llvm/llvm-project/commit/87cd6f934650c2403d776be0cc7f5c065479f77d
DIFF: https://github.com/llvm/llvm-project/commit/87cd6f934650c2403d776be0cc7f5c065479f77d.diff
LOG: [flang][hlfir] Lower post f77 user calls
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).
Differential Revision: https://reviews.llvm.org/D142695
Added:
flang/test/Lower/HLFIR/calls-assumed-shape.f90
flang/test/Lower/HLFIR/calls-optional.f90
Modified:
flang/include/flang/Lower/CallInterface.h
flang/include/flang/Optimizer/Builder/HLFIRTools.h
flang/lib/Lower/CallInterface.cpp
flang/lib/Lower/ConvertCall.cpp
flang/lib/Lower/ConvertExprToHLFIR.cpp
flang/lib/Optimizer/Builder/HLFIRTools.cpp
flang/lib/Optimizer/Dialect/FIROps.cpp
flang/lib/Optimizer/HLFIR/IR/HLFIROps.cpp
flang/test/Lower/HLFIR/elemental-intrinsics.f90
Removed:
################################################################################
diff --git a/flang/include/flang/Lower/CallInterface.h b/flang/include/flang/Lower/CallInterface.h
index 440ac4e78bb98..5308e3450b23f 100644
--- a/flang/include/flang/Lower/CallInterface.h
+++ b/flang/include/flang/Lower/CallInterface.h
@@ -153,16 +153,18 @@ class CallInterface {
/// 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)
diff --git a/flang/include/flang/Optimizer/Builder/HLFIRTools.h b/flang/include/flang/Optimizer/Builder/HLFIRTools.h
index 20b1f35165290..bbc0595a73913 100644
--- a/flang/include/flang/Optimizer/Builder/HLFIRTools.h
+++ b/flang/include/flang/Optimizer/Builder/HLFIRTools.h
@@ -246,6 +246,10 @@ mlir::Value genVariableRawAddress(mlir::Location loc,
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
diff --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp
index bc9967f3e64e6..1f72b5c0709e0 100644
--- a/flang/lib/Lower/CallInterface.cpp
+++ b/flang/lib/Lower/CallInterface.cpp
@@ -1121,12 +1121,7 @@ bool Fortran::lower::CallInterface<T>::PassedEntity::mayBeModifiedByCall()
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 {
@@ -1162,6 +1157,18 @@ bool Fortran::lower::CallInterface<T>::PassedEntity::mustBeMadeContiguous()
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,
diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index a18c1ec8b7d6c..be37c5f5d86fd 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -560,8 +560,37 @@ struct CallContext {
/// 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
@@ -581,6 +610,335 @@ extendedValueToHlfirEntity(mlir::Location loc, fir::FirOpBuilder &builder,
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 argument.
+/// 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 conditionally preparing a dummy argument based
+/// on the actual argument presence.
+/// It helps "wrapping" the dummy and the clean-up information in
+/// an if (present) {...}:
+///
+/// %conditionallyPrepared = 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 %conditionallyPrepared
+ /// 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 is a scalar passed by raw address, a
+ // new descriptor must be made 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
+ // descriptors 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.
@@ -595,7 +953,7 @@ genUserCall(PreparedActualArguments &loweredActuals,
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);
@@ -604,53 +962,31 @@ genUserCall(PreparedActualArguments &loweredActuals,
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
@@ -661,10 +997,8 @@ genUserCall(PreparedActualArguments &loweredActuals,
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
@@ -711,8 +1045,9 @@ genUserCall(PreparedActualArguments &loweredActuals,
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.
@@ -729,15 +1064,16 @@ static hlfir::EntityWithAttributes genIntrinsicRefCore(
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(
@@ -766,7 +1102,6 @@ static hlfir::EntityWithAttributes genIntrinsicRefCore(
}
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;
@@ -808,33 +1143,48 @@ class ElementalCallBuilder {
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");
- shape = hlfir::genShape(loc, builder, actual);
+ 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 array operands appear in optional positions, then none of them
+ // is allowed to be absent as per 15.5.2.12 point 3. (6). Just pick the
+ // first operand.
+ shape =
+ hlfir::genShape(loc, builder, optionalWithShape->getOriginalActual());
+ // 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)
@@ -843,15 +1193,15 @@ class ElementalCallBuilder {
// 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);
@@ -881,8 +1231,7 @@ class ElementalCallBuilder {
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
@@ -972,8 +1321,9 @@ class ElementalIntrinsicCallBuilder
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,
@@ -987,6 +1337,38 @@ class ElementalIntrinsicCallBuilder
};
} // namespace
+static std::optional<mlir::Value>
+genIsPresentIfArgMaybeAbsent(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,
@@ -1011,16 +1393,16 @@ genIntrinsicRef(const Fortran::evaluate::SpecificIntrinsic &intrinsic,
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 =
+ genIsPresentIfArgMaybeAbsent(loc, loweredActual, *expr, callContext,
+ /*passAsAllocatableOrPointer=*/false);
}
- loweredActuals.push_back(
- PreparedActualArgument{loweredActual, handleDynamicOptional});
+ loweredActuals.push_back(PreparedActualArgument{loweredActual, isPresent});
}
if (callContext.isElementalProcWithArrayArgs()) {
@@ -1064,16 +1446,33 @@ genProcedureRef(CallContext &callContext) {
const auto *expr = actual->UnwrapExpr();
if (!expr)
TODO(loc, "assumed type actual argument");
+ if (Fortran::evaluate::UnwrapExpr<Fortran::evaluate::NullPointer>(
+ *expr)) {
+ if (arg.passBy !=
+ Fortran::lower::CallerInterface::PassEntityBy::MutableBox) {
+ assert(
+ arg.isOptional() &&
+ "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;
+ }
+ }
- const bool handleDynamicOptional =
- arg.isOptional() &&
- Fortran::evaluate::MayBePassedAsAbsentOptional(
- *expr, callContext.converter.getFoldingContext());
auto loweredActual = Fortran::lower::convertExprToHLFIR(
loc, callContext.converter, *expr, callContext.symMap,
callContext.stmtCtx);
+ std::optional<mlir::Value> isPresent;
+ if (arg.isOptional())
+ isPresent = genIsPresentIfArgMaybeAbsent(
+ 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);
diff --git a/flang/lib/Lower/ConvertExprToHLFIR.cpp b/flang/lib/Lower/ConvertExprToHLFIR.cpp
index 062d827e59ad1..971d40ef4bc13 100644
--- a/flang/lib/Lower/ConvertExprToHLFIR.cpp
+++ b/flang/lib/Lower/ConvertExprToHLFIR.cpp
@@ -521,6 +521,8 @@ class HlfirDesignatorBuilder {
// 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>();
diff --git a/flang/lib/Optimizer/Builder/HLFIRTools.cpp b/flang/lib/Optimizer/Builder/HLFIRTools.cpp
index 146a063ccb10d..0e49445eabcd0 100644
--- a/flang/lib/Optimizer/Builder/HLFIRTools.cpp
+++ b/flang/lib/Optimizer/Builder/HLFIRTools.cpp
@@ -272,6 +272,29 @@ mlir::Value hlfir::genVariableBoxChar(mlir::Location loc,
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) {
diff --git a/flang/lib/Optimizer/Dialect/FIROps.cpp b/flang/lib/Optimizer/Dialect/FIROps.cpp
index 590a873bb78f8..2af04f869e4b9 100644
--- a/flang/lib/Optimizer/Dialect/FIROps.cpp
+++ b/flang/lib/Optimizer/Dialect/FIROps.cpp
@@ -604,7 +604,7 @@ 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;
diff --git a/flang/lib/Optimizer/HLFIR/IR/HLFIROps.cpp b/flang/lib/Optimizer/HLFIR/IR/HLFIROps.cpp
index 56cb542bcdcf4..9bf5601ce6523 100644
--- a/flang/lib/Optimizer/HLFIR/IR/HLFIROps.cpp
+++ b/flang/lib/Optimizer/HLFIR/IR/HLFIROps.cpp
@@ -522,7 +522,8 @@ void hlfir::NullOp::build(mlir::OpBuilder &builder,
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
diff --git a/flang/test/Lower/HLFIR/calls-assumed-shape.f90 b/flang/test/Lower/HLFIR/calls-assumed-shape.f90
new file mode 100644
index 0000000000000..9f395c34dee47
--- /dev/null
+++ b/flang/test/Lower/HLFIR/calls-assumed-shape.f90
@@ -0,0 +1,116 @@
+! 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
diff --git a/flang/test/Lower/HLFIR/calls-optional.f90 b/flang/test/Lower/HLFIR/calls-optional.f90
new file mode 100644
index 0000000000000..8990e2c4bff7a
--- /dev/null
+++ b/flang/test/Lower/HLFIR/calls-optional.f90
@@ -0,0 +1,162 @@
+! 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>>) -> ()
diff --git a/flang/test/Lower/HLFIR/elemental-intrinsics.f90 b/flang/test/Lower/HLFIR/elemental-intrinsics.f90
index 20c5f5730dc01..d38e4a9d59c05 100644
--- a/flang/test/Lower/HLFIR/elemental-intrinsics.f90
+++ b/flang/test/Lower/HLFIR/elemental-intrinsics.f90
@@ -73,9 +73,9 @@ subroutine elemental_with_char_args(x,y)
! 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>
@@ -139,10 +139,10 @@ subroutine test_merge(x, y, mask)
! 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,?>>
More information about the flang-commits
mailing list