[flang][hlfir] Fixed character allocatable in structure constructor.

The problem appeared as a segfault for case like this:
```
type t
character(11), allocatable :: c
end type
character(12), alloctable :: x
type(t) y
y = t(x)
```

The frontend representes `y = t(x)` as `y=t(c=%SET_LENGTH(x,11_8))`.
When 'x' is unallocated the hlfir.set_length lowering results in
segfault. It could probably be handled in hlfir.set_length lowering
by using NULL base for the hlfir.declare depending on the allocation
status of 'x', but I am not sure if !hlfir.expr, in general, is supposed
to represent an expression created from unallocated allocatable.
I believe in Fortran that would mean referencing an unallocated
allocatable, which is not allowed.

I decided to special case `SET_LENGTH` in structure constructor,
so that we use its 'x' operand as the RHS for the assign operation
implying the isAllocatable check for cases when 'x' is allocatable.
This requires setting keep_lhs_length_if_realloc flag for the assign
operation. Note that when the component being intialized has
deferred length the frontend does not produce `SET_LENGTH`.

Differential Revision: https://reviews.llvm.org/D155151

diff --git a/flang/include/flang/Optimizer/HLFIR/HLFIROps.td b/flang/include/flang/Optimizer/HLFIR/HLFIROps.td
index 000d0c9229af869ab772a7f25f7a4e03ce74b244..704a745cda8da85ec957a4c961b87e87878f3407 100644 (file)
--- a/flang/include/flang/Optimizer/HLFIR/HLFIROps.td
+++ b/flang/include/flang/Optimizer/HLFIR/HLFIROps.td
@@ -144,9 +144,13 @@ def fir_AssignOp : hlfir_Op<"assign", [MemoryEffects<[MemWrite]>]> {
     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,

diff --git a/flang/lib/Lower/ConvertExprToHLFIR.cpp b/flang/lib/Lower/ConvertExprToHLFIR.cpp
index fda0ca1e35cddfac2b661927edfe14b50442bcbd..b17aa11be35e0c74563e352899afa98109400c04 100644 (file)
--- a/flang/lib/Lower/ConvertExprToHLFIR.cpp
+++ b/flang/lib/Lower/ConvertExprToHLFIR.cpp
@@ -1641,19 +1641,6 @@ private:
   // 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 @@ private:
           Fortran::evaluate::UnwrapExpr<Fortran::evaluate::NullPointer>(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<decltype(x)>;
+            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<decltype(someKind)>;
+                      if (const auto *setLength = std::get_if<
+                              Fortran::evaluate::SetLength<T::Result::kind>>(
+                              &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<hlfir::AssignOp>(loc, rhs, lhs, allowRealloc,
-                                        /*keep_lhs_length_if_realloc=*/false,
+                                        allowRealloc ? keepLhsLength : false,
                                         /*temporary_lhs=*/true);
         continue;
       }
@@ -1788,10 +1819,9 @@ private:
       builder.genIfThen(loc, isAlloc)
           .genThen([&]() {
             rhs = hlfir::loadTrivialScalar(loc, builder, rhs);
-            builder.create<hlfir::AssignOp>(
-                loc, rhs, lhs, allowRealloc,
-                /*keep_lhs_length_if_realloc=*/false,
-                /*temporary_lhs=*/true);
+            builder.create<hlfir::AssignOp>(loc, rhs, lhs, allowRealloc,
+                                            keepLhsLength,
+                                            /*temporary_lhs=*/true);
           })
           .end();
     }

diff --git a/flang/lib/Optimizer/HLFIR/IR/HLFIROps.cpp b/flang/lib/Optimizer/HLFIR/IR/HLFIROps.cpp
index 856d16c9a4d446a8fb3a3726de20843d56ddc539..51b44d7bb2f8474cf1ecb4262c1fd28eba45c786 100644 (file)
--- a/flang/lib/Optimizer/HLFIR/IR/HLFIROps.cpp
+++ b/flang/lib/Optimizer/HLFIR/IR/HLFIROps.cpp
@@ -47,9 +47,6 @@ mlir::LogicalResult hlfir::AssignOp::verify() {
         hlfir::getFortranElementType(lhsType).isa<fir::CharacterType>()))
     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();
 }
 

