[flang-commits] [flang] cedfd27 - [flang][hlfir] Lower procedure designators to HLFIR
Jean Perier via flang-commits
flang-commits at lists.llvm.org
Thu Feb 9 00:03:41 PST 2023
Author: Jean Perier
Date: 2023-02-09T09:02:52+01:00
New Revision: cedfd2721e3492e5ab0ea86d24d8027846687c27
URL: https://github.com/llvm/llvm-project/commit/cedfd2721e3492e5ab0ea86d24d8027846687c27
DIFF: https://github.com/llvm/llvm-project/commit/cedfd2721e3492e5ab0ea86d24d8027846687c27.diff
LOG: [flang][hlfir] Lower procedure designators to HLFIR
- Add a convertProcedureDesignatorToHLFIR that converts the
fir::ExtendedValue from the current lowering to a
fir.boxproc/tuple<fir.boxproc, len> mlir::Value.
- Allow fir.boxproc/tuple<fir.boxproc, len> as hlfir::Entity values
(a function is an address, but from a Fortran entity point of view,
procedure that are not procedure pointers cannot be assigned to, so
it makes a lot more sense to consider those as values).
- Modify symbol association to not generate an hlfir.declare for dummy
procedures. They are not needed and allowing hlfir.declare to declare
function values would make its verifier and handling overly complex
for little benefits (maybe an hlfir.declare_proc could be added if it
turnout out useful later for debug info and attributes storing
purposes).
- Allow translation from hlfir::Entity to fir::ExtendedValue.
convertToBox return type had to be relaxed because some intrinsics
handles both object and procedure arguments and need to lower their
object arguments "asBox". fir::BoxValue is not intended to carry
dummy procedures (all its member functions would make little sense
and its verifier does not accept such type).
Note that AsAddr, AsValue and AsBox will always return the same MLIR
value for procedure designators because they are always handled the
same way in FIR.
Differential Revision: https://reviews.llvm.org/D143585
Added:
flang/test/Lower/HLFIR/procedure-designators.f90
Modified:
flang/include/flang/Lower/CallInterface.h
flang/include/flang/Lower/ConvertExprToHLFIR.h
flang/include/flang/Lower/ConvertProcedureDesignator.h
flang/include/flang/Optimizer/Builder/Character.h
flang/include/flang/Optimizer/Builder/HLFIRTools.h
flang/lib/Lower/Bridge.cpp
flang/lib/Lower/CallInterface.cpp
flang/lib/Lower/ConvertCall.cpp
flang/lib/Lower/ConvertExprToHLFIR.cpp
flang/lib/Lower/ConvertProcedureDesignator.cpp
flang/lib/Lower/ConvertVariable.cpp
flang/lib/Optimizer/Builder/Character.cpp
flang/lib/Optimizer/Builder/HLFIRTools.cpp
Removed:
################################################################################
diff --git a/flang/include/flang/Lower/CallInterface.h b/flang/include/flang/Lower/CallInterface.h
index 5308e3450b23f..110403768b493 100644
--- a/flang/include/flang/Lower/CallInterface.h
+++ b/flang/include/flang/Lower/CallInterface.h
@@ -429,6 +429,9 @@ getOrDeclareFunction(llvm::StringRef name,
mlir::Type getDummyProcedureType(const Fortran::semantics::Symbol &dummyProc,
Fortran::lower::AbstractConverter &);
+/// Return !fir.boxproc<() -> ()> type.
+mlir::Type getUntypedBoxProcType(mlir::MLIRContext *context);
+
/// Return true if \p ty is "!fir.ref<i64>", which is the interface for
/// type(C_PTR/C_FUNPTR) passed by value.
bool isCPtrArgByValueType(mlir::Type ty);
diff --git a/flang/include/flang/Lower/ConvertExprToHLFIR.h b/flang/include/flang/Lower/ConvertExprToHLFIR.h
index 84968917c5857..0acb713cd04c5 100644
--- a/flang/include/flang/Lower/ConvertExprToHLFIR.h
+++ b/flang/include/flang/Lower/ConvertExprToHLFIR.h
@@ -48,21 +48,24 @@ translateToExtendedValue(mlir::Location loc, fir::FirOpBuilder &builder,
return exv;
}
-/// Lower an evaluate::Expr to a fir::Box.
-fir::BoxValue convertExprToBox(mlir::Location loc,
- Fortran::lower::AbstractConverter &,
- const Fortran::lower::SomeExpr &,
- Fortran::lower::SymMap &,
- Fortran::lower::StatementContext &);
-fir::BoxValue convertToBox(mlir::Location loc,
- Fortran::lower::AbstractConverter &,
- hlfir::Entity entity,
- Fortran::lower::StatementContext &,
- mlir::Type fortranType);
+/// Lower an evaluate::Expr object to a fir.box, and a procedure designator to a
+/// fir.boxproc<>
+fir::ExtendedValue convertExprToBox(mlir::Location loc,
+ Fortran::lower::AbstractConverter &,
+ const Fortran::lower::SomeExpr &,
+ Fortran::lower::SymMap &,
+ Fortran::lower::StatementContext &);
+fir::ExtendedValue convertToBox(mlir::Location loc,
+ Fortran::lower::AbstractConverter &,
+ hlfir::Entity entity,
+ Fortran::lower::StatementContext &,
+ mlir::Type fortranType);
/// Lower an evaluate::Expr to fir::ExtendedValue address.
-/// The address may be a raw fir.ref<T>, or a fir.box<T>/fir.class<T>, (pointer
-/// and allocatable are dereferenced).
+/// The address may be a raw fir.ref<T>, or a fir.box<T>/fir.class<T>, or a
+/// fir.boxproc<>. Pointers and allocatable are dereferenced.
+/// - If the expression is a procedure designator, it is lowered to fir.boxproc
+/// (with an extra length for character function procedure designators).
/// - If expression is not a variable, or is a designator with vector
/// subscripts, a temporary is created to hold the expression value and
/// is returned as:
diff --git a/flang/include/flang/Lower/ConvertProcedureDesignator.h b/flang/include/flang/Lower/ConvertProcedureDesignator.h
index 6032754572e4c..86a757a9aadf4 100644
--- a/flang/include/flang/Lower/ConvertProcedureDesignator.h
+++ b/flang/include/flang/Lower/ConvertProcedureDesignator.h
@@ -23,6 +23,9 @@ class Location;
namespace fir {
class ExtendedValue;
}
+namespace hlfir {
+class EntityWithAttributes;
+}
namespace Fortran::evaluate {
struct ProcedureDesignator;
}
@@ -40,5 +43,12 @@ fir::ExtendedValue convertProcedureDesignator(
const Fortran::evaluate::ProcedureDesignator &proc,
Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx);
+/// Lower a procedure designator to a !fir.boxproc<()->() or
+/// tuple<!fir.boxproc<()->(), len>.
+hlfir::EntityWithAttributes convertProcedureDesignatorToHLFIR(
+ mlir::Location loc, Fortran::lower::AbstractConverter &converter,
+ const Fortran::evaluate::ProcedureDesignator &proc,
+ Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx);
+
} // namespace Fortran::lower
#endif // FORTRAN_LOWER_CONVERT_PROCEDURE_DESIGNATOR_H
diff --git a/flang/include/flang/Optimizer/Builder/Character.h b/flang/include/flang/Optimizer/Builder/Character.h
index 820c64f9357bb..3d8d9c6086461 100644
--- a/flang/include/flang/Optimizer/Builder/Character.h
+++ b/flang/include/flang/Optimizer/Builder/Character.h
@@ -224,9 +224,11 @@ mlir::Value createCharacterProcedureTuple(fir::FirOpBuilder &builder,
/// Given a tuple containing a character function address and its result length,
/// extract the tuple into a pair of value <function address, result length>.
+/// If openBoxProc is true, the function address is extracted from the
+/// fir.boxproc, otherwise, the returned function address is the fir.boxproc.
std::pair<mlir::Value, mlir::Value>
extractCharacterProcedureTuple(fir::FirOpBuilder &builder, mlir::Location loc,
- mlir::Value tuple);
+ mlir::Value tuple, bool openBoxProc = true);
} // namespace fir::factory
diff --git a/flang/include/flang/Optimizer/Builder/HLFIRTools.h b/flang/include/flang/Optimizer/Builder/HLFIRTools.h
index eeb71e3e6231c..e610478c34994 100644
--- a/flang/include/flang/Optimizer/Builder/HLFIRTools.h
+++ b/flang/include/flang/Optimizer/Builder/HLFIRTools.h
@@ -29,9 +29,18 @@ class AssociateOp;
class ElementalOp;
class YieldElementOp;
+/// Is this an SSA value type for the value of a Fortran procedure
+/// designator ?
+inline bool isFortranProcedureValue(mlir::Type type) {
+ return type.isa<fir::BoxProcType>() ||
+ (type.isa<mlir::TupleType>() &&
+ fir::isCharacterProcedureTuple(type, /*acceptRawFunc=*/false));
+}
+
/// Is this an SSA value type for the value of a Fortran expression?
inline bool isFortranValueType(mlir::Type type) {
- return type.isa<hlfir::ExprType>() || fir::isa_trivial(type);
+ return type.isa<hlfir::ExprType>() || fir::isa_trivial(type) ||
+ isFortranProcedureValue(type);
}
/// Is this the value of a Fortran expression in an SSA value form?
@@ -77,6 +86,10 @@ class Entity : public mlir::Value {
bool isBoxAddressOrValue() const {
return hlfir::isBoxAddressOrValueType(getType());
}
+
+ /// Is this entity a procedure designator?
+ bool isProcedure() const { return isFortranProcedureValue(getType()); }
+
/// Is this an array or an assumed ranked entity?
bool isArray() const { return getRank() != 0; }
@@ -357,7 +370,7 @@ std::pair<fir::ExtendedValue, std::optional<hlfir::CleanupFunction>>
convertToAddress(mlir::Location loc, fir::FirOpBuilder &builder,
const hlfir::Entity &entity, mlir::Type targetType);
-std::pair<fir::BoxValue, std::optional<hlfir::CleanupFunction>>
+std::pair<fir::ExtendedValue, std::optional<hlfir::CleanupFunction>>
convertToBox(mlir::Location loc, fir::FirOpBuilder &builder,
const hlfir::Entity &entity, mlir::Type targetType);
} // namespace hlfir
diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index 5cf81c73d9f0b..a87027e9d19d6 100644
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -807,6 +807,12 @@ class FirConverter : public Fortran::lower::AbstractConverter {
},
[](auto x) -> Fortran::lower::SymbolBox { return x; });
}
+ // Procedure dummies are not mapped with an hlfir.declare because
+ // they are not "variable" (cannot be assigned to), and it would
+ // make hlfir.declare more complex than it needs to to allow this.
+ // Do a regular lookup.
+ if (Fortran::semantics::IsProcedure(sym))
+ return symMap->lookupSymbol(sym);
return {};
}
if (Fortran::lower::SymbolBox v = symMap->lookupSymbol(sym))
diff --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp
index 1f72b5c0709e0..bc6ba47c9c0fe 100644
--- a/flang/lib/Lower/CallInterface.cpp
+++ b/flang/lib/Lower/CallInterface.cpp
@@ -39,24 +39,27 @@ static std::string getMangledName(mlir::Location loc,
return bindName ? *bindName : Fortran::lower::mangle::mangleName(symbol);
}
+mlir::Type Fortran::lower::getUntypedBoxProcType(mlir::MLIRContext *context) {
+ llvm::SmallVector<mlir::Type> resultTys;
+ llvm::SmallVector<mlir::Type> inputTys;
+ auto untypedFunc = mlir::FunctionType::get(context, inputTys, resultTys);
+ return fir::BoxProcType::get(context, untypedFunc);
+}
+
/// Return the type of a dummy procedure given its characteristic (if it has
/// one).
-mlir::Type getProcedureDesignatorType(
+static mlir::Type getProcedureDesignatorType(
const Fortran::evaluate::characteristics::Procedure *,
Fortran::lower::AbstractConverter &converter) {
// TODO: Get actual function type of the dummy procedure, at least when an
// interface is given. The result type should be available even if the arity
// and type of the arguments is not.
- llvm::SmallVector<mlir::Type> resultTys;
- llvm::SmallVector<mlir::Type> inputTys;
// In general, that is a nice to have but we cannot guarantee to find the
// function type that will match the one of the calls, we may not even know
// how many arguments the dummy procedure accepts (e.g. if a procedure
// pointer is only transiting through the current procedure without being
// called), so a function type cast must always be inserted.
- auto *context = &converter.getMLIRContext();
- auto untypedFunc = mlir::FunctionType::get(context, inputTys, resultTys);
- return fir::BoxProcType::get(context, untypedFunc);
+ return Fortran::lower::getUntypedBoxProcType(&converter.getMLIRContext());
}
//===----------------------------------------------------------------------===//
diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index 3e8ea0534eb5d..92a853b6f83de 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -782,6 +782,11 @@ static PreparedDummyArgument preparePresentUserCallActualArgument(
// element if this is an array in an elemental call.
hlfir::Entity actual = preparedActual.getActual(loc, builder);
+ // Do nothing if this is a procedure argument. It is already a
+ // fir.boxproc/fir.tuple<fir.boxproc, len> as it should.
+ if (actual.isProcedure())
+ return PreparedDummyArgument{actual, std::nullopt};
+
const bool passingPolymorphicToNonPolymorphic =
actual.isPolymorphic() && !fir::isPolymorphicType(dummyType);
@@ -1013,7 +1018,10 @@ genUserCall(PreparedActualArguments &loweredActuals,
loc, "unexpected PassBy::AddressAndLength for actual arguments");
break;
case PassBy::CharProcTuple: {
- TODO(loc, "HLFIR PassBy::CharProcTuple");
+ hlfir::Entity actual = preparedActual->getActual(loc, builder);
+ assert(fir::isCharacterProcedureTuple(actual.getType()) &&
+ "character dummy procedure was not prepared as expected");
+ caller.placeInput(arg, actual);
} break;
case PassBy::MutableBox: {
hlfir::Entity actual = preparedActual->getActual(loc, builder);
diff --git a/flang/lib/Lower/ConvertExprToHLFIR.cpp b/flang/lib/Lower/ConvertExprToHLFIR.cpp
index 85ed34e5e2199..f0344ba59e0bd 100644
--- a/flang/lib/Lower/ConvertExprToHLFIR.cpp
+++ b/flang/lib/Lower/ConvertExprToHLFIR.cpp
@@ -16,6 +16,7 @@
#include "flang/Lower/CallInterface.h"
#include "flang/Lower/ConvertCall.h"
#include "flang/Lower/ConvertConstant.h"
+#include "flang/Lower/ConvertProcedureDesignator.h"
#include "flang/Lower/ConvertType.h"
#include "flang/Lower/ConvertVariable.h"
#include "flang/Lower/StatementContext.h"
@@ -1024,9 +1025,11 @@ class HlfirBuilder {
}
hlfir::EntityWithAttributes
- gen(const Fortran::evaluate::ProcedureDesignator &expr) {
- TODO(getLoc(), "lowering ProcDes to HLFIR");
+ gen(const Fortran::evaluate::ProcedureDesignator &proc) {
+ return Fortran::lower::convertProcedureDesignatorToHLFIR(
+ getLoc(), getConverter(), proc, getSymMap(), getStmtCtx());
}
+
hlfir::EntityWithAttributes gen(const Fortran::evaluate::ProcedureRef &expr) {
TODO(getLoc(), "lowering ProcRef to HLFIR");
}
@@ -1256,7 +1259,7 @@ hlfir::EntityWithAttributes Fortran::lower::convertExprToHLFIR(
return HlfirBuilder(loc, converter, symMap, stmtCtx).gen(expr);
}
-fir::BoxValue Fortran::lower::convertToBox(
+fir::ExtendedValue Fortran::lower::convertToBox(
mlir::Location loc, Fortran::lower::AbstractConverter &converter,
hlfir::Entity entity, Fortran::lower::StatementContext &stmtCtx,
mlir::Type fortranType) {
@@ -1266,7 +1269,8 @@ fir::BoxValue Fortran::lower::convertToBox(
stmtCtx.attachCleanup(*cleanup);
return exv;
}
-fir::BoxValue Fortran::lower::convertExprToBox(
+
+fir::ExtendedValue Fortran::lower::convertExprToBox(
mlir::Location loc, Fortran::lower::AbstractConverter &converter,
const Fortran::lower::SomeExpr &expr, Fortran::lower::SymMap &symMap,
Fortran::lower::StatementContext &stmtCtx) {
diff --git a/flang/lib/Lower/ConvertProcedureDesignator.cpp b/flang/lib/Lower/ConvertProcedureDesignator.cpp
index 30987930424e6..aa5a7fe0ce5c5 100644
--- a/flang/lib/Lower/ConvertProcedureDesignator.cpp
+++ b/flang/lib/Lower/ConvertProcedureDesignator.cpp
@@ -93,3 +93,35 @@ fir::ExtendedValue Fortran::lower::convertProcedureDesignator(
}
return funcPtr;
}
+
+hlfir::EntityWithAttributes Fortran::lower::convertProcedureDesignatorToHLFIR(
+ mlir::Location loc, Fortran::lower::AbstractConverter &converter,
+ const Fortran::evaluate::ProcedureDesignator &proc,
+ Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx) {
+ fir::ExtendedValue procExv =
+ convertProcedureDesignator(loc, converter, proc, symMap, stmtCtx);
+ // Directly package the procedure address as a fir.boxproc or
+ // tuple<fir.boxbroc, len> so that it can be returned as a single mlir::Value.
+ fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+
+ mlir::Value funcAddr = fir::getBase(procExv);
+ if (!funcAddr.getType().isa<fir::BoxProcType>()) {
+ mlir::Type boxTy =
+ Fortran::lower::getUntypedBoxProcType(&converter.getMLIRContext());
+ if (auto host = Fortran::lower::argumentHostAssocs(converter, funcAddr))
+ funcAddr = builder.create<fir::EmboxProcOp>(
+ loc, boxTy, llvm::ArrayRef<mlir::Value>{funcAddr, host});
+ else
+ funcAddr = builder.create<fir::EmboxProcOp>(loc, boxTy, funcAddr);
+ }
+
+ mlir::Value res = procExv.match(
+ [&](const fir::CharBoxValue &box) -> mlir::Value {
+ mlir::Type tupleTy =
+ fir::factory::getCharacterProcedureTupleType(funcAddr.getType());
+ return fir::factory::createCharacterProcedureTuple(
+ builder, loc, tupleTy, funcAddr, box.getLen());
+ },
+ [funcAddr](const auto &) { return funcAddr; });
+ return hlfir::EntityWithAttributes{res};
+}
diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp
index 1b3036d295aec..82960f96872ff 100644
--- a/flang/lib/Lower/ConvertVariable.cpp
+++ b/flang/lib/Lower/ConvertVariable.cpp
@@ -1439,7 +1439,13 @@ static void genDeclareSymbol(Fortran::lower::AbstractConverter &converter,
llvm::ArrayRef<mlir::Value> shape = std::nullopt,
llvm::ArrayRef<mlir::Value> lbounds = std::nullopt,
bool force = false) {
- if (converter.getLoweringOptions().getLowerToHighLevelFIR()) {
+ // In HLFIR, procedure dummy symbols are not added with an hlfir.declare
+ // because they are "values", and hlfir.declare is intended for variables. It
+ // would add too much complexity to hlfir.declare to support this case, and
+ // this would bring very little (the only point being debug info, that are not
+ // yet emitted) since alias analysis is meaningless for those.
+ if (converter.getLoweringOptions().getLowerToHighLevelFIR() &&
+ !Fortran::semantics::IsProcedure(sym)) {
fir::FirOpBuilder &builder = converter.getFirOpBuilder();
const mlir::Location loc = genLocation(converter, sym);
mlir::Value shapeOrShift;
@@ -1488,7 +1494,8 @@ void Fortran::lower::genDeclareSymbol(
Fortran::lower::AbstractConverter &converter,
Fortran::lower::SymMap &symMap, const Fortran::semantics::Symbol &sym,
const fir::ExtendedValue &exv, bool force) {
- if (converter.getLoweringOptions().getLowerToHighLevelFIR()) {
+ if (converter.getLoweringOptions().getLowerToHighLevelFIR() &&
+ !Fortran::semantics::IsProcedure(sym)) {
fir::FirOpBuilder &builder = converter.getFirOpBuilder();
const mlir::Location loc = genLocation(converter, sym);
fir::FortranVariableFlagsAttr attributes =
diff --git a/flang/lib/Optimizer/Builder/Character.cpp b/flang/lib/Optimizer/Builder/Character.cpp
index aa455e768a086..c9b0be948831b 100644
--- a/flang/lib/Optimizer/Builder/Character.cpp
+++ b/flang/lib/Optimizer/Builder/Character.cpp
@@ -710,15 +710,17 @@ mlir::Value fir::factory::CharacterExprHelper::getLength(mlir::Value memref) {
std::pair<mlir::Value, mlir::Value>
fir::factory::extractCharacterProcedureTuple(fir::FirOpBuilder &builder,
mlir::Location loc,
- mlir::Value tuple) {
+ mlir::Value tuple,
+ bool openBoxProc) {
mlir::TupleType tupleType = tuple.getType().cast<mlir::TupleType>();
mlir::Value addr = builder.create<fir::ExtractValueOp>(
loc, tupleType.getType(0), tuple,
builder.getArrayAttr(
{builder.getIntegerAttr(builder.getIndexType(), 0)}));
mlir::Value proc = [&]() -> mlir::Value {
- if (auto addrTy = addr.getType().dyn_cast<fir::BoxProcType>())
- return builder.create<fir::BoxAddrOp>(loc, addrTy.getEleTy(), addr);
+ if (openBoxProc)
+ if (auto addrTy = addr.getType().dyn_cast<fir::BoxProcType>())
+ return builder.create<fir::BoxAddrOp>(loc, addrTy.getEleTy(), addr);
return addr;
}();
mlir::Value len = builder.create<fir::ExtractValueOp>(
diff --git a/flang/lib/Optimizer/Builder/HLFIRTools.cpp b/flang/lib/Optimizer/Builder/HLFIRTools.cpp
index 04c130ffcaeb1..41cc800ac182c 100644
--- a/flang/lib/Optimizer/Builder/HLFIRTools.cpp
+++ b/flang/lib/Optimizer/Builder/HLFIRTools.cpp
@@ -806,6 +806,15 @@ hlfir::translateToExtendedValue(mlir::Location loc, fir::FirOpBuilder &builder,
return {translateVariableToExtendedValue(loc, builder, entity),
std::nullopt};
+ if (entity.isProcedure()) {
+ if (fir::isCharacterProcedureTuple(entity.getType())) {
+ auto [boxProc, len] = fir::factory::extractCharacterProcedureTuple(
+ builder, loc, entity, /*openBoxProc=*/false);
+ return {fir::CharBoxValue{boxProc, len}, std::nullopt};
+ }
+ return {static_cast<mlir::Value>(entity), std::nullopt};
+ }
+
if (entity.getType().isa<hlfir::ExprType>()) {
hlfir::AssociateOp associate = hlfir::genAssociateExpr(
loc, builder, entity, entity.getType(), "adapt.valuebyref");
@@ -856,10 +865,14 @@ static fir::ExtendedValue placeTrivialInMemory(mlir::Location loc,
return temp;
}
-std::pair<fir::BoxValue, std::optional<hlfir::CleanupFunction>>
+std::pair<fir::ExtendedValue, std::optional<hlfir::CleanupFunction>>
hlfir::convertToBox(mlir::Location loc, fir::FirOpBuilder &builder,
const hlfir::Entity &entity, mlir::Type targetType) {
auto [exv, cleanup] = translateToExtendedValue(loc, builder, entity);
+ // Procedure entities should not go through createBoxValue that embox
+ // object entities. Return the fir.boxproc directly.
+ if (entity.isProcedure())
+ return {exv, cleanup};
mlir::Value base = fir::getBase(exv);
if (fir::isa_trivial(base.getType()))
exv = placeTrivialInMemory(loc, builder, base, targetType);
diff --git a/flang/test/Lower/HLFIR/procedure-designators.f90 b/flang/test/Lower/HLFIR/procedure-designators.f90
new file mode 100644
index 0000000000000..e814cd40bcc96
--- /dev/null
+++ b/flang/test/Lower/HLFIR/procedure-designators.f90
@@ -0,0 +1,158 @@
+! Test lowering of procedure designators to HLFIR.
+! RUN: bbc -emit-fir -hlfir -o - %s | FileCheck %s
+
+module test_proc_designator
+ interface
+ subroutine simple()
+ end subroutine
+ character(10) function return_char(x)
+ integer :: x
+ end function
+ end interface
+contains
+
+subroutine test_pass_simple()
+ call takes_simple(simple)
+end subroutine
+! CHECK-LABEL: func.func @_QMtest_proc_designatorPtest_pass_simple() {
+! CHECK: %[[VAL_0:.*]] = fir.address_of(@_QPsimple) : () -> ()
+! CHECK: %[[VAL_1:.*]] = fir.emboxproc %[[VAL_0]] : (() -> ()) -> !fir.boxproc<() -> ()>
+! CHECK: fir.call @_QPtakes_simple(%[[VAL_1]]) {{.*}}: (!fir.boxproc<() -> ()>) -> ()
+
+subroutine test_pass_character()
+ call takes_char_proc(return_char)
+end subroutine
+! CHECK-LABEL: func.func @_QMtest_proc_designatorPtest_pass_character() {
+! CHECK: %[[VAL_0:.*]] = fir.address_of(@_QPreturn_char) : (!fir.ref<!fir.char<1,10>>, index, !fir.ref<i32>) -> !fir.boxchar<1>
+! CHECK: %[[VAL_1:.*]] = arith.constant 10 : i64
+! CHECK: %[[VAL_2:.*]] = fir.emboxproc %[[VAL_0]] : ((!fir.ref<!fir.char<1,10>>, index, !fir.ref<i32>) -> !fir.boxchar<1>) -> !fir.boxproc<() -> ()>
+! CHECK: %[[VAL_3:.*]] = fir.undefined tuple<!fir.boxproc<() -> ()>, i64>
+! CHECK: %[[VAL_4:.*]] = fir.insert_value %[[VAL_3]], %[[VAL_2]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>, !fir.boxproc<() -> ()>) -> tuple<!fir.boxproc<() -> ()>, i64>
+! CHECK: %[[VAL_5:.*]] = fir.insert_value %[[VAL_4]], %[[VAL_1]], [1 : index] : (tuple<!fir.boxproc<() -> ()>, i64>, i64) -> tuple<!fir.boxproc<() -> ()>, i64>
+! CHECK: fir.call @_QPtakes_char_proc(%[[VAL_5]]) {{.*}}: (tuple<!fir.boxproc<() -> ()>, i64>) -> ()
+
+subroutine test_pass_simple_dummy(proc)
+ procedure(simple) :: proc
+ call takes_simple(proc)
+end subroutine
+! CHECK-LABEL: func.func @_QMtest_proc_designatorPtest_pass_simple_dummy(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.boxproc<() -> ()>) {
+! CHECK: fir.call @_QPtakes_simple(%[[VAL_0]]) {{.*}}: (!fir.boxproc<() -> ()>) -> ()
+
+subroutine test_pass_character_dummy(proc)
+ procedure(return_char) :: proc
+ call takes_char_proc(proc)
+end subroutine
+! CHECK-LABEL: func.func @_QMtest_proc_designatorPtest_pass_character_dummy(
+! CHECK-SAME: %[[VAL_0:.*]]: tuple<!fir.boxproc<() -> ()>, i64> {fir.char_proc}) {
+! CHECK: %[[VAL_1:.*]] = fir.extract_value %[[VAL_0]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>) -> !fir.boxproc<() -> ()>
+! CHECK: %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]] : (!fir.boxproc<() -> ()>) -> (() -> ())
+! CHECK: %[[VAL_3:.*]] = arith.constant 10 : i64
+! CHECK: %[[VAL_4:.*]] = fir.emboxproc %[[VAL_2]] : (() -> ()) -> !fir.boxproc<() -> ()>
+! CHECK: %[[VAL_5:.*]] = fir.undefined tuple<!fir.boxproc<() -> ()>, i64>
+! CHECK: %[[VAL_6:.*]] = fir.insert_value %[[VAL_5]], %[[VAL_4]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>, !fir.boxproc<() -> ()>) -> tuple<!fir.boxproc<() -> ()>, i64>
+! CHECK: %[[VAL_7:.*]] = fir.insert_value %[[VAL_6]], %[[VAL_3]], [1 : index] : (tuple<!fir.boxproc<() -> ()>, i64>, i64) -> tuple<!fir.boxproc<() -> ()>, i64>
+! CHECK: fir.call @_QPtakes_char_proc(%[[VAL_7]]) {{.*}}: (tuple<!fir.boxproc<() -> ()>, i64>) -> ()
+
+subroutine test_pass_character_dummy_2(proc)
+ character(*), external :: proc
+ call takes_char_proc(proc)
+end subroutine
+! CHECK-LABEL: func.func @_QMtest_proc_designatorPtest_pass_character_dummy_2(
+! CHECK-SAME: %[[VAL_0:.*]]: tuple<!fir.boxproc<() -> ()>, i64> {fir.char_proc}) {
+! CHECK: %[[VAL_1:.*]] = fir.extract_value %[[VAL_0]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>) -> !fir.boxproc<() -> ()>
+! CHECK: %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]] : (!fir.boxproc<() -> ()>) -> (() -> ())
+! CHECK: %[[VAL_3:.*]] = fir.extract_value %[[VAL_0]], [1 : index] : (tuple<!fir.boxproc<() -> ()>, i64>) -> i64
+! CHECK: %[[VAL_4:.*]] = fir.emboxproc %[[VAL_2]] : (() -> ()) -> !fir.boxproc<() -> ()>
+! CHECK: %[[VAL_5:.*]] = fir.undefined tuple<!fir.boxproc<() -> ()>, i64>
+! CHECK: %[[VAL_6:.*]] = fir.insert_value %[[VAL_5]], %[[VAL_4]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>, !fir.boxproc<() -> ()>) -> tuple<!fir.boxproc<() -> ()>, i64>
+! CHECK: %[[VAL_7:.*]] = fir.insert_value %[[VAL_6]], %[[VAL_3]], [1 : index] : (tuple<!fir.boxproc<() -> ()>, i64>, i64) -> tuple<!fir.boxproc<() -> ()>, i64>
+! CHECK: fir.call @_QPtakes_char_proc(%[[VAL_7]]) {{.*}}: (tuple<!fir.boxproc<() -> ()>, i64>) -> ()
+
+subroutine test_pass_simple_internal()
+ integer :: x
+ call takes_simple(simple_internal)
+contains
+subroutine simple_internal()
+ x = 42
+end subroutine
+end subroutine
+! CHECK-LABEL: func.func @_QMtest_proc_designatorPtest_pass_simple_internal() {
+! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare {{.*}}Ex
+! CHECK: %[[VAL_2:.*]] = fir.alloca tuple<!fir.ref<i32>>
+! CHECK: %[[VAL_3:.*]] = arith.constant 0 : i32
+! CHECK: %[[VAL_4:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_3]] : (!fir.ref<tuple<!fir.ref<i32>>>, i32) -> !fir.llvm_ptr<!fir.ref<i32>>
+! CHECK: fir.store %[[VAL_1]]#1 to %[[VAL_4]] : !fir.llvm_ptr<!fir.ref<i32>>
+! CHECK: %[[VAL_5:.*]] = fir.address_of(@_QMtest_proc_designatorFtest_pass_simple_internalPsimple_internal) : (!fir.ref<tuple<!fir.ref<i32>>>) -> ()
+! CHECK: %[[VAL_6:.*]] = fir.emboxproc %[[VAL_5]], %[[VAL_2]] : ((!fir.ref<tuple<!fir.ref<i32>>>) -> (), !fir.ref<tuple<!fir.ref<i32>>>) -> !fir.boxproc<() -> ()>
+! CHECK: fir.call @_QPtakes_simple(%[[VAL_6]]) {{.*}}: (!fir.boxproc<() -> ()>) -> ()
+
+subroutine test_pass_character_internal()
+ integer :: x
+ call takes_char_proc(return_char_internal)
+contains
+character(10) function return_char_internal()
+ return_char_internal = char(x)
+end function
+end subroutine
+! CHECK-LABEL: func.func @_QMtest_proc_designatorPtest_pass_character_internal() {
+! CHECK: %[[VAL_1:.*]]:2 = hlfir.declare {{.*}}Ex
+! CHECK: %[[VAL_2:.*]] = fir.alloca tuple<!fir.ref<i32>>
+! CHECK: %[[VAL_3:.*]] = arith.constant 0 : i32
+! CHECK: %[[VAL_4:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_3]] : (!fir.ref<tuple<!fir.ref<i32>>>, i32) -> !fir.llvm_ptr<!fir.ref<i32>>
+! CHECK: fir.store %[[VAL_1]]#1 to %[[VAL_4]] : !fir.llvm_ptr<!fir.ref<i32>>
+! CHECK: %[[VAL_5:.*]] = fir.address_of(@_QMtest_proc_designatorFtest_pass_character_internalPreturn_char_internal) : (!fir.ref<!fir.char<1,10>>, index, !fir.ref<tuple<!fir.ref<i32>>>) -> !fir.boxchar<1>
+! CHECK: %[[VAL_6:.*]] = arith.constant 10 : i64
+! CHECK: %[[VAL_7:.*]] = fir.emboxproc %[[VAL_5]], %[[VAL_2]] : ((!fir.ref<!fir.char<1,10>>, index, !fir.ref<tuple<!fir.ref<i32>>>) -> !fir.boxchar<1>, !fir.ref<tuple<!fir.ref<i32>>>) -> !fir.boxproc<() -> ()>
+! CHECK: %[[VAL_8:.*]] = fir.undefined tuple<!fir.boxproc<() -> ()>, i64>
+! CHECK: %[[VAL_9:.*]] = fir.insert_value %[[VAL_8]], %[[VAL_7]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>, !fir.boxproc<() -> ()>) -> tuple<!fir.boxproc<() -> ()>, i64>
+! CHECK: %[[VAL_10:.*]] = fir.insert_value %[[VAL_9]], %[[VAL_6]], [1 : index] : (tuple<!fir.boxproc<() -> ()>, i64>, i64) -> tuple<!fir.boxproc<() -> ()>, i64>
+! CHECK: fir.call @_QPtakes_char_proc(%[[VAL_10]]) {{.*}}: (tuple<!fir.boxproc<() -> ()>, i64>) -> ()
+
+
+subroutine test_call_simple_dummy(proc)
+ procedure(simple) :: proc
+ call proc()
+end subroutine
+! CHECK-LABEL: func.func @_QMtest_proc_designatorPtest_call_simple_dummy(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.boxproc<() -> ()>) {
+! CHECK: %[[VAL_1:.*]] = fir.box_addr %[[VAL_0]] : (!fir.boxproc<() -> ()>) -> (() -> ())
+! CHECK: fir.call %[[VAL_1]]() {{.*}}: () -> ()
+
+subroutine test_call_character_dummy(proc)
+ procedure(return_char) :: proc
+ call takes_char(proc(42))
+end subroutine
+! CHECK-LABEL: func.func @_QMtest_proc_designatorPtest_call_character_dummy(
+! CHECK-SAME: %[[VAL_0:.*]]: tuple<!fir.boxproc<() -> ()>, i64> {fir.char_proc}) {
+! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.char<1,10> {bindc_name = ".result"}
+! CHECK: %[[VAL_4:.*]] = fir.extract_value %[[VAL_0]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>) -> !fir.boxproc<() -> ()>
+! CHECK: %[[VAL_5:.*]] = fir.box_addr %[[VAL_4]] : (!fir.boxproc<() -> ()>) -> (() -> ())
+! CHECK: %[[VAL_12:.*]] = fir.convert %[[VAL_5]] : (() -> ()) -> ((!fir.ref<!fir.char<1,10>>, index, !fir.ref<i32>) -> !fir.boxchar<1>)
+! CHECK: %[[VAL_13:.*]] = fir.call %[[VAL_12]](%[[VAL_1]], {{.*}}
+
+subroutine test_present_simple_dummy(proc)
+ procedure(simple), optional :: proc
+ call takes_logical(present(proc))
+end subroutine
+! CHECK-LABEL: func.func @_QMtest_proc_designatorPtest_present_simple_dummy(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.boxproc<() -> ()>) {
+! CHECK: %[[VAL_1:.*]] = fir.is_present %[[VAL_0]] : (!fir.boxproc<() -> ()>) -> i1
+
+subroutine test_present_character_dummy(proc)
+ procedure(return_char), optional :: proc
+ call takes_logical(present(proc))
+end subroutine
+! CHECK-LABEL: func.func @_QMtest_proc_designatorPtest_present_character_dummy(
+! CHECK-SAME: %[[VAL_0:.*]]: tuple<!fir.boxproc<() -> ()>, i64> {fir.char_proc}) {
+! CHECK: %[[VAL_1:.*]] = fir.extract_value %[[VAL_0]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>) -> !fir.boxproc<() -> ()>
+! CHECK: %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]] : (!fir.boxproc<() -> ()>) -> (() -> ())
+! CHECK: %[[VAL_3:.*]] = arith.constant 10 : i64
+! CHECK: %[[VAL_4:.*]] = fir.emboxproc %[[VAL_2]] : (() -> ()) -> !fir.boxproc<() -> ()>
+! CHECK: %[[VAL_5:.*]] = fir.undefined tuple<!fir.boxproc<() -> ()>, i64>
+! CHECK: %[[VAL_6:.*]] = fir.insert_value %[[VAL_5]], %[[VAL_4]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>, !fir.boxproc<() -> ()>) -> tuple<!fir.boxproc<() -> ()>, i64>
+! CHECK: %[[VAL_7:.*]] = fir.insert_value %[[VAL_6]], %[[VAL_3]], [1 : index] : (tuple<!fir.boxproc<() -> ()>, i64>, i64) -> tuple<!fir.boxproc<() -> ()>, i64>
+! CHECK: %[[VAL_8:.*]] = fir.extract_value %[[VAL_7]], [0 : index] : (tuple<!fir.boxproc<() -> ()>, i64>) -> !fir.boxproc<() -> ()>
+! CHECK: %[[VAL_9:.*]] = fir.is_present %[[VAL_8]] : (!fir.boxproc<() -> ()>) -> i1
+
+end module
More information about the flang-commits
mailing list