[flang] Move whole allocatable assignment implicit conversion to lowering

flang/include/flang/Optimizer/Builder/Character.h

@@ -235,6 +235,11 @@ std::pair<mlir::Value, mlir::Value>
 extractCharacterProcedureTuple(fir::FirOpBuilder &builder, mlir::Location loc,
                                mlir::Value tuple, bool openBoxProc = true);
 
+fir::CharBoxValue convertCharacterKind(fir::FirOpBuilder &builder,
+                                       mlir::Location loc,
+                                       fir::CharBoxValue srcBoxChar,
+                                       int toKind);
+
 } // namespace fir::factory
 
 #endif // FORTRAN_OPTIMIZER_BUILDER_CHARACTER_H

flang/include/flang/Optimizer/Builder/HLFIRTools.h

@@ -427,6 +427,29 @@ std::pair<hlfir::Entity, mlir::Value>
 createTempFromMold(mlir::Location loc, fir::FirOpBuilder &builder,
                    hlfir::Entity mold);
 
+hlfir::EntityWithAttributes convertCharacterKind(mlir::Location loc,
+                                                 fir::FirOpBuilder &builder,
+                                                 hlfir::Entity scalarChar,
+                                                 int toKind);
+
+/// Materialize an implicit Fortran type conversion from \p source to \p toType.
+/// This is a no-op if the Fortran category and KIND of \p source are
+/// the same as the one in \p toType. This is also a no-op if \p toType is an
+/// unlimited polymorphic. For characters, this implies that a conversion is
+/// only inserted in case of KIND mismatch (and not in case of length mismatch),
+/// and that the resulting entity length is the same as the one from \p source.
+/// It is valid to call this helper if \p source is an array. If a conversion is
+/// inserted for arrays, a clean-up will be returned. If no conversion is
+/// needed, the source is returned.
+/// Beware that the resulting entity mlir type may not be toType: it will be a
+/// Fortran entity with the same Fortran category and KIND.
+/// If preserveLowerBounds is set, the returned entity will have the same lower
+/// bounds as \p source.
+std::pair<hlfir::Entity, std::optional<hlfir::CleanupFunction>>
+genTypeAndKindConvert(mlir::Location loc, fir::FirOpBuilder &builder,
+                      hlfir::Entity source, mlir::Type toType,
+                      bool preserveLowerBounds);
+
 } // namespace hlfir
 
 #endif // FORTRAN_OPTIMIZER_BUILDER_HLFIRTOOLS_H

flang/lib/Lower/Bridge.cpp

@@ -3372,47 +3372,25 @@ class FirConverter : public Fortran::lower::AbstractConverter {
     }
   }
 
