[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

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,

flang/lib/Lower/ConvertExprToHLFIR.cpp

@@ -1641,19 +1641,6 @@ class HlfirBuilder {
   // 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 @@ class HlfirBuilder {
           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 @@ class HlfirBuilder {
       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();
     }

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();
 }
 

flang/lib/Optimizer/HLFIR/Transforms/ConvertToFIR.cpp

@@ -120,6 +120,11 @@ class AssignOpConversion : public mlir::OpRewritePattern<hlfir::AssignOp> {
         // 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.

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}}