diff --git a/flang/lib/Optimizer/HLFIR/Transforms/ConvertToFIR.cpp b/flang/lib/Optimizer/HLFIR/Transforms/ConvertToFIR.cpp
index 15e75c3857aa3ab1200dd001f9dd1b196b93f667..e6f132cc76609f5f07bd8450c0c49b4e251bcaba 100644 (file)
--- a/flang/lib/Optimizer/HLFIR/Transforms/ConvertToFIR.cpp
+++ b/flang/lib/Optimizer/HLFIR/Transforms/ConvertToFIR.cpp
@@ -120,6 +120,11 @@ public:
         // 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.

diff --git a/flang/test/HLFIR/invalid.fir b/flang/test/HLFIR/invalid.fir
index 34d0d528c57389070a86855748ede47a08d1f5f5..bbfe543a3427eb0f23e64be6ef334cfd81184e95 100644 (file)
--- a/flang/test/HLFIR/invalid.fir
+++ b/flang/test/HLFIR/invalid.fir
@@ -644,13 +644,6 @@ func.func @bad_assign_2(%arg0: !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>,
   return
 }
 
-// -----
-func.func @bad_assign_3(%arg0: !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>>, %arg1: !fir.box<!fir.array<?x!fir.char<1,?>>>) {
-  // 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.array<?x!fir.char<1,?>>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>>
-  return
-}
-
 // -----
 func.func @bad_parent_comp1(%arg0: !fir.box<!fir.array<10x!fir.type<t2{i:i32,j:i32}>>>) {
   // expected-error@+1 {{'hlfir.parent_comp' op must be provided a shape if and only if the base is an array}}

diff --git a/flang/test/Lower/HLFIR/structure-constructor.f90 b/flang/test/Lower/HLFIR/structure-constructor.f90
index 356b8a75ac86a96e1c1d0878754c346deb6b9975..90d5922d67a67526123659feee2a6c5c1dd9211b 100644 (file)
--- a/flang/test/Lower/HLFIR/structure-constructor.f90
+++ b/flang/test/Lower/HLFIR/structure-constructor.f90
@@ -24,6 +24,9 @@ module types
      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 @@ end subroutine test1
 ! CHECK:           %[[VAL_14:.*]] = fir.call @_FortranAInitialize(%[[VAL_12]], %[[VAL_13]], %[[VAL_11]]) fastmath<contract> : (!fir.box<none>, !fir.ref<i8>, i32) -> none
 ! CHECK:           %[[VAL_15:.*]] = arith.constant 4 : index
 ! CHECK:           %[[VAL_16:.*]] = hlfir.designate %[[VAL_8]]#0{"c"}   typeparams %[[VAL_15]] : (!fir.ref<!fir.type<_QMtypesTt1{c:!fir.char<1,4>}>>, index) -> !fir.ref<!fir.char<1,4>>
-! CHECK:           %[[VAL_17:.*]] = arith.constant 4 : i64
-! CHECK:           %[[VAL_18:.*]] = hlfir.set_length %[[VAL_7]]#0 len %[[VAL_17]] : (!fir.ref<!fir.char<1,4>>, i64) -> !hlfir.expr<!fir.char<1,4>>
-! CHECK:           hlfir.assign %[[VAL_18]] to %[[VAL_16]] temporary_lhs : !hlfir.expr<!fir.char<1,4>>, !fir.ref<!fir.char<1,4>>
+! CHECK:           hlfir.assign %[[VAL_7]]#0 to %[[VAL_16]] temporary_lhs : !fir.ref<!fir.char<1,4>>, !fir.ref<!fir.char<1,4>>
 ! CHECK:           hlfir.assign %[[VAL_8]]#0 to %[[VAL_3]]#0 : !fir.ref<!fir.type<_QMtypesTt1{c:!fir.char<1,4>}>>, !fir.ref<!fir.type<_QMtypesTt1{c:!fir.char<1,4>}>>
 ! CHECK:           return
 ! CHECK:         }
