Index: flang/include/flang/Optimizer/HLFIR/HLFIROps.td =================================================================== --- flang/include/flang/Optimizer/HLFIR/HLFIROps.td +++ flang/include/flang/Optimizer/HLFIR/HLFIROps.td @@ -144,9 +144,13 @@ generated temporary. In this case the temporary is initialized if needed (e.g. the LHS is of derived type with allocatable/pointer components), and the assignment is done without LHS (or its subobjects) finalization - and with automatic allocation. Since LHS is uninitialized in this case, - "keep_lhs_length_if_realloc" attribute does not make sense. "realloc" - attribute is allowed with "temporary_lhs", though, it is implied. + and with automatic allocation. + If "temporary_lhs" and "keep_lhs_length_if_realloc" are both set, + this assign operation denotes special case of character allocatable + LHS with explicit length. The LHS that must preserve its length + during the assignment regardless of the the RHS's length or/and + allocation status. This assign operation will be lowered into a call + to AssignExplicitLengthCharacter(). }]; let arguments = (ins AnyFortranEntity:$rhs, Index: flang/lib/Lower/ConvertExprToHLFIR.cpp =================================================================== --- flang/lib/Lower/ConvertExprToHLFIR.cpp +++ flang/lib/Lower/ConvertExprToHLFIR.cpp @@ -1641,19 +1641,6 @@ // StructureConstructor. The initialization of the temporary entity // is done component by component with the help of HLFIR operations // ParentComponentOp, DesignateOp and AssignOp. - // - // FIXME: in general, AssignOp cannot be used for initializing - // compiler generated temporaries. The lowered AssignOp may trigger - // finalizations for the LHS, which is not expected and may be detected - // in user programs using impure final subprograms. This is a problem - // not only here, but also in HLFIR-to-FIR conversion, for example, - // when we generate AssignOp during bufferizing AsExprOp. - // We could add some flag for AssignOp that would indicate that the LHS - // is a compiler generated temporary, so that the further lowering - // may disable the finalizations. This flag may also be used to automatically - // initialize the LHS temporary (e.g. AssignTemporary() runtime already - // doing the implicit initialization), so that we can avoid explicit - // initialization for the temporaries here and at other places. hlfir::EntityWithAttributes gen(const Fortran::evaluate::StructureConstructor &ctor) { mlir::Location loc = getLoc(); @@ -1767,11 +1754,55 @@ Fortran::evaluate::UnwrapExpr(expr)) continue; - hlfir::Entity rhs = gen(expr); + // Handle special case when the initializer expression is + // '{%SET_LENGTH(x,const_kind)}'. In structure constructor, + // SET_LENGTH is used for initializers of character allocatable + // components with *explicit* length, because they have to keep + // their length regardless of the initializer expression's length. + // We cannot just lower SET_LENGTH into hlfir.set_length in case + // when 'x' is allocatable: if 'x' is unallocated, it is not clear + // what hlfir.expr should be produced by hlfir.set_length. + // So whenever the initializer expression is SET_LENGTH we + // recognize it as the directive to keep the explicit length + // of the LHS component, and we completely ignore 'const_kind' + // operand assuming that it matches the LHS component's explicit + // length. Note that in case when LHS component has deferred length, + // the FE does not produce SET_LENGTH expression. + // + // When SET_LENGTH is recognized, we use 'x' as the initializer + // for the LHS component. If 'x' is allocatable, the dynamic + // isAllocated check will guard the assign operation as usual. + bool keepLhsLength = false; + hlfir::Entity rhs = std::visit( + [&](const auto &x) -> hlfir::Entity { + using T = std::decay_t; + if constexpr (Fortran::common::HasMember< + T, Fortran::lower::CategoryExpression>) { + if constexpr (T::Result::category == + Fortran::common::TypeCategory::Character) { + return std::visit( + [&](const auto &someKind) -> hlfir::Entity { + using T = std::decay_t; + if (const auto *setLength = std::get_if< + Fortran::evaluate::SetLength>( + &someKind.u)) { + keepLhsLength = true; + return gen(setLength->left()); + } + + return gen(someKind); + }, + x.u); + } + } + return gen(x); + }, + expr.u); + if (!allowRealloc || !rhs.isMutableBox()) { rhs = hlfir::loadTrivialScalar(loc, builder, rhs); builder.create(loc, rhs, lhs, allowRealloc, - /*keep_lhs_length_if_realloc=*/false, + allowRealloc ? keepLhsLength : false, /*temporary_lhs=*/true); continue; } @@ -1788,10 +1819,9 @@ builder.genIfThen(loc, isAlloc) .genThen([&]() { rhs = hlfir::loadTrivialScalar(loc, builder, rhs); - builder.create( - loc, rhs, lhs, allowRealloc, - /*keep_lhs_length_if_realloc=*/false, - /*temporary_lhs=*/true); + builder.create(loc, rhs, lhs, allowRealloc, + keepLhsLength, + /*temporary_lhs=*/true); }) .end(); } Index: flang/lib/Optimizer/HLFIR/IR/HLFIROps.cpp =================================================================== --- flang/lib/Optimizer/HLFIR/IR/HLFIROps.cpp +++ flang/lib/Optimizer/HLFIR/IR/HLFIROps.cpp @@ -47,9 +47,6 @@ hlfir::getFortranElementType(lhsType).isa())) return emitOpError("`realloc` must be set and lhs must be a character " "allocatable when `keep_lhs_length_if_realloc` is set"); - if (mustKeepLhsLengthInAllocatableAssignment() && isTemporaryLHS()) - return emitOpError("`keep_lhs_length_if_realloc` does not make sense " - "for `temporary_lhs` assignments"); return mlir::success(); } Index: flang/lib/Optimizer/HLFIR/Transforms/ConvertToFIR.cpp =================================================================== --- flang/lib/Optimizer/HLFIR/Transforms/ConvertToFIR.cpp +++ flang/lib/Optimizer/HLFIR/Transforms/ConvertToFIR.cpp @@ -120,6 +120,11 @@ // Indicate the runtime that it should not reallocate in case of length // mismatch, and that it should use the LHS explicit/assumed length if // allocating/reallocation the LHS. + // Note that AssignExplicitLengthCharacter() must be used + // when isTemporaryLHS() is true here: the LHS is known to be + // character allocatable in this case, so finalization will not + // happen (as implied by temporary_lhs attribute), and LHS + // must keep its length (as implied by keep_lhs_length_if_realloc). fir::runtime::genAssignExplicitLengthCharacter(builder, loc, to, from); } else if (assignOp.isTemporaryLHS()) { // Use AssignTemporary, when the LHS is a compiler generated temporary. Index: flang/test/HLFIR/invalid.fir =================================================================== --- flang/test/HLFIR/invalid.fir +++ flang/test/HLFIR/invalid.fir @@ -644,13 +644,6 @@ return } -// ----- -func.func @bad_assign_3(%arg0: !fir.ref>>>>, %arg1: !fir.box>>) { - // expected-error@+1 {{'hlfir.assign' op `keep_lhs_length_if_realloc` does not make sense for `temporary_lhs` assignments}} - hlfir.assign %arg1 to %arg0 realloc keep_lhs_len temporary_lhs : !fir.box>>, !fir.ref>>>> - return -} - // ----- func.func @bad_parent_comp1(%arg0: !fir.box>>) { // expected-error@+1 {{'hlfir.parent_comp' op must be provided a shape if and only if the base is an array}} Index: flang/test/Lower/HLFIR/structure-constructor.f90 =================================================================== --- flang/test/Lower/HLFIR/structure-constructor.f90 +++ flang/test/Lower/HLFIR/structure-constructor.f90 @@ -24,6 +24,9 @@ integer :: c1 real, allocatable :: c2(:) end type t7 + type t8 + character(11), allocatable :: c + end type t8 end module types subroutine test1(x) @@ -50,9 +53,7 @@ ! CHECK: %[[VAL_14:.*]] = fir.call @_FortranAInitialize(%[[VAL_12]], %[[VAL_13]], %[[VAL_11]]) fastmath : (!fir.box, !fir.ref, i32) -> none ! CHECK: %[[VAL_15:.*]] = arith.constant 4 : index ! CHECK: %[[VAL_16:.*]] = hlfir.designate %[[VAL_8]]#0{"c"} typeparams %[[VAL_15]] : (!fir.ref}>>, index) -> !fir.ref> -! CHECK: %[[VAL_17:.*]] = arith.constant 4 : i64 -! CHECK: %[[VAL_18:.*]] = hlfir.set_length %[[VAL_7]]#0 len %[[VAL_17]] : (!fir.ref>, i64) -> !hlfir.expr> -! CHECK: hlfir.assign %[[VAL_18]] to %[[VAL_16]] temporary_lhs : !hlfir.expr>, !fir.ref> +! CHECK: hlfir.assign %[[VAL_7]]#0 to %[[VAL_16]] temporary_lhs : !fir.ref>, !fir.ref> ! CHECK: hlfir.assign %[[VAL_8]]#0 to %[[VAL_3]]#0 : !fir.ref}>>, !fir.ref}>> ! CHECK: return ! CHECK: } @@ -150,28 +151,20 @@ ! CHECK: %[[VAL_18:.*]] = fir.call @_FortranAInitialize(%[[VAL_16]], %[[VAL_17]], %[[VAL_15]]) fastmath : (!fir.box, !fir.ref, i32) -> none ! CHECK: %[[VAL_19:.*]] = arith.constant 2 : index ! CHECK: %[[VAL_20:.*]] = hlfir.designate %[[VAL_12]]#0{"c"} typeparams %[[VAL_19]] {fortran_attrs = #fir.var_attrs} : (!fir.ref>>>}>>, index) -> !fir.ref>>>> -! CHECK: %[[VAL_21:.*]] = fir.load %[[VAL_11]]#0 : !fir.ref>>>> -! CHECK: %[[VAL_22:.*]] = arith.constant 2 : i64 -! CHECK: %[[VAL_23:.*]] = arith.constant 0 : index -! CHECK: %[[VAL_24:.*]]:3 = fir.box_dims %[[VAL_21]], %[[VAL_23]] : (!fir.box>>>, index) -> (index, index, index) -! CHECK: %[[VAL_25:.*]] = fir.shape %[[VAL_24]]#1 : (index) -> !fir.shape<1> -! CHECK: %[[VAL_26:.*]] = hlfir.elemental %[[VAL_25]] typeparams %[[VAL_22]] unordered : (!fir.shape<1>, i64) -> !hlfir.expr> { -! CHECK: ^bb0(%[[VAL_27:.*]]: index): -! CHECK: %[[VAL_28:.*]] = arith.constant 0 : index -! CHECK: %[[VAL_29:.*]]:3 = fir.box_dims %[[VAL_21]], %[[VAL_28]] : (!fir.box>>>, index) -> (index, index, index) -! CHECK: %[[VAL_30:.*]] = arith.constant 1 : index -! CHECK: %[[VAL_31:.*]] = arith.subi %[[VAL_29]]#0, %[[VAL_30]] : index -! CHECK: %[[VAL_32:.*]] = arith.addi %[[VAL_27]], %[[VAL_31]] : index -! CHECK: %[[VAL_33:.*]] = hlfir.designate %[[VAL_21]] (%[[VAL_32]]) typeparams %[[VAL_10]] : (!fir.box>>>, index, index) -> !fir.ref> -! CHECK: %[[VAL_34:.*]] = hlfir.set_length %[[VAL_33]] len %[[VAL_22]] : (!fir.ref>, i64) -> !hlfir.expr> -! CHECK: hlfir.yield_element %[[VAL_34]] : !hlfir.expr> +! CHECK: %[[VAL_21:.*]] = fir.load %[[VAL_11]]#1 : !fir.ref>>>> +! CHECK: %[[VAL_22:.*]] = fir.box_addr %[[VAL_21]] : (!fir.box>>>) -> !fir.heap>> +! CHECK: %[[VAL_23:.*]] = fir.convert %[[VAL_22]] : (!fir.heap>>) -> i64 +! CHECK: %[[VAL_24:.*]] = arith.constant 0 : i64 +! CHECK: %[[VAL_25:.*]] = arith.cmpi ne, %[[VAL_23]], %[[VAL_24]] : i64 +! CHECK: fir.if %[[VAL_25]] { +! CHECK: %[[VAL_26:.*]] = fir.load %[[VAL_11]]#0 : !fir.ref>>>> +! CHECK: hlfir.assign %[[VAL_26]] to %[[VAL_20]] realloc keep_lhs_len temporary_lhs : !fir.box>>>, !fir.ref>>>> ! CHECK: } -! CHECK: hlfir.assign %[[VAL_35:.*]] to %[[VAL_20]] realloc temporary_lhs : !hlfir.expr>, !fir.ref>>>> ! CHECK: hlfir.assign %[[VAL_12]]#0 to %[[VAL_3]]#0 : !fir.ref>>>}>>, !fir.ref>>>}>> -! CHECK: hlfir.destroy %[[VAL_35]] : !hlfir.expr> ! CHECK: return ! CHECK: } + subroutine test5(x) use types type(t4), allocatable :: x(:) @@ -291,16 +284,14 @@ ! CHECK: %[[VAL_64:.*]] = fir.call @_FortranAInitialize(%[[VAL_62]], %[[VAL_63]], %[[VAL_61]]) fastmath : (!fir.box, !fir.ref, i32) -> none ! CHECK: %[[VAL_65:.*]] = arith.constant 4 : index ! CHECK: %[[VAL_66:.*]] = hlfir.designate %[[VAL_58]]#0{"c"} typeparams %[[VAL_65]] : (!fir.ref}>>, index) -> !fir.ref> -! CHECK: %[[VAL_67:.*]] = arith.constant 4 : i64 -! CHECK: %[[VAL_68:.*]] = hlfir.set_length %[[VAL_10]]#0 len %[[VAL_67]] : (!fir.ref>, i64) -> !hlfir.expr> -! CHECK: hlfir.assign %[[VAL_68]] to %[[VAL_66]] temporary_lhs : !hlfir.expr>, !fir.ref> -! CHECK: %[[VAL_69:.*]] = fir.convert %[[VAL_58]]#1 : (!fir.ref}>>) -> !fir.llvm_ptr -! CHECK: %[[VAL_70:.*]] = fir.call @_FortranAPushArrayConstructorSimpleScalar(%[[VAL_51]], %[[VAL_69]]) fastmath : (!fir.llvm_ptr, !fir.llvm_ptr) -> none -! CHECK: %[[VAL_71:.*]] = arith.constant true -! CHECK: %[[VAL_72:.*]] = hlfir.as_expr %[[VAL_48]]#0 move %[[VAL_71]] : (!fir.heap}>>>, i1) -> !hlfir.expr<1x!fir.type<_QMtypesTt1{c:!fir.char<1,4>}>> -! CHECK: hlfir.assign %[[VAL_72]] to %[[VAL_44]] temporary_lhs : !hlfir.expr<1x!fir.type<_QMtypesTt1{c:!fir.char<1,4>}>>, !fir.ref}>>> +! CHECK: hlfir.assign %[[VAL_10]]#0 to %[[VAL_66]] temporary_lhs : !fir.ref>, !fir.ref> +! CHECK: %[[VAL_67:.*]] = fir.convert %[[VAL_58]]#1 : (!fir.ref}>>) -> !fir.llvm_ptr +! CHECK: %[[VAL_68:.*]] = fir.call @_FortranAPushArrayConstructorSimpleScalar(%[[VAL_51]], %[[VAL_67]]) fastmath : (!fir.llvm_ptr, !fir.llvm_ptr) -> none +! CHECK: %[[VAL_69:.*]] = arith.constant true +! CHECK: %[[VAL_70:.*]] = hlfir.as_expr %[[VAL_48]]#0 move %[[VAL_69]] : (!fir.heap}>>>, i1) -> !hlfir.expr<1x!fir.type<_QMtypesTt1{c:!fir.char<1,4>}>> +! CHECK: hlfir.assign %[[VAL_70]] to %[[VAL_44]] temporary_lhs : !hlfir.expr<1x!fir.type<_QMtypesTt1{c:!fir.char<1,4>}>>, !fir.ref}>>> ! CHECK: hlfir.assign %[[VAL_20]]#0 to %[[VAL_12]]#0 : !fir.ref>>>}>>>>,t6m:!fir.array<1x!fir.type<_QMtypesTt1{c:!fir.char<1,4>}>>}>>, !fir.ref>>>}>>>>,t6m:!fir.array<1x!fir.type<_QMtypesTt1{c:!fir.char<1,4>}>>}>> -! CHECK: hlfir.destroy %[[VAL_72]] : !hlfir.expr<1x!fir.type<_QMtypesTt1{c:!fir.char<1,4>}>> +! CHECK: hlfir.destroy %[[VAL_70]] : !hlfir.expr<1x!fir.type<_QMtypesTt1{c:!fir.char<1,4>}>> ! CHECK: return ! CHECK: } @@ -340,3 +331,120 @@ ! CHECK: hlfir.assign %[[VAL_11]]#0 to %[[VAL_4]]#0 : !fir.ref>>}>>, !fir.ref>>}>> ! CHECK: return ! CHECK: } + +! Test character allocatable component initialization +! from character allocatable of different size. +subroutine test8 + use types + character(12), allocatable :: x + type(t8) res + res = t8(x) +end subroutine test8 +! CHECK-LABEL: func.func @_QPtest8() { +! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.type<_QMtypesTt8{c:!fir.box>>}> +! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.type<_QMtypesTt8{c:!fir.box>>}> {bindc_name = "res", uniq_name = "_QFtest8Eres"} +! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_1]] {uniq_name = "_QFtest8Eres"} : (!fir.ref>>}>>) -> (!fir.ref>>}>>, !fir.ref>>}>>) +! CHECK: %[[VAL_3:.*]] = fir.embox %[[VAL_2]]#1 : (!fir.ref>>}>>) -> !fir.box>>}>> +! CHECK: %[[VAL_4:.*]] = fir.address_of(@_QQcl.{{.*}}) : !fir.ref> +! CHECK: %[[VAL_5:.*]] = arith.constant {{[0-9]*}} : i32 +! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_3]] : (!fir.box>>}>>) -> !fir.box +! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_4]] : (!fir.ref>) -> !fir.ref +! CHECK: %[[VAL_8:.*]] = fir.call @_FortranAInitialize(%[[VAL_6]], %[[VAL_7]], %[[VAL_5]]) fastmath : (!fir.box, !fir.ref, i32) -> none +! CHECK: %[[VAL_9:.*]] = fir.alloca !fir.box>> {bindc_name = "x", uniq_name = "_QFtest8Ex"} +! CHECK: %[[VAL_10:.*]] = arith.constant 12 : index +! CHECK: %[[VAL_11:.*]] = fir.zero_bits !fir.heap> +! CHECK: %[[VAL_12:.*]] = fir.embox %[[VAL_11]] : (!fir.heap>) -> !fir.box>> +! CHECK: fir.store %[[VAL_12]] to %[[VAL_9]] : !fir.ref>>> +! CHECK: %[[VAL_13:.*]]:2 = hlfir.declare %[[VAL_9]] typeparams %[[VAL_10]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFtest8Ex"} : (!fir.ref>>>, index) -> (!fir.ref>>>, !fir.ref>>>) +! CHECK: %[[VAL_14:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = "ctor.temp"} : (!fir.ref>>}>>) -> (!fir.ref>>}>>, !fir.ref>>}>>) +! CHECK: %[[VAL_15:.*]] = fir.embox %[[VAL_14]]#0 : (!fir.ref>>}>>) -> !fir.box>>}>> +! CHECK: %[[VAL_16:.*]] = fir.address_of(@_QQcl.{{.*}}) : !fir.ref> +! CHECK: %[[VAL_17:.*]] = arith.constant {{[0-9]*}} : i32 +! CHECK: %[[VAL_18:.*]] = fir.convert %[[VAL_15]] : (!fir.box>>}>>) -> !fir.box +! CHECK: %[[VAL_19:.*]] = fir.convert %[[VAL_16]] : (!fir.ref>) -> !fir.ref +! CHECK: %[[VAL_20:.*]] = fir.call @_FortranAInitialize(%[[VAL_18]], %[[VAL_19]], %[[VAL_17]]) fastmath : (!fir.box, !fir.ref, i32) -> none +! CHECK: %[[VAL_21:.*]] = arith.constant 11 : index +! CHECK: %[[VAL_22:.*]] = hlfir.designate %[[VAL_14]]#0{"c"} typeparams %[[VAL_21]] {fortran_attrs = #fir.var_attrs} : (!fir.ref>>}>>, index) -> !fir.ref>>> +! CHECK: %[[VAL_23:.*]] = fir.load %[[VAL_13]]#1 : !fir.ref>>> +! CHECK: %[[VAL_24:.*]] = fir.box_addr %[[VAL_23]] : (!fir.box>>) -> !fir.heap> +! CHECK: %[[VAL_25:.*]] = fir.convert %[[VAL_24]] : (!fir.heap>) -> i64 +! CHECK: %[[VAL_26:.*]] = arith.constant 0 : i64 +! CHECK: %[[VAL_27:.*]] = arith.cmpi ne, %[[VAL_25]], %[[VAL_26]] : i64 +! CHECK: fir.if %[[VAL_27]] { +! CHECK: %[[VAL_28:.*]] = fir.load %[[VAL_13]]#0 : !fir.ref>>> +! CHECK: %[[VAL_29:.*]] = fir.box_addr %[[VAL_28]] : (!fir.box>>) -> !fir.heap> +! CHECK: hlfir.assign %[[VAL_29]] to %[[VAL_22]] realloc keep_lhs_len temporary_lhs : !fir.heap>, !fir.ref>>> +! CHECK: } +! CHECK: hlfir.assign %[[VAL_14]]#0 to %[[VAL_2]]#0 : !fir.ref>>}>>, !fir.ref>>}>> +! CHECK: return +! CHECK: } + +! Test character allocatable component initialization +! from character non-allocatable of different size. +subroutine test9 + use types + character(12) :: x + type(t8) res + res = t8(x) +end subroutine test9 +! CHECK-LABEL: func.func @_QPtest9() { +! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.type<_QMtypesTt8{c:!fir.box>>}> +! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.type<_QMtypesTt8{c:!fir.box>>}> {bindc_name = "res", uniq_name = "_QFtest9Eres"} +! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_1]] {uniq_name = "_QFtest9Eres"} : (!fir.ref>>}>>) -> (!fir.ref>>}>>, !fir.ref>>}>>) +! CHECK: %[[VAL_3:.*]] = fir.embox %[[VAL_2]]#1 : (!fir.ref>>}>>) -> !fir.box>>}>> +! CHECK: %[[VAL_4:.*]] = fir.address_of(@_QQcl.{{.*}}) : !fir.ref> +! CHECK: %[[VAL_5:.*]] = arith.constant {{[0-9]*}} : i32 +! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_3]] : (!fir.box>>}>>) -> !fir.box +! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_4]] : (!fir.ref>) -> !fir.ref +! CHECK: %[[VAL_8:.*]] = fir.call @_FortranAInitialize(%[[VAL_6]], %[[VAL_7]], %[[VAL_5]]) fastmath : (!fir.box, !fir.ref, i32) -> none +! CHECK: %[[VAL_9:.*]] = arith.constant 12 : index +! CHECK: %[[VAL_10:.*]] = fir.alloca !fir.char<1,12> {bindc_name = "x", uniq_name = "_QFtest9Ex"} +! CHECK: %[[VAL_11:.*]]:2 = hlfir.declare %[[VAL_10]] typeparams %[[VAL_9]] {uniq_name = "_QFtest9Ex"} : (!fir.ref>, index) -> (!fir.ref>, !fir.ref>) +! CHECK: %[[VAL_12:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = "ctor.temp"} : (!fir.ref>>}>>) -> (!fir.ref>>}>>, !fir.ref>>}>>) +! CHECK: %[[VAL_13:.*]] = fir.embox %[[VAL_12]]#0 : (!fir.ref>>}>>) -> !fir.box>>}>> +! CHECK: %[[VAL_14:.*]] = fir.address_of(@_QQcl.{{.*}}) : !fir.ref> +! CHECK: %[[VAL_15:.*]] = arith.constant {{[0-9]*}} : i32 +! CHECK: %[[VAL_16:.*]] = fir.convert %[[VAL_13]] : (!fir.box>>}>>) -> !fir.box +! CHECK: %[[VAL_17:.*]] = fir.convert %[[VAL_14]] : (!fir.ref>) -> !fir.ref +! CHECK: %[[VAL_18:.*]] = fir.call @_FortranAInitialize(%[[VAL_16]], %[[VAL_17]], %[[VAL_15]]) fastmath : (!fir.box, !fir.ref, i32) -> none +! CHECK: %[[VAL_19:.*]] = arith.constant 11 : index +! CHECK: %[[VAL_20:.*]] = hlfir.designate %[[VAL_12]]#0{"c"} typeparams %[[VAL_19]] {fortran_attrs = #fir.var_attrs} : (!fir.ref>>}>>, index) -> !fir.ref>>> +! CHECK: hlfir.assign %[[VAL_11]]#0 to %[[VAL_20]] realloc keep_lhs_len temporary_lhs : !fir.ref>, !fir.ref>>> +! CHECK: hlfir.assign %[[VAL_12]]#0 to %[[VAL_2]]#0 : !fir.ref>>}>>, !fir.ref>>}>> +! CHECK: return +! CHECK: } + + +! Test character non-allocatable component initialization +! from character allocatable of different size. +subroutine test10 + use types + character(12), allocatable :: x + type(t1) res + res = t1(x) +end subroutine test10 +! CHECK-LABEL: func.func @_QPtest10() { +! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.type<_QMtypesTt1{c:!fir.char<1,4>}> +! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.type<_QMtypesTt1{c:!fir.char<1,4>}> {bindc_name = "res", uniq_name = "_QFtest10Eres"} +! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_1]] {uniq_name = "_QFtest10Eres"} : (!fir.ref}>>) -> (!fir.ref}>>, !fir.ref}>>) +! CHECK: %[[VAL_3:.*]] = fir.alloca !fir.box>> {bindc_name = "x", uniq_name = "_QFtest10Ex"} +! CHECK: %[[VAL_4:.*]] = arith.constant 12 : index +! CHECK: %[[VAL_5:.*]] = fir.zero_bits !fir.heap> +! CHECK: %[[VAL_6:.*]] = fir.embox %[[VAL_5]] : (!fir.heap>) -> !fir.box>> +! CHECK: fir.store %[[VAL_6]] to %[[VAL_3]] : !fir.ref>>> +! CHECK: %[[VAL_7:.*]]:2 = hlfir.declare %[[VAL_3]] typeparams %[[VAL_4]] {fortran_attrs = #fir.var_attrs, uniq_name = "_QFtest10Ex"} : (!fir.ref>>>, index) -> (!fir.ref>>>, !fir.ref>>>) +! CHECK: %[[VAL_8:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = "ctor.temp"} : (!fir.ref}>>) -> (!fir.ref}>>, !fir.ref}>>) +! CHECK: %[[VAL_9:.*]] = fir.embox %[[VAL_8]]#0 : (!fir.ref}>>) -> !fir.box}>> +! CHECK: %[[VAL_10:.*]] = fir.address_of(@_QQcl.{{.*}}) : !fir.ref> +! CHECK: %[[VAL_11:.*]] = arith.constant {{[0-9]*}} : i32 +! CHECK: %[[VAL_12:.*]] = fir.convert %[[VAL_9]] : (!fir.box}>>) -> !fir.box +! CHECK: %[[VAL_13:.*]] = fir.convert %[[VAL_10]] : (!fir.ref>) -> !fir.ref +! CHECK: %[[VAL_14:.*]] = fir.call @_FortranAInitialize(%[[VAL_12]], %[[VAL_13]], %[[VAL_11]]) fastmath : (!fir.box, !fir.ref, i32) -> none +! CHECK: %[[VAL_15:.*]] = arith.constant 4 : index +! CHECK: %[[VAL_16:.*]] = hlfir.designate %[[VAL_8]]#0{"c"} typeparams %[[VAL_15]] : (!fir.ref}>>, index) -> !fir.ref> +! CHECK: %[[VAL_17:.*]] = fir.load %[[VAL_7]]#0 : !fir.ref>>> +! CHECK: %[[VAL_18:.*]] = fir.box_addr %[[VAL_17]] : (!fir.box>>) -> !fir.heap> +! CHECK: hlfir.assign %[[VAL_18]] to %[[VAL_16]] temporary_lhs : !fir.heap>, !fir.ref> +! CHECK: hlfir.assign %[[VAL_8]]#0 to %[[VAL_2]]#0 : !fir.ref}>>, !fir.ref}>> +! CHECK: return +! CHECK: }