diff --git a/flang/include/flang/Optimizer/Builder/HLFIRTools.h b/flang/include/flang/Optimizer/Builder/HLFIRTools.h --- a/flang/include/flang/Optimizer/Builder/HLFIRTools.h +++ b/flang/include/flang/Optimizer/Builder/HLFIRTools.h @@ -198,6 +198,11 @@ 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 --- a/flang/include/flang/Optimizer/Builder/Runtime/Allocatable.h +++ b/flang/include/flang/Optimizer/Builder/Runtime/Allocatable.h @@ -29,5 +29,13 @@ 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 --- a/flang/lib/Optimizer/Builder/Runtime/Allocatable.cpp +++ b/flang/lib/Optimizer/Builder/Runtime/Allocatable.cpp @@ -40,3 +40,17 @@ return builder.create(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(loc, + builder)}; + mlir::FunctionType fTy = func.getFunctionType(); + mlir::Value rankVal = + builder.createIntegerConstant(loc, fTy.getInput(2), rank); + llvm::SmallVector args{ + fir::runtime::createArguments(builder, loc, fTy, desc, mold, rankVal)}; + builder.create(loc, func, args); +} diff --git a/flang/lib/Optimizer/HLFIR/IR/HLFIROps.cpp b/flang/lib/Optimizer/HLFIR/IR/HLFIROps.cpp --- a/flang/lib/Optimizer/HLFIR/IR/HLFIROps.cpp +++ b/flang/lib/Optimizer/HLFIR/IR/HLFIROps.cpp @@ -981,9 +981,16 @@ 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(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 @@ 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()) { typeShape.append(seqType.getShape().begin(), seqType.getShape().end()); @@ -1017,7 +1025,7 @@ } 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 --- 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 std::pair createTempFromMold(mlir::Location loc, fir::FirOpBuilder &builder, hlfir::Entity mold) { - if (mold.isPolymorphic()) - TODO(loc, "creating polymorphic temporary"); llvm::SmallVector 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(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 @@ /*shape=*/std::nullopt, lenParams); isHeapAlloc = builder.createBool(loc, false); } - auto declareOp = builder.create( - loc, alloc, tmpName, shape, lenParams, fir::FortranVariableFlagsAttr{}); + auto declareOp = builder.create(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 @@ // Otherwise, create a copy in a new buffer. hlfir::Entity source = hlfir::Entity{adaptor.getVar()}; auto [temp, cleanup] = createTempFromMold(loc, builder, source); - builder.create(loc, source, temp, /*realloc=*/false, + builder.create(loc, source, temp, temp.isAllocatable(), /*keep_lhs_length_if_realloc=*/false, /*temporary_lhs=*/true); mlir::Value bufferizedExpr = @@ -414,24 +447,32 @@ // // !fir.box>> value must be // propagated as the box address !fir.ref>. + auto adjustVar = [&](mlir::Value sourceVar, mlir::Type assocType) { + if (mlir::isa(sourceVar.getType()) && + mlir::isa( + fir::unwrapRefType(sourceVar.getType()))) { + // Association of a polymorphic value. + sourceVar = builder.create(loc, sourceVar); + assert(mlir::isa(sourceVar.getType()) && + fir::isAllocatableType(sourceVar.getType())); + assert(sourceVar.getType() == assocType); + } else if ((sourceVar.getType().isa() && + !assocType.isa()) || + ((sourceVar.getType().isa() && + !assocType.isa()))) { + sourceVar = builder.create(loc, assocType, sourceVar); + } else { + sourceVar = builder.createConvert(loc, assocType, sourceVar); + } + return sourceVar; + }; + mlir::Type associateHlfirVarType = associate.getResultTypes()[0]; - if (hlfirVar.getType().isa() && - !associateHlfirVarType.isa()) - hlfirVar = builder.create(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() && - !associateFirVarType.isa()) || - (firVar.getType().isa() && - !associateFirVarType.isa())) - firVar = - builder.create(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 @@ // use that hlfir::Entity source = hlfir::Entity{adaptor.getSource()}; auto [temp, cleanup] = createTempFromMold(loc, builder, source); - builder.create(loc, source, temp, /*reassoc=*/false, + builder.create(loc, source, temp, temp.isAllocatable(), /*keep_lhs_length_if_realloc=*/false, /*temporary_lhs=*/true); mlir::Value bufferTuple = @@ -483,10 +524,22 @@ // fir::FreeMemOp operand type must be a fir::HeapType. mlir::Type heapType = fir::HeapType::get( hlfir::getFortranElementOrSequenceType(var.getType())); - if (var.getType().isa()) + if (mlir::isa(var.getType()) && + mlir::isa(fir::unwrapRefType(var.getType()))) { + // A temporary for a polymorphic expression is represented + // via an allocatable. Variable type in this case + // is !fir.ref>>>. + // We need to free the allocatable data, not the box + // that is allocated on the stack. + var = builder.create(loc, var); + assert(mlir::isa(var.getType()) && + fir::isAllocatableType(var.getType())); + var = builder.create(loc, heapType, var); + } else if (var.getType().isa()) { var = builder.create(loc, heapType, var); - else if (!var.getType().isa()) + } else if (!var.getType().isa()) { var = builder.create(loc, heapType, var); + } builder.create(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 --- /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>> {bindc_name = "r", uniq_name = "_QFtestEr"} + %8:2 = hlfir.declare %5 {fortran_attrs = #fir.var_attrs, uniq_name = "_QFtestEr"} : (!fir.ref>>>) -> (!fir.ref>>>, !fir.ref>>>) + %26 = fir.undefined !fir.class>> + %27:2 = hlfir.declare %26 {uniq_name = ".tmp.intrinsic_result"} : (!fir.class>>) -> (!fir.class>>, !fir.class>>) + %28 = hlfir.as_expr %27#0 : (!fir.class>>) -> !hlfir.expr?> + hlfir.assign %28 to %8#0 realloc : !hlfir.expr?>, !fir.ref>>> + hlfir.destroy %28 : !hlfir.expr?> + return +} +// CHECK-LABEL: func.func @test_poly_expr_without_associate() { +// CHECK: %[[VAL_0:.*]] = fir.alloca !fir.class>> +// CHECK: %[[VAL_1:.*]] = fir.alloca !fir.class>> {bindc_name = "r", uniq_name = "_QFtestEr"} +// CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_1]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFtestEr"} : (!fir.ref>>>) -> (!fir.ref>>>, !fir.ref>>>) +// CHECK: %[[VAL_3:.*]] = fir.undefined !fir.class>> +// CHECK: %[[VAL_4:.*]]:2 = hlfir.declare %[[VAL_3]] {uniq_name = ".tmp.intrinsic_result"} : (!fir.class>>) -> (!fir.class>>, !fir.class>>) +// CHECK: %[[VAL_5:.*]] = fir.zero_bits !fir.heap> +// CHECK: %[[VAL_6:.*]] = fir.embox %[[VAL_5]] : (!fir.heap>) -> !fir.class>> +// CHECK: fir.store %[[VAL_6]] to %[[VAL_0]] : !fir.ref>>> +// CHECK: %[[VAL_7:.*]] = arith.constant true +// CHECK: %[[VAL_8:.*]]:2 = hlfir.declare %[[VAL_0]] {fortran_attrs = #fir.var_attrs, uniq_name = ".tmp"} : (!fir.ref>>>) -> (!fir.ref>>>, !fir.ref>>>) +// CHECK: %[[VAL_9:.*]] = arith.constant 0 : i32 +// CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_0]] : (!fir.ref>>>) -> !fir.ref> +// CHECK: %[[VAL_11:.*]] = fir.convert %[[VAL_4]]#1 : (!fir.class>>) -> !fir.box +// CHECK: %[[VAL_12:.*]] = fir.call @_FortranAAllocatableApplyMold(%[[VAL_10]], %[[VAL_11]], %[[VAL_9]]) : (!fir.ref>, !fir.box, i32) -> none +// CHECK: hlfir.assign %[[VAL_4]]#0 to %[[VAL_8]]#0 realloc temporary_lhs : !fir.class>>, !fir.ref>>> +// CHECK: %[[VAL_13:.*]] = fir.undefined tuple>>>, i1> +// CHECK: %[[VAL_14:.*]] = fir.insert_value %[[VAL_13]], %[[VAL_7]], [1 : index] : (tuple>>>, i1>, i1) -> tuple>>>, i1> +// CHECK: %[[VAL_15:.*]] = fir.insert_value %[[VAL_14]], %[[VAL_8]]#0, [0 : index] : (tuple>>>, i1>, !fir.ref>>>) -> tuple>>>, i1> +// CHECK: hlfir.assign %[[VAL_8]]#0 to %[[VAL_2]]#0 realloc : !fir.ref>>>, !fir.ref>>> +// CHECK: %[[VAL_16:.*]] = fir.load %[[VAL_8]]#1 : !fir.ref>>> +// CHECK: %[[VAL_17:.*]] = fir.box_addr %[[VAL_16]] : (!fir.class>>) -> !fir.heap> +// CHECK: fir.freemem %[[VAL_17]] : !fir.heap> +// CHECK: return +// CHECK: } + +func.func @test_poly_expr_with_associate(%arg1: !fir.class>> {fir.bindc_name = "v2"}) { + %0 = fir.alloca !fir.class>>> {bindc_name = ".result"} + %2:2 = hlfir.declare %arg1 {uniq_name = "_QFtestEv2"} : (!fir.class>>) -> (!fir.class>>, !fir.class>>) + %4:2 = hlfir.declare %0 {uniq_name = ".tmp.func_result"} : (!fir.ref>>>>) -> (!fir.ref>>>>, !fir.ref>>>>) + %5 = fir.load %4#0 : !fir.ref>>>> + %6 = hlfir.as_expr %5 : (!fir.class>>>) -> !hlfir.expr?> + %c0 = arith.constant 0 : index + %7:3 = fir.box_dims %5, %c0 : (!fir.class>>>, 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?>, !fir.shape<1>) -> (!fir.class>>>, !fir.class>>>, i1) + %10 = fir.convert %0 : (!fir.ref>>>>) -> !fir.box + %11 = fir.call @_FortranADestroy(%10) fastmath : (!fir.box) -> 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>>, index) -> !fir.class> + %14 = hlfir.designate %9#0 (%arg2) : (!fir.class>>>, index) -> !fir.class> + fir.dispatch "assign"(%13 : !fir.class>) (%13, %14 : !fir.class>, !fir.class>) {pass_arg_pos = 0 : i32} + } + hlfir.end_associate %9#1, %9#2 : !fir.class>>>, i1 + return +} +// CHECK-LABEL: func.func @test_poly_expr_with_associate( +// CHECK-SAME: %[[VAL_0:.*]]: !fir.class>> {fir.bindc_name = "v2"}) { +// CHECK: %[[VAL_1:.*]] = fir.alloca !fir.class>>> +// CHECK: %[[VAL_2:.*]] = fir.alloca !fir.class>>> {bindc_name = ".result"} +// CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = "_QFtestEv2"} : (!fir.class>>) -> (!fir.class>>, !fir.class>>) +// CHECK: %[[VAL_4:.*]]:2 = hlfir.declare %[[VAL_2]] {uniq_name = ".tmp.func_result"} : (!fir.ref>>>>) -> (!fir.ref>>>>, !fir.ref>>>>) +// CHECK: %[[VAL_5:.*]] = fir.load %[[VAL_4]]#0 : !fir.ref>>>> +// CHECK: %[[VAL_6:.*]] = arith.constant 0 : index +// CHECK: %[[VAL_7:.*]]:3 = fir.box_dims %[[VAL_5]], %[[VAL_6]] : (!fir.class>>>, index) -> (index, index, index) +// CHECK: %[[VAL_8:.*]] = fir.shape %[[VAL_7]]#1 : (index) -> !fir.shape<1> +// CHECK: %[[VAL_9:.*]] = fir.zero_bits !fir.heap>> +// 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.shape<1>) -> !fir.class>>> +// CHECK: fir.store %[[VAL_12]] to %[[VAL_1]] : !fir.ref>>>> +// CHECK: %[[VAL_13:.*]] = arith.constant true +// CHECK: %[[VAL_14:.*]]:2 = hlfir.declare %[[VAL_1]] {fortran_attrs = #fir.var_attrs, uniq_name = ".tmp"} : (!fir.ref>>>>) -> (!fir.ref>>>>, !fir.ref>>>>) +// CHECK: %[[VAL_15:.*]] = arith.constant 1 : i32 +// CHECK: %[[VAL_16:.*]] = fir.convert %[[VAL_1]] : (!fir.ref>>>>) -> !fir.ref> +// CHECK: %[[VAL_17:.*]] = fir.convert %[[VAL_5]] : (!fir.class>>>) -> !fir.box +// CHECK: %[[VAL_18:.*]] = fir.call @_FortranAAllocatableApplyMold(%[[VAL_16]], %[[VAL_17]], %[[VAL_15]]) : (!fir.ref>, !fir.box, i32) -> none +// CHECK: hlfir.assign %[[VAL_5]] to %[[VAL_14]]#0 realloc temporary_lhs : !fir.class>>>, !fir.ref>>>> +// CHECK: %[[VAL_19:.*]] = fir.undefined tuple>>>>, i1> +// CHECK: %[[VAL_20:.*]] = fir.insert_value %[[VAL_19]], %[[VAL_13]], [1 : index] : (tuple>>>>, i1>, i1) -> tuple>>>>, i1> +// CHECK: %[[VAL_21:.*]] = fir.insert_value %[[VAL_20]], %[[VAL_14]]#0, [0 : index] : (tuple>>>>, i1>, !fir.ref>>>>) -> tuple>>>>, i1> +// CHECK: %[[VAL_22:.*]] = arith.constant 0 : index +// CHECK: %[[VAL_23:.*]]:3 = fir.box_dims %[[VAL_5]], %[[VAL_22]] : (!fir.class>>>, 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>>>> +// CHECK: %[[VAL_26:.*]] = fir.load %[[VAL_14]]#1 : !fir.ref>>>> +// CHECK: %[[VAL_27:.*]] = fir.convert %[[VAL_2]] : (!fir.ref>>>>) -> !fir.box +// CHECK: %[[VAL_28:.*]] = fir.call @_FortranADestroy(%[[VAL_27]]) fastmath : (!fir.box) -> 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>>, index) -> !fir.class> +// CHECK: %[[VAL_34:.*]] = hlfir.designate %[[VAL_25]] (%[[VAL_32]]) : (!fir.class>>>, index) -> !fir.class> +// CHECK: fir.dispatch "assign"(%[[VAL_33]] : !fir.class>) (%[[VAL_33]], %[[VAL_34]] : !fir.class>, !fir.class>) {pass_arg_pos = 0 : i32} +// CHECK: } +// CHECK: %[[VAL_35:.*]] = fir.box_addr %[[VAL_26]] : (!fir.class>>>) -> !fir.heap>> +// CHECK: fir.freemem %[[VAL_35]] : !fir.heap>> +// 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 --- /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.shift<1>) -> (!fir.class>>>, !fir.class>>>) +! CHECK: %[[VAL_22:.*]] = arith.constant true +! CHECK: %[[VAL_23:.*]] = hlfir.as_expr %[[VAL_21]]#0 move %[[VAL_22]] : (!fir.class>>>, i1) -> !hlfir.expr?> +! CHECK: %[[VAL_24:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_25:.*]]:3 = fir.box_dims %[[VAL_21]]#0, %[[VAL_24]] : (!fir.class>>>, 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?>, !fir.shape<1>) -> (!fir.class>>>, !fir.class>>>, i1) +! CHECK: %[[VAL_28:.*]] = fir.rebox %[[VAL_27]]#0 : (!fir.class>>>) -> !fir.class>> +! CHECK: fir.call @_QPcallee(%[[VAL_28]]) fastmath : (!fir.class>>) -> () +! CHECK: hlfir.end_associate %[[VAL_27]]#1, %[[VAL_27]]#2 : !fir.class>>>, i1 +! CHECK: hlfir.destroy %[[VAL_23]] : !hlfir.expr?>