@@ -150,28 +151,20 @@ end subroutine test4
 ! CHECK:           %[[VAL_18:.*]] = fir.call @_FortranAInitialize(%[[VAL_16]], %[[VAL_17]], %[[VAL_15]]) fastmath<contract> : (!fir.box<none>, !fir.ref<i8>, 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<allocatable>} : (!fir.ref<!fir.type<_QMtypesTt4{c:!fir.box<!fir.heap<!fir.array<?x!fir.char<1,2>>>>}>>, index) -> !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,2>>>>>
-! CHECK:           %[[VAL_21:.*]] = fir.load %[[VAL_11]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,2>>>>>
-! 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<!fir.heap<!fir.array<?x!fir.char<1,2>>>>, 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<?x!fir.char<1,?>> {
-! 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<!fir.heap<!fir.array<?x!fir.char<1,2>>>>, 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<!fir.heap<!fir.array<?x!fir.char<1,2>>>>, index, index) -> !fir.ref<!fir.char<1,2>>
-! CHECK:             %[[VAL_34:.*]] = hlfir.set_length %[[VAL_33]] len %[[VAL_22]] : (!fir.ref<!fir.char<1,2>>, i64) -> !hlfir.expr<!fir.char<1,2>>
-! CHECK:             hlfir.yield_element %[[VAL_34]] : !hlfir.expr<!fir.char<1,2>>
+! CHECK:           %[[VAL_21:.*]] = fir.load %[[VAL_11]]#1 : !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,2>>>>>
+! CHECK:           %[[VAL_22:.*]] = fir.box_addr %[[VAL_21]] : (!fir.box<!fir.heap<!fir.array<?x!fir.char<1,2>>>>) -> !fir.heap<!fir.array<?x!fir.char<1,2>>>
+! CHECK:           %[[VAL_23:.*]] = fir.convert %[[VAL_22]] : (!fir.heap<!fir.array<?x!fir.char<1,2>>>) -> 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<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,2>>>>>
+! CHECK:             hlfir.assign %[[VAL_26]] to %[[VAL_20]] realloc keep_lhs_len temporary_lhs : !fir.box<!fir.heap<!fir.array<?x!fir.char<1,2>>>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,2>>>>>
 ! CHECK:           }
-! CHECK:           hlfir.assign %[[VAL_35:.*]] to %[[VAL_20]] realloc temporary_lhs : !hlfir.expr<?x!fir.char<1,?>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,2>>>>>
 ! CHECK:           hlfir.assign %[[VAL_12]]#0 to %[[VAL_3]]#0 : !fir.ref<!fir.type<_QMtypesTt4{c:!fir.box<!fir.heap<!fir.array<?x!fir.char<1,2>>>>}>>, !fir.ref<!fir.type<_QMtypesTt4{c:!fir.box<!fir.heap<!fir.array<?x!fir.char<1,2>>>>}>>
-! CHECK:           hlfir.destroy %[[VAL_35]] : !hlfir.expr<?x!fir.char<1,?>>
 ! CHECK:           return
 ! CHECK:         }
 
+
 subroutine test5(x)
   use types
   type(t4), allocatable :: x(:)
@@ -291,16 +284,14 @@ end subroutine test6
 ! CHECK:           %[[VAL_64:.*]] = fir.call @_FortranAInitialize(%[[VAL_62]], %[[VAL_63]], %[[VAL_61]]) fastmath<contract> : (!fir.box<none>, !fir.ref<i8>, i32) -> none
 ! CHECK:           %[[VAL_65:.*]] = arith.constant 4 : index
 ! CHECK:           %[[VAL_66:.*]] = hlfir.designate %[[VAL_58]]#0{"c"}   typeparams %[[VAL_65]] : (!fir.ref<!fir.type<_QMtypesTt1{c:!fir.char<1,4>}>>, index) -> !fir.ref<!fir.char<1,4>>