-  /// Given converted LHS and RHS of the assignment, generate
-  /// explicit type conversion for implicit Logical<->Integer
-  /// conversion. Return Value representing the converted RHS,
-  /// if the implicit Logical<->Integer is detected, otherwise,
-  /// return nullptr. The caller is responsible for inserting
-  /// DestroyOp in case the returned value has hlfir::ExprType.
-  mlir::Value
-  genImplicitLogicalConvert(const Fortran::evaluate::Assignment &assign,
-                            hlfir::Entity rhs,
-                            Fortran::lower::StatementContext &stmtCtx) {
-    mlir::Type fromTy = rhs.getFortranElementType();
-    if (!fromTy.isa<mlir::IntegerType, fir::LogicalType>())
-      return nullptr;
-
-    mlir::Type toTy = hlfir::getFortranElementType(genType(assign.lhs));
-    if (fromTy == toTy)
-      return nullptr;
-    if (!toTy.isa<mlir::IntegerType, fir::LogicalType>())
-      return nullptr;
-
+  /// Given converted LHS and RHS of the assignment, materialize any
+  /// implicit conversion of the RHS to the LHS type. The front-end
+  /// usually already makes those explicit, except for non-standard
+  /// LOGICAL <-> INTEGER, or if the LHS is a whole allocatable
+  /// (making the conversion explicit in the front-end would prevent
+  /// propagation of the LHS lower bound in the reallocation).
+  /// If array temporaries or values are created, the cleanups are
+  /// added in the statement context.
+  hlfir::Entity genImplicitConvert(const Fortran::evaluate::Assignment &assign,
+                                   hlfir::Entity rhs, bool preserveLowerBounds,
+                                   Fortran::lower::StatementContext &stmtCtx) {
     mlir::Location loc = toLocation();
     auto &builder = getFirOpBuilder();
-    if (assign.rhs.Rank() == 0)
-      return builder.createConvert(loc, toTy, rhs);
-
-    mlir::Value shape = hlfir::genShape(loc, builder, rhs);
-    auto genKernel =
-        [&rhs, &toTy](mlir::Location loc, fir::FirOpBuilder &builder,
-                      mlir::ValueRange oneBasedIndices) -> hlfir::Entity {
-      auto elementPtr = hlfir::getElementAt(loc, builder, rhs, oneBasedIndices);
-      auto val = hlfir::loadTrivialScalar(loc, builder, elementPtr);
-      return hlfir::EntityWithAttributes{builder.createConvert(loc, toTy, val)};
-    };
-    mlir::Value convertedRhs = hlfir::genElementalOp(
-        loc, builder, toTy, shape, /*typeParams=*/{}, genKernel,
-        /*isUnordered=*/true);
-    fir::FirOpBuilder *bldr = &builder;
-    stmtCtx.attachCleanup([loc, bldr, convertedRhs]() {
-      bldr->create<hlfir::DestroyOp>(loc, convertedRhs);
-    });
-    return convertedRhs;
+    mlir::Type toType = genType(assign.lhs);
+    auto valueAndPair = hlfir::genTypeAndKindConvert(loc, builder, rhs, toType,
+                                                     preserveLowerBounds);
+    if (valueAndPair.second)
+      stmtCtx.attachCleanup(*valueAndPair.second);
+    return hlfir::Entity{valueAndPair.first};
   }
 
   static void
@@ -3476,14 +3454,17 @@ class FirConverter : public Fortran::lower::AbstractConverter {
       // loops early if possible. This also dereferences pointer and
       // allocatable RHS: the target is being assigned from.
       rhs = hlfir::loadTrivialScalar(loc, builder, rhs);
-      // In intrinsic assignments, Logical<->Integer assignments are allowed as
-      // an extension, but there is no explicit Convert expression for the RHS.
-      // Recognize the type mismatch here and insert explicit scalar convert or
-      // ElementalOp for array assignment.
+      // In intrinsic assignments, the LHS type may not match the RHS type, in
+      // which case an implicit conversion of the LHS must be done. The
+      // front-end usually makes it explicit, unless it cannot (whole
+      // allocatable LHS or Logical<->Integer assignment extension). Recognize
+      // any type mismatches here and insert explicit scalar convert or
+      // ElementalOp for array assignment. Preserve the RHS lower bounds on the
+      // converted entity in case of assignment to whole allocatables so to
+      // propagate the lower bounds to the LHS in case of reallocation.
       if (!userDefinedAssignment)
-        if (mlir::Value conversion =
-                genImplicitLogicalConvert(assign, rhs, stmtCtx))
-          rhs = hlfir::Entity{conversion};
+        rhs = genImplicitConvert(assign, rhs, isWholeAllocatableAssignment,
+                                 stmtCtx);
       return rhs;
     };
 

flang/lib/Lower/ConvertExpr.cpp

@@ -1237,41 +1237,8 @@ class ScalarExprLowering {
         [&](const fir::CharBoxValue &boxchar) -> ExtValue {
           if constexpr (TC1 == Fortran::common::TypeCategory::Character &&
                         TC2 == TC1) {
-            // Use char_convert. Each code point is translated from a
-            // narrower/wider encoding to the target encoding. For example, 'A'
-            // may be translated from 0x41 : i8 to 0x0041 : i16. The symbol
-            // for euro (0x20AC : i16) may be translated from a wide character
-            // to "0xE2 0x82 0xAC" : UTF-8.
-            mlir::Value bufferSize = boxchar.getLen();
-            auto kindMap = builder.getKindMap();
-            mlir::Value boxCharAddr = boxchar.getAddr();
-            auto fromTy = boxCharAddr.getType();
-            if (auto charTy = fromTy.dyn_cast<fir::CharacterType>()) {
-              // boxchar is a value, not a variable. Turn it into a temporary.
-              // As a value, it ought to have a constant LEN value.
-              assert(charTy.hasConstantLen() && "must have constant length");
-              mlir::Value tmp = builder.createTemporary(loc, charTy);
-              builder.create<fir::StoreOp>(loc, boxCharAddr, tmp);
-              boxCharAddr = tmp;
-            }
-            auto fromBits =
-                kindMap.getCharacterBitsize(fir::unwrapRefType(fromTy)
-                                                .cast<fir::CharacterType>()
-                                                .getFKind());
-            auto toBits = kindMap.getCharacterBitsize(
-                ty.cast<fir::CharacterType>().getFKind());
-            if (toBits < fromBits) {
-              // Scale by relative ratio to give a buffer of the same length.
-              auto ratio = builder.createIntegerConstant(
-                  loc, bufferSize.getType(), fromBits / toBits);
-              bufferSize =
-                  builder.create<mlir::arith::MulIOp>(loc, bufferSize, ratio);
-            }
-            auto dest = builder.create<fir::AllocaOp>(
-                loc, ty, mlir::ValueRange{bufferSize});
-            builder.create<fir::CharConvertOp>(loc, boxCharAddr,
-                                               boxchar.getLen(), dest);
-            return fir::CharBoxValue{dest, boxchar.getLen()};
+            return fir::factory::convertCharacterKind(builder, loc, boxchar,
+                                                      KIND);
           } else {
             fir::emitFatalError(
                 loc, "unsupported evaluate::Convert between CHARACTER type "
@@ -3965,7 +3932,7 @@ class ArrayExprLowering {
       auto castTo = builder.createConvert(loc, memrefTy, origVal);
       origVal = builder.create<fir::EmboxOp>(loc, eleTy, castTo);
     }
-    mlir::Value val = builder.createConvert(loc, eleTy, origVal);
+    mlir::Value val = builder.convertWithSemantics(loc, eleTy, origVal);
     if (isBoundsSpec()) {
       assert(lbounds.has_value());
       auto lbs = *lbounds;

flang/lib/Lower/ConvertExprToHLFIR.cpp

@@ -1367,37 +1367,7 @@ struct UnaryOp<
                                          hlfir::Entity lhs) {
     if constexpr (TC1 == Fortran::common::TypeCategory::Character &&
                   TC2 == TC1) {
-      auto kindMap = builder.getKindMap();
-      mlir::Type fromTy = lhs.getFortranElementType();
-      mlir::Value origBufferSize = genCharLength(loc, builder, lhs);
-      mlir::Value bufferSize{origBufferSize};
-      auto fromBits = kindMap.getCharacterBitsize(
-          fir::unwrapRefType(fromTy).cast<fir::CharacterType>().getFKind());
-      mlir::Type toTy = Fortran::lower::getFIRType(
-          builder.getContext(), TC1, KIND, /*params=*/std::nullopt);
-      auto toBits = kindMap.getCharacterBitsize(
-          toTy.cast<fir::CharacterType>().getFKind());
-      if (toBits < fromBits) {
-        // Scale by relative ratio to give a buffer of the same length.
-        auto ratio = builder.createIntegerConstant(loc, bufferSize.getType(),
-                                                   fromBits / toBits);
-        bufferSize =
-            builder.create<mlir::arith::MulIOp>(loc, bufferSize, ratio);
-      }
-      // allocate space on the stack for toBuffer
-      auto dest = builder.create<fir::AllocaOp>(loc, toTy,
-                                                mlir::ValueRange{bufferSize});
-      auto src = hlfir::convertToAddress(loc, builder, lhs,
-                                         lhs.getFortranElementType());
-      builder.create<fir::CharConvertOp>(loc, src.first.getCharBox()->getAddr(),
-                                         origBufferSize, dest);
-      if (src.second.has_value())
-        src.second.value()();
-
-      return hlfir::EntityWithAttributes{builder.create<hlfir::DeclareOp>(
-          loc, dest, "ctor.temp", /*shape=*/nullptr,
-          /*typeparams=*/mlir::ValueRange{origBufferSize},
-          fir::FortranVariableFlagsAttr{})};
+      return hlfir::convertCharacterKind(loc, builder, lhs, KIND);
     }
     mlir::Type type = Fortran::lower::getFIRType(builder.getContext(), TC1,
                                                  KIND, /*params=*/std::nullopt);
@@ -1789,7 +1759,7 @@ class HlfirBuilder {
       // If it is allocatable, then using AssignOp for unallocated RHS
       // will cause illegal dereference. When an unallocated allocatable
       // value is used to construct an allocatable component, the component
-      // must just stay unallocated.
+      // must just stay unallocated (see Fortran 2018 7.5.10 point 7).
 
       // If the component is allocatable and RHS is NULL() expression, then
       // we can just skip it: the LHS must remain unallocated with its
@@ -1798,56 +1768,44 @@ class HlfirBuilder {
           Fortran::evaluate::UnwrapExpr<Fortran::evaluate::NullPointer>(expr))
         continue;
 
+      bool keepLhsLength = false;
+      if (allowRealloc)
+        if (const Fortran::semantics::DeclTypeSpec *declType = sym.GetType())
+          keepLhsLength =
+              declType->category() ==
+                  Fortran::semantics::DeclTypeSpec::Category::Character &&
+              !declType->characterTypeSpec().length().isDeferred();
       // 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()) {
+      // SET_LENGTH is used for initializers of non-allocatable character
+      // components so that the front-end can better
+      // fold and work with these structure constructors.
+      // Here, they are just noise since the assignment semantics will deal
+      // with any length mismatch, and creating an extra temp with the lhs
+      // length is useless.
+      // TODO: should this be moved into an hlfir.assign + hlfir.set_length
+      // pattern rewrite?
+      hlfir::Entity rhs = gen(expr);
+      if (auto set_length = rhs.getDefiningOp<hlfir::SetLengthOp>())
+        rhs = hlfir::Entity{set_length.getString()};
+
+      // lambda to generate `lhs = rhs` and deal with potential rhs implicit
+      // cast
+      auto genAssign = [&] {
         rhs = hlfir::loadTrivialScalar(loc, builder, rhs);
-        builder.create<hlfir::AssignOp>(loc, rhs, lhs, allowRealloc,
+        auto rhsCastAndCleanup =
+            hlfir::genTypeAndKindConvert(loc, builder, rhs, lhs.getType(),
+                                         /*preserveLowerBounds=*/allowRealloc);
+        builder.create<hlfir::AssignOp>(loc, rhsCastAndCleanup.first, lhs,
+                                        allowRealloc,
                                         allowRealloc ? keepLhsLength : false,
                                         /*temporary_lhs=*/true);
+        if (rhsCastAndCleanup.second)
+          (*rhsCastAndCleanup.second)();
+      };
+
+      if (!allowRealloc || !rhs.isMutableBox()) {
+        genAssign();
         continue;
       }
 
@@ -1860,14 +1818,7 @@ class HlfirBuilder {
                                  "to mutable box");
       mlir::Value isAlloc =
           fir::factory::genIsAllocatedOrAssociatedTest(builder, loc, *fromBox);
-      builder.genIfThen(loc, isAlloc)
-          .genThen([&]() {
-            rhs = hlfir::loadTrivialScalar(loc, builder, rhs);
-            builder.create<hlfir::AssignOp>(loc, rhs, lhs, allowRealloc,
-                                            keepLhsLength,
-                                            /*temporary_lhs=*/true);
-          })
-          .end();
+      builder.genIfThen(loc, isAlloc).genThen(genAssign).end();
     }
 
     return varOp;

flang/lib/Optimizer/Builder/Character.cpp

@@ -851,3 +851,42 @@ fir::CharBoxValue fir::factory::CharacterExprHelper::createCharExtremum(
   createAssign(toBuf, fromBuf);
   return temp;
 }
+
+fir::CharBoxValue
+fir::factory::convertCharacterKind(fir::FirOpBuilder &builder,
+                                   mlir::Location loc,
+                                   fir::CharBoxValue srcBoxChar, int toKind) {
+  // Use char_convert. Each code point is translated from a
+  // narrower/wider encoding to the target encoding. For example, 'A'
+  // may be translated from 0x41 : i8 to 0x0041 : i16. The symbol
+  // for euro (0x20AC : i16) may be translated from a wide character
+  // to "0xE2 0x82 0xAC" : UTF-8.
+  mlir::Value bufferSize = srcBoxChar.getLen();
+  auto kindMap = builder.getKindMap();
+  mlir::Value boxCharAddr = srcBoxChar.getAddr();
+  auto fromTy = boxCharAddr.getType();
+  if (auto charTy = fromTy.dyn_cast<fir::CharacterType>()) {
+    // boxchar is a value, not a variable. Turn it into a temporary.
+    // As a value, it ought to have a constant LEN value.
+    assert(charTy.hasConstantLen() && "must have constant length");
+    mlir::Value tmp = builder.createTemporary(loc, charTy);
+    builder.create<fir::StoreOp>(loc, boxCharAddr, tmp);
+    boxCharAddr = tmp;
+  }
+  auto fromBits = kindMap.getCharacterBitsize(
+      fir::unwrapRefType(fromTy).cast<fir::CharacterType>().getFKind());
+  auto toBits = kindMap.getCharacterBitsize(toKind);
+  if (toBits < fromBits) {
+    // Scale by relative ratio to give a buffer of the same length.
+    auto ratio = builder.createIntegerConstant(loc, bufferSize.getType(),
+                                               fromBits / toBits);
+    bufferSize = builder.create<mlir::arith::MulIOp>(loc, bufferSize, ratio);
+  }
+  mlir::Type toType =
+      fir::CharacterType::getUnknownLen(builder.getContext(), toKind);
+  auto dest = builder.createTemporary(loc, toType, /*name=*/{}, /*shape=*/{},
+                                      mlir::ValueRange{bufferSize});
+  builder.create<fir::CharConvertOp>(loc, boxCharAddr, srcBoxChar.getLen(),
+                                     dest);
+  return fir::CharBoxValue{dest, srcBoxChar.getLen()};
+}