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; }
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
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);
+}
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();
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());
}
auto resultType = hlfir::ExprType::get(builder.getContext(), typeShape, type,
- /*isPolymorphic: TODO*/ false);
+ isPolymorphic);
return build(builder, result, resultType, var, mustFree);
}
#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"
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);
/*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};
}
// 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 =
//
// !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});
// 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 =
// 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)) {
--- /dev/null
+// 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: }
--- /dev/null
+! 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}>?>
projects / platform / upstream / llvm.git / commitdiff