-! CHECK:           %[[VAL_67:.*]] = arith.constant 4 : i64
-! CHECK:           %[[VAL_68:.*]] = hlfir.set_length %[[VAL_10]]#0 len %[[VAL_67]] : (!fir.ref<!fir.char<1,4>>, i64) -> !hlfir.expr<!fir.char<1,4>>
-! CHECK:           hlfir.assign %[[VAL_68]] to %[[VAL_66]] temporary_lhs : !hlfir.expr<!fir.char<1,4>>, !fir.ref<!fir.char<1,4>>
-! CHECK:           %[[VAL_69:.*]] = fir.convert %[[VAL_58]]#1 : (!fir.ref<!fir.type<_QMtypesTt1{c:!fir.char<1,4>}>>) -> !fir.llvm_ptr<i8>
-! CHECK:           %[[VAL_70:.*]] = fir.call @_FortranAPushArrayConstructorSimpleScalar(%[[VAL_51]], %[[VAL_69]]) fastmath<contract> : (!fir.llvm_ptr<i8>, !fir.llvm_ptr<i8>) -> none
-! CHECK:           %[[VAL_71:.*]] = arith.constant true
-! CHECK:           %[[VAL_72:.*]] = hlfir.as_expr %[[VAL_48]]#0 move %[[VAL_71]] : (!fir.heap<!fir.array<1x!fir.type<_QMtypesTt1{c:!fir.char<1,4>}>>>, 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<!fir.array<1x!fir.type<_QMtypesTt1{c:!fir.char<1,4>}>>>
+! CHECK:           hlfir.assign %[[VAL_10]]#0 to %[[VAL_66]] temporary_lhs : !fir.ref<!fir.char<1,4>>, !fir.ref<!fir.char<1,4>>
+! CHECK:           %[[VAL_67:.*]] = fir.convert %[[VAL_58]]#1 : (!fir.ref<!fir.type<_QMtypesTt1{c:!fir.char<1,4>}>>) -> !fir.llvm_ptr<i8>
+! CHECK:           %[[VAL_68:.*]] = fir.call @_FortranAPushArrayConstructorSimpleScalar(%[[VAL_51]], %[[VAL_67]]) fastmath<contract> : (!fir.llvm_ptr<i8>, !fir.llvm_ptr<i8>) -> none
+! CHECK:           %[[VAL_69:.*]] = arith.constant true
+! CHECK:           %[[VAL_70:.*]] = hlfir.as_expr %[[VAL_48]]#0 move %[[VAL_69]] : (!fir.heap<!fir.array<1x!fir.type<_QMtypesTt1{c:!fir.char<1,4>}>>>, 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<!fir.array<1x!fir.type<_QMtypesTt1{c:!fir.char<1,4>}>>>
 ! CHECK:           hlfir.assign %[[VAL_20]]#0 to %[[VAL_12]]#0 : !fir.ref<!fir.type<_QMtypesTt6{t5m:!fir.box<!fir.heap<!fir.array<?x!fir.type<_QMtypesTt4{c:!fir.box<!fir.heap<!fir.array<?x!fir.char<1,2>>>>}>>>>,t6m:!fir.array<1x!fir.type<_QMtypesTt1{c:!fir.char<1,4>}>>}>>, !fir.ref<!fir.type<_QMtypesTt6{t5m:!fir.box<!fir.heap<!fir.array<?x!fir.type<_QMtypesTt4{c:!fir.box<!fir.heap<!fir.array<?x!fir.char<1,2>>>>}>>>>,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 @@ end subroutine test7
 ! CHECK:           hlfir.assign %[[VAL_11]]#0 to %[[VAL_4]]#0 : !fir.ref<!fir.type<_QMtypesTt7{c1:i32,c2:!fir.box<!fir.heap<!fir.array<?xf32>>>}>>, !fir.ref<!fir.type<_QMtypesTt7{c1:i32,c2:!fir.box<!fir.heap<!fir.array<?xf32>>>}>>
 ! 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<!fir.heap<!fir.char<1,11>>>}>
