[flang-commits] [flang] daa8734 - [flang][hlfir] Support polymorphic hlfir.expr values.
Slava Zakharin via flang-commits
flang-commits at lists.llvm.org
Tue Jul 18 09:00:43 PDT 2023
Author: Slava Zakharin
Date: 2023-07-18T09:00:26-07:00
New Revision: daa8734233e781efe3ee92c5b6687f409c1fa7b2
URL: https://github.com/llvm/llvm-project/commit/daa8734233e781efe3ee92c5b6687f409c1fa7b2
DIFF: https://github.com/llvm/llvm-project/commit/daa8734233e781efe3ee92c5b6687f409c1fa7b2.diff
LOG: [flang][hlfir] Support polymorphic hlfir.expr values.
This patch sets 'polymorphic' attribute of hlfir::ExprType when
the value is created from a polymorphic entity.
Memoization of such ExprType involves creating a mutable descriptor
on the stack, which is initialized (as a null box) and passed to
AllocatableApplyMold with the mold being the entity from which
the ExprType value is being created.
This patch fixes "creating polymorphic temporary" TODO and also
several cases of "'fir.convert' op invalid type conversion" error.
Reviewed By: tblah
Differential Revision: https://reviews.llvm.org/D155541
Added:
flang/test/HLFIR/bufferize-poly-expr.fir
flang/test/Lower/HLFIR/polymorphic-expressions.f90
Modified:
flang/include/flang/Optimizer/Builder/HLFIRTools.h
flang/include/flang/Optimizer/Builder/Runtime/Allocatable.h
flang/lib/Optimizer/Builder/Runtime/Allocatable.cpp
flang/lib/Optimizer/HLFIR/IR/HLFIROps.cpp
flang/lib/Optimizer/HLFIR/Transforms/BufferizeHLFIR.cpp
Removed:
################################################################################
diff --git a/flang/include/flang/Optimizer/Builder/HLFIRTools.h b/flang/include/flang/Optimizer/Builder/HLFIRTools.h
index 88819cdec2e77c..9d631dba9412cf 100644
--- a/flang/include/flang/Optimizer/Builder/HLFIRTools.h
+++ b/flang/include/flang/Optimizer/Builder/HLFIRTools.h
@@ -198,6 +198,11 @@ class Entity : public mlir::Value {
return varIface ? varIface.isParameter() : false;
}
+ bool isAllocatable() const {
+ auto varIface = getIfVariableInterface();
+ return varIface ? varIface.isAllocatable() : false;
+ }
+
// Get the entity as an mlir SSA value containing all the shape, type
// parameters and dynamic shape information.
mlir::Value getBase() const { return *this; }
diff --git a/flang/include/flang/Optimizer/Builder/Runtime/Allocatable.h b/flang/include/flang/Optimizer/Builder/Runtime/Allocatable.h
index 0013afee9fd0f5..dc3858f3d319f5 100644
--- a/flang/include/flang/Optimizer/Builder/Runtime/Allocatable.h
+++ b/flang/include/flang/Optimizer/Builder/Runtime/Allocatable.h
@@ -29,5 +29,13 @@ mlir::Value genMoveAlloc(fir::FirOpBuilder &builder, mlir::Location loc,
mlir::Value to, mlir::Value from, mlir::Value hasStat,
mlir::Value errMsg);
+/// Generate runtime call to apply bounds, cobounds, length type
+/// parameters and derived type information from \p mold descriptor
+/// to \p desc descriptor. The resulting rank of \p desc descriptor
+/// is set to \p rank. The resulting descriptor must be initialized
+/// and deallocated before the call.
+void genAllocatableApplyMold(fir::FirOpBuilder &builder, mlir::Location loc,
+ mlir::Value desc, mlir::Value mold, int rank);
+
} // namespace fir::runtime
#endif // FORTRAN_OPTIMIZER_BUILDER_RUNTIME_ALLOCATABLE_H
diff --git a/flang/lib/Optimizer/Builder/Runtime/Allocatable.cpp b/flang/lib/Optimizer/Builder/Runtime/Allocatable.cpp
index c05d66230f4015..2a5bdee546a787 100644
--- a/flang/lib/Optimizer/Builder/Runtime/Allocatable.cpp
+++ b/flang/lib/Optimizer/Builder/Runtime/Allocatable.cpp
@@ -40,3 +40,17 @@ mlir::Value fir::runtime::genMoveAlloc(fir::FirOpBuilder &builder,
return builder.create<fir::CallOp>(loc, func, args).getResult(0);
}
+
+void fir::runtime::genAllocatableApplyMold(fir::FirOpBuilder &builder,
+ mlir::Location loc, mlir::Value desc,
+ mlir::Value mold, int rank) {
+ mlir::func::FuncOp func{
+ fir::runtime::getRuntimeFunc<mkRTKey(AllocatableApplyMold)>(loc,
+ builder)};
+ mlir::FunctionType fTy = func.getFunctionType();
+ mlir::Value rankVal =
+ builder.createIntegerConstant(loc, fTy.getInput(2), rank);
+ llvm::SmallVector<mlir::Value> args{
+ fir::runtime::createArguments(builder, loc, fTy, desc, mold, rankVal)};
+ builder.create<fir::CallOp>(loc, func, args);
+}
diff --git a/flang/lib/Optimizer/HLFIR/IR/HLFIROps.cpp b/flang/lib/Optimizer/HLFIR/IR/HLFIROps.cpp
index 37a1d9acd3d9d4..a74d6f94f4df14 100644
--- a/flang/lib/Optimizer/HLFIR/IR/HLFIROps.cpp
+++ b/flang/lib/Optimizer/HLFIR/IR/HLFIROps.cpp
@@ -981,9 +981,16 @@ void hlfir::AssociateOp::build(mlir::OpBuilder &builder,
mlir::ValueRange typeparams,
fir::FortranVariableFlagsAttr fortran_attrs) {
auto nameAttr = builder.getStringAttr(uniq_name);
- // TODO: preserve polymorphism of polymorphic expr.
- mlir::Type firVarType = fir::ReferenceType::get(
- getFortranElementOrSequenceType(source.getType()));
+ mlir::Type dataType = getFortranElementOrSequenceType(source.getType());
+
+ // Preserve polymorphism of polymorphic expr.
+ mlir::Type firVarType;
+ auto sourceExprType = mlir::dyn_cast<hlfir::ExprType>(source.getType());
+ if (sourceExprType && sourceExprType.isPolymorphic())
+ firVarType = fir::ClassType::get(fir::HeapType::get(dataType));
+ else
+ firVarType = fir::ReferenceType::get(dataType);
+
mlir::Type hlfirVariableType =
DeclareOp::getHLFIRVariableType(firVarType, /*hasExplicitLbs=*/false);
mlir::Type i1Type = builder.getI1Type();
@@ -1010,6 +1017,7 @@ void hlfir::AsExprOp::build(mlir::OpBuilder &builder,
mlir::OperationState &result, mlir::Value var,
mlir::Value mustFree) {
hlfir::ExprType::Shape typeShape;
+ bool isPolymorphic = fir::isPolymorphicType(var.getType());
mlir::Type type = getFortranElementOrSequenceType(var.getType());
if (auto seqType = type.dyn_cast<fir::SequenceType>()) {
typeShape.append(seqType.getShape().begin(), seqType.getShape().end());
@@ -1017,7 +1025,7 @@ void hlfir::AsExprOp::build(mlir::OpBuilder &builder,
}
auto resultType = hlfir::ExprType::get(builder.getContext(), typeShape, type,
- /*isPolymorphic: TODO*/ false);
+ isPolymorphic);
return build(builder, result, resultType, var, mustFree);
}
diff --git a/flang/lib/Optimizer/HLFIR/Transforms/BufferizeHLFIR.cpp b/flang/lib/Optimizer/HLFIR/Transforms/BufferizeHLFIR.cpp
index 53117e0d654afe..86fa2f4acb297f 100644
--- a/flang/lib/Optimizer/HLFIR/Transforms/BufferizeHLFIR.cpp
+++ b/flang/lib/Optimizer/HLFIR/Transforms/BufferizeHLFIR.cpp
@@ -15,7 +15,8 @@
#include "flang/Optimizer/Builder/Character.h"
#include "flang/Optimizer/Builder/FIRBuilder.h"
#include "flang/Optimizer/Builder/HLFIRTools.h"
-#include "flang/Optimizer/Builder/Runtime/Assign.h"
+#include "flang/Optimizer/Builder/MutableBox.h"
+#include "flang/Optimizer/Builder/Runtime/Allocatable.h"
#include "flang/Optimizer/Builder/Todo.h"
#include "flang/Optimizer/Dialect/FIRDialect.h"
#include "flang/Optimizer/Dialect/FIROps.h"
@@ -101,15 +102,38 @@ static mlir::Value getBufferizedExprMustFreeFlag(mlir::Value bufferizedExpr) {
static std::pair<hlfir::Entity, mlir::Value>
createTempFromMold(mlir::Location loc, fir::FirOpBuilder &builder,
hlfir::Entity mold) {
- if (mold.isPolymorphic())
- TODO(loc, "creating polymorphic temporary");
llvm::SmallVector<mlir::Value> lenParams;
hlfir::genLengthParameters(loc, builder, mold, lenParams);
llvm::StringRef tmpName{".tmp"};
mlir::Value alloc;
mlir::Value isHeapAlloc;
mlir::Value shape{};
- if (mold.isArray()) {
+ fir::FortranVariableFlagsAttr declAttrs;
+
+ if (mold.isPolymorphic()) {
+ // Create unallocated polymorphic temporary using the dynamic type
+ // of the mold. The static type of the temporary matches
+ // the static type of the mold, but then the dynamic type
+ // of the mold is applied to the temporary's descriptor.
+
+ if (mold.isArray())
+ hlfir::genShape(loc, builder, mold);
+
+ // Create polymorphic allocatable box on the stack.
+ mlir::Type boxHeapType = fir::HeapType::get(fir::unwrapRefType(
+ mlir::cast<fir::BaseBoxType>(mold.getType()).getEleTy()));
+ // The box must be initialized, because AllocatableApplyMold
+ // may read its contents (e.g. for checking whether it is allocated).
+ alloc = fir::factory::genNullBoxStorage(builder, loc,
+ fir::ClassType::get(boxHeapType));
+ // The temporary is unallocated even after AllocatableApplyMold below.
+ // If the temporary is used as assignment LHS it will be automatically
+ // allocated on the heap, as long as we use Assign family
+ // runtime functions. So set MustFree to true.
+ isHeapAlloc = builder.createBool(loc, true);
+ declAttrs = fir::FortranVariableFlagsAttr::get(
+ builder.getContext(), fir::FortranVariableFlagsEnum::allocatable);
+ } else if (mold.isArray()) {
mlir::Type sequenceType =
hlfir::getFortranElementOrSequenceType(mold.getType());
shape = hlfir::genShape(loc, builder, mold);
@@ -122,8 +146,17 @@ createTempFromMold(mlir::Location loc, fir::FirOpBuilder &builder,
/*shape=*/std::nullopt, lenParams);
isHeapAlloc = builder.createBool(loc, false);
}
- auto declareOp = builder.create<hlfir::DeclareOp>(
- loc, alloc, tmpName, shape, lenParams, fir::FortranVariableFlagsAttr{});
+ auto declareOp = builder.create<hlfir::DeclareOp>(loc, alloc, tmpName, shape,
+ lenParams, declAttrs);
+ if (mold.isPolymorphic()) {
+ int rank = mold.getRank();
+ // TODO: should probably read rank from the mold.
+ if (rank < 0)
+ TODO(loc, "create temporary for assumed rank polymorphic");
+ fir::runtime::genAllocatableApplyMold(builder, loc, alloc,
+ mold.getFirBase(), rank);
+ }
+
return {hlfir::Entity{declareOp.getBase()}, isHeapAlloc};
}
@@ -162,7 +195,7 @@ struct AsExprOpConversion : public mlir::OpConversionPattern<hlfir::AsExprOp> {
// Otherwise, create a copy in a new buffer.
hlfir::Entity source = hlfir::Entity{adaptor.getVar()};
auto [temp, cleanup] = createTempFromMold(loc, builder, source);
- builder.create<hlfir::AssignOp>(loc, source, temp, /*realloc=*/false,
+ builder.create<hlfir::AssignOp>(loc, source, temp, temp.isAllocatable(),
/*keep_lhs_length_if_realloc=*/false,
/*temporary_lhs=*/true);
mlir::Value bufferizedExpr =
@@ -414,24 +447,32 @@ struct AssociateOpConversion
//
// !fir.box<!fir.heap<!fir.type<_T{y:i32}>>> value must be
// propagated as the box address !fir.ref<!fir.type<_T{y:i32}>>.
+ auto adjustVar = [&](mlir::Value sourceVar, mlir::Type assocType) {
+ if (mlir::isa<fir::ReferenceType>(sourceVar.getType()) &&
+ mlir::isa<fir::ClassType>(
+ fir::unwrapRefType(sourceVar.getType()))) {
+ // Association of a polymorphic value.
+ sourceVar = builder.create<fir::LoadOp>(loc, sourceVar);
+ assert(mlir::isa<fir::ClassType>(sourceVar.getType()) &&
+ fir::isAllocatableType(sourceVar.getType()));
+ assert(sourceVar.getType() == assocType);
+ } else if ((sourceVar.getType().isa<fir::BaseBoxType>() &&
+ !assocType.isa<fir::BaseBoxType>()) ||
+ ((sourceVar.getType().isa<fir::BoxCharType>() &&
+ !assocType.isa<fir::BoxCharType>()))) {
+ sourceVar = builder.create<fir::BoxAddrOp>(loc, assocType, sourceVar);
+ } else {
+ sourceVar = builder.createConvert(loc, assocType, sourceVar);
+ }
+ return sourceVar;
+ };
+
mlir::Type associateHlfirVarType = associate.getResultTypes()[0];
- if (hlfirVar.getType().isa<fir::BaseBoxType>() &&
- !associateHlfirVarType.isa<fir::BaseBoxType>())
- hlfirVar = builder.create<fir::BoxAddrOp>(loc, associateHlfirVarType,
- hlfirVar);
- else
- hlfirVar = builder.createConvert(loc, associateHlfirVarType, hlfirVar);
+ hlfirVar = adjustVar(hlfirVar, associateHlfirVarType);
associate.getResult(0).replaceAllUsesWith(hlfirVar);
mlir::Type associateFirVarType = associate.getResultTypes()[1];
- if ((firVar.getType().isa<fir::BaseBoxType>() &&
- !associateFirVarType.isa<fir::BaseBoxType>()) ||
- (firVar.getType().isa<fir::BoxCharType>() &&
- !associateFirVarType.isa<fir::BoxCharType>()))
- firVar =
- builder.create<fir::BoxAddrOp>(loc, associateFirVarType, firVar);
- else
- firVar = builder.createConvert(loc, associateFirVarType, firVar);
+ firVar = adjustVar(firVar, associateFirVarType);
associate.getResult(1).replaceAllUsesWith(firVar);
associate.getResult(2).replaceAllUsesWith(flag);
rewriter.replaceOp(associate, {hlfirVar, firVar, flag});
@@ -465,7 +506,7 @@ struct AssociateOpConversion
// use that
hlfir::Entity source = hlfir::Entity{adaptor.getSource()};
auto [temp, cleanup] = createTempFromMold(loc, builder, source);
- builder.create<hlfir::AssignOp>(loc, source, temp, /*reassoc=*/false,
+ builder.create<hlfir::AssignOp>(loc, source, temp, temp.isAllocatable(),
/*keep_lhs_length_if_realloc=*/false,
/*temporary_lhs=*/true);
mlir::Value bufferTuple =
@@ -483,10 +524,22 @@ static void genFreeIfMustFree(mlir::Location loc, fir::FirOpBuilder &builder,
// fir::FreeMemOp operand type must be a fir::HeapType.
mlir::Type heapType = fir::HeapType::get(
hlfir::getFortranElementOrSequenceType(var.getType()));
- if (var.getType().isa<fir::BaseBoxType, fir::BoxCharType>())
+ if (mlir::isa<fir::ReferenceType>(var.getType()) &&
+ mlir::isa<fir::ClassType>(fir::unwrapRefType(var.getType()))) {
+ // A temporary for a polymorphic expression is represented
+ // via an allocatable. Variable type in this case
+ // is !fir.ref<!fir.class<!fir.heap<!fir.type<>>>>.
+ // We need to free the allocatable data, not the box
+ // that is allocated on the stack.
+ var = builder.create<fir::LoadOp>(loc, var);
+ assert(mlir::isa<fir::ClassType>(var.getType()) &&
+ fir::isAllocatableType(var.getType()));
+ var = builder.create<fir::BoxAddrOp>(loc, heapType, var);
+ } else if (var.getType().isa<fir::BaseBoxType, fir::BoxCharType>()) {
var = builder.create<fir::BoxAddrOp>(loc, heapType, var);
- else if (!var.getType().isa<fir::HeapType>())
+ } else if (!var.getType().isa<fir::HeapType>()) {
var = builder.create<fir::ConvertOp>(loc, heapType, var);
+ }
builder.create<fir::FreeMemOp>(loc, var);
};
if (auto cstMustFree = fir::getIntIfConstant(mustFree)) {
diff --git a/flang/test/HLFIR/bufferize-poly-expr.fir b/flang/test/HLFIR/bufferize-poly-expr.fir
new file mode 100644
index 00000000000000..31987643d1b767
--- /dev/null
+++ b/flang/test/HLFIR/bufferize-poly-expr.fir
@@ -0,0 +1,105 @@
+// RUN: fir-opt --bufferize-hlfir %s | FileCheck %s
+
+func.func @test_poly_expr_without_associate() {
+ %5 = fir.alloca !fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>> {bindc_name = "r", uniq_name = "_QFtestEr"}
+ %8:2 = hlfir.declare %5 {fortran_attrs = #fir.var_attrs<allocatable>, uniq_name = "_QFtestEr"} : (!fir.ref<!fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>>) -> (!fir.ref<!fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>>, !fir.ref<!fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>>)
+ %26 = fir.undefined !fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>
+ %27:2 = hlfir.declare %26 {uniq_name = ".tmp.intrinsic_result"} : (!fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>) -> (!fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>, !fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>)
+ %28 = hlfir.as_expr %27#0 : (!fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>) -> !hlfir.expr<!fir.type<_QFtestTt{c:i32}>?>
+ hlfir.assign %28 to %8#0 realloc : !hlfir.expr<!fir.type<_QFtestTt{c:i32}>?>, !fir.ref<!fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>>
+ hlfir.destroy %28 : !hlfir.expr<!fir.type<_QFtestTt{c:i32}>?>
+ return
+}
+// CHECK-LABEL: func.func @test_poly_expr_without_associate() {
+// CHECK: %[[VAL_0:.*]] = fir.alloca !fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>
+// CHECK: %[[VAL_1:.*]] = fir.alloca !fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>> {bindc_name = "r", uniq_name = "_QFtestEr"}
+// CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_1]] {fortran_attrs = #fir.var_attrs<allocatable>, uniq_name = "_QFtestEr"} : (!fir.ref<!fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>>) -> (!fir.ref<!fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>>, !fir.ref<!fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>>)
+// CHECK: %[[VAL_3:.*]] = fir.undefined !fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>
+// CHECK: %[[VAL_4:.*]]:2 = hlfir.declare %[[VAL_3]] {uniq_name = ".tmp.intrinsic_result"} : (!fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>) -> (!fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>, !fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>)
+// CHECK: %[[VAL_5:.*]] = fir.zero_bits !fir.heap<!fir.type<_QFtestTt{c:i32}>>
+// CHECK: %[[VAL_6:.*]] = fir.embox %[[VAL_5]] : (!fir.heap<!fir.type<_QFtestTt{c:i32}>>) -> !fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>
+// CHECK: fir.store %[[VAL_6]] to %[[VAL_0]] : !fir.ref<!fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>>
+// CHECK: %[[VAL_7:.*]] = arith.constant true
+// CHECK: %[[VAL_8:.*]]:2 = hlfir.declare %[[VAL_0]] {fortran_attrs = #fir.var_attrs<allocatable>, uniq_name = ".tmp"} : (!fir.ref<!fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>>) -> (!fir.ref<!fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>>, !fir.ref<!fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>>)
+// CHECK: %[[VAL_9:.*]] = arith.constant 0 : i32
+// CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_0]] : (!fir.ref<!fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>>) -> !fir.ref<!fir.box<none>>
+// CHECK: %[[VAL_11:.*]] = fir.convert %[[VAL_4]]#1 : (!fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>) -> !fir.box<none>
+// CHECK: %[[VAL_12:.*]] = fir.call @_FortranAAllocatableApplyMold(%[[VAL_10]], %[[VAL_11]], %[[VAL_9]]) : (!fir.ref<!fir.box<none>>, !fir.box<none>, i32) -> none
+// CHECK: hlfir.assign %[[VAL_4]]#0 to %[[VAL_8]]#0 realloc temporary_lhs : !fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>, !fir.ref<!fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>>
+// CHECK: %[[VAL_13:.*]] = fir.undefined tuple<!fir.ref<!fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>>, i1>
+// CHECK: %[[VAL_14:.*]] = fir.insert_value %[[VAL_13]], %[[VAL_7]], [1 : index] : (tuple<!fir.ref<!fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>>, i1>, i1) -> tuple<!fir.ref<!fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>>, i1>
+// CHECK: %[[VAL_15:.*]] = fir.insert_value %[[VAL_14]], %[[VAL_8]]#0, [0 : index] : (tuple<!fir.ref<!fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>>, i1>, !fir.ref<!fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>>) -> tuple<!fir.ref<!fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>>, i1>
+// CHECK: hlfir.assign %[[VAL_8]]#0 to %[[VAL_2]]#0 realloc : !fir.ref<!fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>>, !fir.ref<!fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>>
+// CHECK: %[[VAL_16:.*]] = fir.load %[[VAL_8]]#1 : !fir.ref<!fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>>
+// CHECK: %[[VAL_17:.*]] = fir.box_addr %[[VAL_16]] : (!fir.class<!fir.heap<!fir.type<_QFtestTt{c:i32}>>>) -> !fir.heap<!fir.type<_QFtestTt{c:i32}>>
+// CHECK: fir.freemem %[[VAL_17]] : !fir.heap<!fir.type<_QFtestTt{c:i32}>>
+// CHECK: return
+// CHECK: }
+
+func.func @test_poly_expr_with_associate(%arg1: !fir.class<!fir.array<3x!fir.type<_QMtest_typeTt1{i:i32}>>> {fir.bindc_name = "v2"}) {
+ %0 = fir.alloca !fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>> {bindc_name = ".result"}
+ %2:2 = hlfir.declare %arg1 {uniq_name = "_QFtestEv2"} : (!fir.class<!fir.array<3x!fir.type<_QMtest_typeTt1{i:i32}>>>) -> (!fir.class<!fir.array<3x!fir.type<_QMtest_typeTt1{i:i32}>>>, !fir.class<!fir.array<3x!fir.type<_QMtest_typeTt1{i:i32}>>>)
+ %4:2 = hlfir.declare %0 {uniq_name = ".tmp.func_result"} : (!fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>>) -> (!fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>>, !fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>>)
+ %5 = fir.load %4#0 : !fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>>
+ %6 = hlfir.as_expr %5 : (!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>) -> !hlfir.expr<?x!fir.type<_QMtest_typeTt1{i:i32}>?>
+ %c0 = arith.constant 0 : index
+ %7:3 = fir.box_dims %5, %c0 : (!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>, index) -> (index, index, index)
+ %8 = fir.shape %7#1 : (index) -> !fir.shape<1>
+ %9:3 = hlfir.associate %6(%8) {uniq_name = ".tmp.assign"} : (!hlfir.expr<?x!fir.type<_QMtest_typeTt1{i:i32}>?>, !fir.shape<1>) -> (!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>, !fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>, i1)
+ %10 = fir.convert %0 : (!fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>>) -> !fir.box<none>
+ %11 = fir.call @_FortranADestroy(%10) fastmath<contract> : (!fir.box<none>) -> none
+ %c3 = arith.constant 3 : index
+ %12 = fir.shape %c3 : (index) -> !fir.shape<1>
+ %c1 = arith.constant 1 : index
+ fir.do_loop %arg2 = %c1 to %c3 step %c1 {
+ %13 = hlfir.designate %2#0 (%arg2) : (!fir.class<!fir.array<3x!fir.type<_QMtest_typeTt1{i:i32}>>>, index) -> !fir.class<!fir.type<_QMtest_typeTt1{i:i32}>>
+ %14 = hlfir.designate %9#0 (%arg2) : (!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>, index) -> !fir.class<!fir.type<_QMtest_typeTt1{i:i32}>>
+ fir.dispatch "assign"(%13 : !fir.class<!fir.type<_QMtest_typeTt1{i:i32}>>) (%13, %14 : !fir.class<!fir.type<_QMtest_typeTt1{i:i32}>>, !fir.class<!fir.type<_QMtest_typeTt1{i:i32}>>) {pass_arg_pos = 0 : i32}
+ }
+ hlfir.end_associate %9#1, %9#2 : !fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>, i1
+ return
+}
+// CHECK-LABEL: func.func @test_poly_expr_with_associate(
+// CHECK-SAME: %[[VAL_0:.*]]: !fir.class<!fir.array<3x!fir.type<_QMtest_typeTt1{i:i32}>>> {fir.bindc_name = "v2"}) {
+// CHECK: %[[VAL_1:.*]] = fir.alloca !fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>
+// CHECK: %[[VAL_2:.*]] = fir.alloca !fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>> {bindc_name = ".result"}
+// CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = "_QFtestEv2"} : (!fir.class<!fir.array<3x!fir.type<_QMtest_typeTt1{i:i32}>>>) -> (!fir.class<!fir.array<3x!fir.type<_QMtest_typeTt1{i:i32}>>>, !fir.class<!fir.array<3x!fir.type<_QMtest_typeTt1{i:i32}>>>)
+// CHECK: %[[VAL_4:.*]]:2 = hlfir.declare %[[VAL_2]] {uniq_name = ".tmp.func_result"} : (!fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>>) -> (!fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>>, !fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>>)
+// CHECK: %[[VAL_5:.*]] = fir.load %[[VAL_4]]#0 : !fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>>
+// CHECK: %[[VAL_6:.*]] = arith.constant 0 : index
+// CHECK: %[[VAL_7:.*]]:3 = fir.box_dims %[[VAL_5]], %[[VAL_6]] : (!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>, index) -> (index, index, index)
+// CHECK: %[[VAL_8:.*]] = fir.shape %[[VAL_7]]#1 : (index) -> !fir.shape<1>
+// CHECK: %[[VAL_9:.*]] = fir.zero_bits !fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>
+// CHECK: %[[VAL_10:.*]] = arith.constant 0 : index
+// CHECK: %[[VAL_11:.*]] = fir.shape %[[VAL_10]] : (index) -> !fir.shape<1>
+// CHECK: %[[VAL_12:.*]] = fir.embox %[[VAL_9]](%[[VAL_11]]) : (!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>, !fir.shape<1>) -> !fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>
+// CHECK: fir.store %[[VAL_12]] to %[[VAL_1]] : !fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>>
+// CHECK: %[[VAL_13:.*]] = arith.constant true
+// CHECK: %[[VAL_14:.*]]:2 = hlfir.declare %[[VAL_1]] {fortran_attrs = #fir.var_attrs<allocatable>, uniq_name = ".tmp"} : (!fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>>) -> (!fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>>, !fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>>)
+// CHECK: %[[VAL_15:.*]] = arith.constant 1 : i32
+// CHECK: %[[VAL_16:.*]] = fir.convert %[[VAL_1]] : (!fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>>) -> !fir.ref<!fir.box<none>>
+// CHECK: %[[VAL_17:.*]] = fir.convert %[[VAL_5]] : (!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>) -> !fir.box<none>
+// CHECK: %[[VAL_18:.*]] = fir.call @_FortranAAllocatableApplyMold(%[[VAL_16]], %[[VAL_17]], %[[VAL_15]]) : (!fir.ref<!fir.box<none>>, !fir.box<none>, i32) -> none
+// CHECK: hlfir.assign %[[VAL_5]] to %[[VAL_14]]#0 realloc temporary_lhs : !fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>, !fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>>
+// CHECK: %[[VAL_19:.*]] = fir.undefined tuple<!fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>>, i1>
+// CHECK: %[[VAL_20:.*]] = fir.insert_value %[[VAL_19]], %[[VAL_13]], [1 : index] : (tuple<!fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>>, i1>, i1) -> tuple<!fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>>, i1>
+// CHECK: %[[VAL_21:.*]] = fir.insert_value %[[VAL_20]], %[[VAL_14]]#0, [0 : index] : (tuple<!fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>>, i1>, !fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>>) -> tuple<!fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>>, i1>
+// CHECK: %[[VAL_22:.*]] = arith.constant 0 : index
+// CHECK: %[[VAL_23:.*]]:3 = fir.box_dims %[[VAL_5]], %[[VAL_22]] : (!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>, index) -> (index, index, index)
+// CHECK: %[[VAL_24:.*]] = fir.shape %[[VAL_23]]#1 : (index) -> !fir.shape<1>
+// CHECK: %[[VAL_25:.*]] = fir.load %[[VAL_14]]#0 : !fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>>
+// CHECK: %[[VAL_26:.*]] = fir.load %[[VAL_14]]#1 : !fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>>
+// CHECK: %[[VAL_27:.*]] = fir.convert %[[VAL_2]] : (!fir.ref<!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>>) -> !fir.box<none>
+// CHECK: %[[VAL_28:.*]] = fir.call @_FortranADestroy(%[[VAL_27]]) fastmath<contract> : (!fir.box<none>) -> none
+// CHECK: %[[VAL_29:.*]] = arith.constant 3 : index
+// CHECK: %[[VAL_30:.*]] = fir.shape %[[VAL_29]] : (index) -> !fir.shape<1>
+// CHECK: %[[VAL_31:.*]] = arith.constant 1 : index
+// CHECK: fir.do_loop %[[VAL_32:.*]] = %[[VAL_31]] to %[[VAL_29]] step %[[VAL_31]] {
+// CHECK: %[[VAL_33:.*]] = hlfir.designate %[[VAL_3]]#0 (%[[VAL_32]]) : (!fir.class<!fir.array<3x!fir.type<_QMtest_typeTt1{i:i32}>>>, index) -> !fir.class<!fir.type<_QMtest_typeTt1{i:i32}>>
+// CHECK: %[[VAL_34:.*]] = hlfir.designate %[[VAL_25]] (%[[VAL_32]]) : (!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>, index) -> !fir.class<!fir.type<_QMtest_typeTt1{i:i32}>>
+// CHECK: fir.dispatch "assign"(%[[VAL_33]] : !fir.class<!fir.type<_QMtest_typeTt1{i:i32}>>) (%[[VAL_33]], %[[VAL_34]] : !fir.class<!fir.type<_QMtest_typeTt1{i:i32}>>, !fir.class<!fir.type<_QMtest_typeTt1{i:i32}>>) {pass_arg_pos = 0 : i32}
+// CHECK: }
+// CHECK: %[[VAL_35:.*]] = fir.box_addr %[[VAL_26]] : (!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>>) -> !fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>
+// CHECK: fir.freemem %[[VAL_35]] : !fir.heap<!fir.array<?x!fir.type<_QMtest_typeTt1{i:i32}>>>
+// CHECK: return
+// CHECK: }
diff --git a/flang/test/Lower/HLFIR/polymorphic-expressions.f90 b/flang/test/Lower/HLFIR/polymorphic-expressions.f90
new file mode 100644
index 00000000000000..e83378255c14f5
--- /dev/null
+++ b/flang/test/Lower/HLFIR/polymorphic-expressions.f90
@@ -0,0 +1,33 @@
+! RUN: bbc -emit-hlfir --polymorphic-type -o - %s -I nowhere | FileCheck %s
+
+module polymorphic_expressions_types
+ type t
+ integer c
+ end type t
+end module polymorphic_expressions_types
+
+! Test that proper polymorphic type used for hlfir.as_expr,
+! and that hlfir.association has polymorphic result type.
+subroutine test1(a)
+ use polymorphic_expressions_types
+ interface
+ subroutine callee(x)
+ use polymorphic_expressions_types
+ class(t) :: x(:)
+ end subroutine callee
+ end interface
+ class(t), allocatable :: a
+ call callee(spread(a, 1, 2))
+end subroutine test1
+! CHECK-LABEL: func.func @_QPtest1(
+! CHECK: %[[VAL_21:.*]]:2 = hlfir.declare %{{.*}}(%{{.*}}) {uniq_name = ".tmp.intrinsic_result"} : (!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMpolymorphic_expressions_typesTt{c:i32}>>>>, !fir.shift<1>) -> (!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMpolymorphic_expressions_typesTt{c:i32}>>>>, !fir.class<!fir.heap<!fir.array<?x!fir.type<_QMpolymorphic_expressions_typesTt{c:i32}>>>>)
+! CHECK: %[[VAL_22:.*]] = arith.constant true
+! CHECK: %[[VAL_23:.*]] = hlfir.as_expr %[[VAL_21]]#0 move %[[VAL_22]] : (!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMpolymorphic_expressions_typesTt{c:i32}>>>>, i1) -> !hlfir.expr<?x!fir.type<_QMpolymorphic_expressions_typesTt{c:i32}>?>
+! CHECK: %[[VAL_24:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_25:.*]]:3 = fir.box_dims %[[VAL_21]]#0, %[[VAL_24]] : (!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMpolymorphic_expressions_typesTt{c:i32}>>>>, index) -> (index, index, index)
+! CHECK: %[[VAL_26:.*]] = fir.shape %[[VAL_25]]#1 : (index) -> !fir.shape<1>
+! CHECK: %[[VAL_27:.*]]:3 = hlfir.associate %[[VAL_23]](%[[VAL_26]]) {uniq_name = "adapt.valuebyref"} : (!hlfir.expr<?x!fir.type<_QMpolymorphic_expressions_typesTt{c:i32}>?>, !fir.shape<1>) -> (!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMpolymorphic_expressions_typesTt{c:i32}>>>>, !fir.class<!fir.heap<!fir.array<?x!fir.type<_QMpolymorphic_expressions_typesTt{c:i32}>>>>, i1)
+! CHECK: %[[VAL_28:.*]] = fir.rebox %[[VAL_27]]#0 : (!fir.class<!fir.heap<!fir.array<?x!fir.type<_QMpolymorphic_expressions_typesTt{c:i32}>>>>) -> !fir.class<!fir.array<?x!fir.type<_QMpolymorphic_expressions_typesTt{c:i32}>>>
+! CHECK: fir.call @_QPcallee(%[[VAL_28]]) fastmath<contract> : (!fir.class<!fir.array<?x!fir.type<_QMpolymorphic_expressions_typesTt{c:i32}>>>) -> ()
+! CHECK: hlfir.end_associate %[[VAL_27]]#1, %[[VAL_27]]#2 : !fir.class<!fir.heap<!fir.array<?x!fir.type<_QMpolymorphic_expressions_typesTt{c:i32}>>>>, i1
+! CHECK: hlfir.destroy %[[VAL_23]] : !hlfir.expr<?x!fir.type<_QMpolymorphic_expressions_typesTt{c:i32}>?>
More information about the flang-commits
mailing list