+! CHECK:           %[[VAL_1:.*]] = fir.alloca !fir.type<_QMtypesTt8{c:!fir.box<!fir.heap<!fir.char<1,11>>>}> {bindc_name = "res", uniq_name = "_QFtest8Eres"}
+! CHECK:           %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_1]] {uniq_name = "_QFtest8Eres"} : (!fir.ref<!fir.type<_QMtypesTt8{c:!fir.box<!fir.heap<!fir.char<1,11>>>}>>) -> (!fir.ref<!fir.type<_QMtypesTt8{c:!fir.box<!fir.heap<!fir.char<1,11>>>}>>, !fir.ref<!fir.type<_QMtypesTt8{c:!fir.box<!fir.heap<!fir.char<1,11>>>}>>)
+! CHECK:           %[[VAL_3:.*]] = fir.embox %[[VAL_2]]#1 : (!fir.ref<!fir.type<_QMtypesTt8{c:!fir.box<!fir.heap<!fir.char<1,11>>>}>>) -> !fir.box<!fir.type<_QMtypesTt8{c:!fir.box<!fir.heap<!fir.char<1,11>>>}>>
+! CHECK:           %[[VAL_4:.*]] = fir.address_of(@_QQcl.{{.*}}) : !fir.ref<!fir.char<1,{{[0-9]*}}>>
+! CHECK:           %[[VAL_5:.*]] = arith.constant {{[0-9]*}} : i32
+! CHECK:           %[[VAL_6:.*]] = fir.convert %[[VAL_3]] : (!fir.box<!fir.type<_QMtypesTt8{c:!fir.box<!fir.heap<!fir.char<1,11>>>}>>) -> !fir.box<none>
+! CHECK:           %[[VAL_7:.*]] = fir.convert %[[VAL_4]] : (!fir.ref<!fir.char<1,{{[0-9]*}}>>) -> !fir.ref<i8>
+! CHECK:           %[[VAL_8:.*]] = fir.call @_FortranAInitialize(%[[VAL_6]], %[[VAL_7]], %[[VAL_5]]) fastmath<contract> : (!fir.box<none>, !fir.ref<i8>, i32) -> none
+! CHECK:           %[[VAL_9:.*]] = fir.alloca !fir.box<!fir.heap<!fir.char<1,12>>> {bindc_name = "x", uniq_name = "_QFtest8Ex"}
+! CHECK:           %[[VAL_10:.*]] = arith.constant 12 : index
+! CHECK:           %[[VAL_11:.*]] = fir.zero_bits !fir.heap<!fir.char<1,12>>
+! CHECK:           %[[VAL_12:.*]] = fir.embox %[[VAL_11]] : (!fir.heap<!fir.char<1,12>>) -> !fir.box<!fir.heap<!fir.char<1,12>>>
+! CHECK:           fir.store %[[VAL_12]] to %[[VAL_9]] : !fir.ref<!fir.box<!fir.heap<!fir.char<1,12>>>>
+! CHECK:           %[[VAL_13:.*]]:2 = hlfir.declare %[[VAL_9]] typeparams %[[VAL_10]] {fortran_attrs = #fir.var_attrs<allocatable>, uniq_name = "_QFtest8Ex"} : (!fir.ref<!fir.box<!fir.heap<!fir.char<1,12>>>>, index) -> (!fir.ref<!fir.box<!fir.heap<!fir.char<1,12>>>>, !fir.ref<!fir.box<!fir.heap<!fir.char<1,12>>>>)
+! CHECK:           %[[VAL_14:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = "ctor.temp"} : (!fir.ref<!fir.type<_QMtypesTt8{c:!fir.box<!fir.heap<!fir.char<1,11>>>}>>) -> (!fir.ref<!fir.type<_QMtypesTt8{c:!fir.box<!fir.heap<!fir.char<1,11>>>}>>, !fir.ref<!fir.type<_QMtypesTt8{c:!fir.box<!fir.heap<!fir.char<1,11>>>}>>)
+! CHECK:           %[[VAL_15:.*]] = fir.embox %[[VAL_14]]#0 : (!fir.ref<!fir.type<_QMtypesTt8{c:!fir.box<!fir.heap<!fir.char<1,11>>>}>>) -> !fir.box<!fir.type<_QMtypesTt8{c:!fir.box<!fir.heap<!fir.char<1,11>>>}>>
+! CHECK:           %[[VAL_16:.*]] = fir.address_of(@_QQcl.{{.*}}) : !fir.ref<!fir.char<1,{{[0-9]*}}>>
+! CHECK:           %[[VAL_17:.*]] = arith.constant {{[0-9]*}} : i32
+! CHECK:           %[[VAL_18:.*]] = fir.convert %[[VAL_15]] : (!fir.box<!fir.type<_QMtypesTt8{c:!fir.box<!fir.heap<!fir.char<1,11>>>}>>) -> !fir.box<none>
+! CHECK:           %[[VAL_19:.*]] = fir.convert %[[VAL_16]] : (!fir.ref<!fir.char<1,{{[0-9]*}}>>) -> !fir.ref<i8>
+! CHECK:           %[[VAL_20:.*]] = fir.call @_FortranAInitialize(%[[VAL_18]], %[[VAL_19]], %[[VAL_17]]) fastmath<contract> : (!fir.box<none>, !fir.ref<i8>, 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<allocatable>} : (!fir.ref<!fir.type<_QMtypesTt8{c:!fir.box<!fir.heap<!fir.char<1,11>>>}>>, index) -> !fir.ref<!fir.box<!fir.heap<!fir.char<1,11>>>>
+! CHECK:           %[[VAL_23:.*]] = fir.load %[[VAL_13]]#1 : !fir.ref<!fir.box<!fir.heap<!fir.char<1,12>>>>
+! CHECK:           %[[VAL_24:.*]] = fir.box_addr %[[VAL_23]] : (!fir.box<!fir.heap<!fir.char<1,12>>>) -> !fir.heap<!fir.char<1,12>>
+! CHECK:           %[[VAL_25:.*]] = fir.convert %[[VAL_24]] : (!fir.heap<!fir.char<1,12>>) -> 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<!fir.box<!fir.heap<!fir.char<1,12>>>>
+! CHECK:             %[[VAL_29:.*]] = fir.box_addr %[[VAL_28]] : (!fir.box<!fir.heap<!fir.char<1,12>>>) -> !fir.heap<!fir.char<1,12>>
+! CHECK:             hlfir.assign %[[VAL_29]] to %[[VAL_22]] realloc keep_lhs_len temporary_lhs : !fir.heap<!fir.char<1,12>>, !fir.ref<!fir.box<!fir.heap<!fir.char<1,11>>>>
+! CHECK:           }
+! CHECK:           hlfir.assign %[[VAL_14]]#0 to %[[VAL_2]]#0 : !fir.ref<!fir.type<_QMtypesTt8{c:!fir.box<!fir.heap<!fir.char<1,11>>>}>>, !fir.ref<!fir.type<_QMtypesTt8{c:!fir.box<!fir.heap<!fir.char<1,11>>>}>>
+! 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<!fir.heap<!fir.char<1,11>>>}>
+! CHECK:           %[[VAL_1:.*]] = fir.alloca !fir.type<_QMtypesTt8{c:!fir.box<!fir.heap<!fir.char<1,11>>>}> {bindc_name = "res", uniq_name = "_QFtest9Eres"}
+! CHECK:           %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_1]] {uniq_name = "_QFtest9Eres"} : (!fir.ref<!fir.type<_QMtypesTt8{c:!fir.box<!fir.heap<!fir.char<1,11>>>}>>) -> (!fir.ref<!fir.type<_QMtypesTt8{c:!fir.box<!fir.heap<!fir.char<1,11>>>}>>, !fir.ref<!fir.type<_QMtypesTt8{c:!fir.box<!fir.heap<!fir.char<1,11>>>}>>)
+! CHECK:           %[[VAL_3:.*]] = fir.embox %[[VAL_2]]#1 : (!fir.ref<!fir.type<_QMtypesTt8{c:!fir.box<!fir.heap<!fir.char<1,11>>>}>>) -> !fir.box<!fir.type<_QMtypesTt8{c:!fir.box<!fir.heap<!fir.char<1,11>>>}>>
+! CHECK:           %[[VAL_4:.*]] = fir.address_of(@_QQcl.{{.*}}) : !fir.ref<!fir.char<1,{{[0-9]*}}>>
+! CHECK:           %[[VAL_5:.*]] = arith.constant {{[0-9]*}} : i32
+! CHECK:           %[[VAL_6:.*]] = fir.convert %[[VAL_3]] : (!fir.box<!fir.type<_QMtypesTt8{c:!fir.box<!fir.heap<!fir.char<1,11>>>}>>) -> !fir.box<none>
+! CHECK:           %[[VAL_7:.*]] = fir.convert %[[VAL_4]] : (!fir.ref<!fir.char<1,{{[0-9]*}}>>) -> !fir.ref<i8>
+! CHECK:           %[[VAL_8:.*]] = fir.call @_FortranAInitialize(%[[VAL_6]], %[[VAL_7]], %[[VAL_5]]) fastmath<contract> : (!fir.box<none>, !fir.ref<i8>, 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<!fir.char<1,12>>, index) -> (!fir.ref<!fir.char<1,12>>, !fir.ref<!fir.char<1,12>>)
+! CHECK:           %[[VAL_12:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = "ctor.temp"} : (!fir.ref<!fir.type<_QMtypesTt8{c:!fir.box<!fir.heap<!fir.char<1,11>>>}>>) -> (!fir.ref<!fir.type<_QMtypesTt8{c:!fir.box<!fir.heap<!fir.char<1,11>>>}>>, !fir.ref<!fir.type<_QMtypesTt8{c:!fir.box<!fir.heap<!fir.char<1,11>>>}>>)
+! CHECK:           %[[VAL_13:.*]] = fir.embox %[[VAL_12]]#0 : (!fir.ref<!fir.type<_QMtypesTt8{c:!fir.box<!fir.heap<!fir.char<1,11>>>}>>) -> !fir.box<!fir.type<_QMtypesTt8{c:!fir.box<!fir.heap<!fir.char<1,11>>>}>>
+! CHECK:           %[[VAL_14:.*]] = fir.address_of(@_QQcl.{{.*}}) : !fir.ref<!fir.char<1,{{[0-9]*}}>>
+! CHECK:           %[[VAL_15:.*]] = arith.constant {{[0-9]*}} : i32
+! CHECK:           %[[VAL_16:.*]] = fir.convert %[[VAL_13]] : (!fir.box<!fir.type<_QMtypesTt8{c:!fir.box<!fir.heap<!fir.char<1,11>>>}>>) -> !fir.box<none>
+! CHECK:           %[[VAL_17:.*]] = fir.convert %[[VAL_14]] : (!fir.ref<!fir.char<1,{{[0-9]*}}>>) -> !fir.ref<i8>
+! CHECK:           %[[VAL_18:.*]] = fir.call @_FortranAInitialize(%[[VAL_16]], %[[VAL_17]], %[[VAL_15]]) fastmath<contract> : (!fir.box<none>, !fir.ref<i8>, 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<allocatable>} : (!fir.ref<!fir.type<_QMtypesTt8{c:!fir.box<!fir.heap<!fir.char<1,11>>>}>>, index) -> !fir.ref<!fir.box<!fir.heap<!fir.char<1,11>>>>
+! CHECK:           hlfir.assign %[[VAL_11]]#0 to %[[VAL_20]] realloc keep_lhs_len temporary_lhs : !fir.ref<!fir.char<1,12>>, !fir.ref<!fir.box<!fir.heap<!fir.char<1,11>>>>
+! CHECK:           hlfir.assign %[[VAL_12]]#0 to %[[VAL_2]]#0 : !fir.ref<!fir.type<_QMtypesTt8{c:!fir.box<!fir.heap<!fir.char<1,11>>>}>>, !fir.ref<!fir.type<_QMtypesTt8{c:!fir.box<!fir.heap<!fir.char<1,11>>>}>>
+! 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.type<_QMtypesTt1{c:!fir.char<1,4>}>>) -> (!fir.ref<!fir.type<_QMtypesTt1{c:!fir.char<1,4>}>>, !fir.ref<!fir.type<_QMtypesTt1{c:!fir.char<1,4>}>>)
+! CHECK:           %[[VAL_3:.*]] = fir.alloca !fir.box<!fir.heap<!fir.char<1,12>>> {bindc_name = "x", uniq_name = "_QFtest10Ex"}
+! CHECK:           %[[VAL_4:.*]] = arith.constant 12 : index
+! CHECK:           %[[VAL_5:.*]] = fir.zero_bits !fir.heap<!fir.char<1,12>>
+! CHECK:           %[[VAL_6:.*]] = fir.embox %[[VAL_5]] : (!fir.heap<!fir.char<1,12>>) -> !fir.box<!fir.heap<!fir.char<1,12>>>
+! CHECK:           fir.store %[[VAL_6]] to %[[VAL_3]] : !fir.ref<!fir.box<!fir.heap<!fir.char<1,12>>>>
+! CHECK:           %[[VAL_7:.*]]:2 = hlfir.declare %[[VAL_3]] typeparams %[[VAL_4]] {fortran_attrs = #fir.var_attrs<allocatable>, uniq_name = "_QFtest10Ex"} : (!fir.ref<!fir.box<!fir.heap<!fir.char<1,12>>>>, index) -> (!fir.ref<!fir.box<!fir.heap<!fir.char<1,12>>>>, !fir.ref<!fir.box<!fir.heap<!fir.char<1,12>>>>)
+! CHECK:           %[[VAL_8:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = "ctor.temp"} : (!fir.ref<!fir.type<_QMtypesTt1{c:!fir.char<1,4>}>>) -> (!fir.ref<!fir.type<_QMtypesTt1{c:!fir.char<1,4>}>>, !fir.ref<!fir.type<_QMtypesTt1{c:!fir.char<1,4>}>>)
+! CHECK:           %[[VAL_9:.*]] = fir.embox %[[VAL_8]]#0 : (!fir.ref<!fir.type<_QMtypesTt1{c:!fir.char<1,4>}>>) -> !fir.box<!fir.type<_QMtypesTt1{c:!fir.char<1,4>}>>
+! CHECK:           %[[VAL_10:.*]] = fir.address_of(@_QQcl.{{.*}}) : !fir.ref<!fir.char<1,{{[0-9]*}}>>
+! CHECK:           %[[VAL_11:.*]] = arith.constant {{[0-9]*}} : i32
+! CHECK:           %[[VAL_12:.*]] = fir.convert %[[VAL_9]] : (!fir.box<!fir.type<_QMtypesTt1{c:!fir.char<1,4>}>>) -> !fir.box<none>
+! CHECK:           %[[VAL_13:.*]] = fir.convert %[[VAL_10]] : (!fir.ref<!fir.char<1,{{[0-9]*}}>>) -> !fir.ref<i8>
+! CHECK:           %[[VAL_14:.*]] = fir.call @_FortranAInitialize(%[[VAL_12]], %[[VAL_13]], %[[VAL_11]]) fastmath<contract> : (!fir.box<none>, !fir.ref<i8>, i32) -> none
+! CHECK:           %[[VAL_15:.*]] = arith.constant 4 : index
+! CHECK:           %[[VAL_16:.*]] = hlfir.designate %[[VAL_8]]#0{"c"}   typeparams %[[VAL_15]] : (!fir.ref<!fir.type<_QMtypesTt1{c:!fir.char<1,4>}>>, index) -> !fir.ref<!fir.char<1,4>>
+! CHECK:           %[[VAL_17:.*]] = fir.load %[[VAL_7]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.char<1,12>>>>
+! CHECK:           %[[VAL_18:.*]] = fir.box_addr %[[VAL_17]] : (!fir.box<!fir.heap<!fir.char<1,12>>>) -> !fir.heap<!fir.char<1,12>>
+! CHECK:           hlfir.assign %[[VAL_18]] to %[[VAL_16]] temporary_lhs : !fir.heap<!fir.char<1,12>>, !fir.ref<!fir.char<1,4>>
+! CHECK:           hlfir.assign %[[VAL_8]]#0 to %[[VAL_2]]#0 : !fir.ref<!fir.type<_QMtypesTt1{c:!fir.char<1,4>}>>, !fir.ref<!fir.type<_QMtypesTt1{c:!fir.char<1,4>}>>
+! CHECK:           return
+! CHECK:         }