[flang] Fix crash in folding TRANSFER() with MOLD=substring

[klausler]

Summary

When a substring appears as the MOLD= argument to TRANSFER(),
it's possible for the compiler to assert if it can't figure
out a constant length for the substring. Fix.

[PeteSteinfeld]

All builds and tests correctly and looks good.

flang/include/flang/Evaluate/initial-image.h

 
   // Conversions to constant initializers
   std::optional<Expr<SomeType>> AsConstant(FoldingContext &,
-      const DynamicType &, const ConstantSubscripts &, bool padWithZero = false,
+      const DynamicType &, std::optional<std::int64_t> charLength,
+      const ConstantSubscripts &, bool padWithZero = false,
       ConstantSubscript offset = 0) const;
   std::optional<Expr<SomeType>> AsConstantPointer(
       ConstantSubscript offset = 0) const;

flang/include/flang/Evaluate/type.h

   std::optional<Expr<SubscriptInteger>> GetCharLength() const;
 
   std::size_t GetAlignment(const TargetCharacteristics &) const;
-  std::optional<Expr<SubscriptInteger>> MeasureSizeInBytes(
-      FoldingContext &, bool aligned) const;
+  std::optional<Expr<SubscriptInteger>> MeasureSizeInBytes(FoldingContext &,
+      bool aligned,
+      std::optional<std::int64_t> charLength = std::nullopt) const;
 
   std::string AsFortran() const;
   std::string AsFortran(std::string &&charLenExpr) const;

flang/lib/Evaluate/fold.cpp

     }
   }
   std::optional<DynamicType> moldType;
-  if (arguments[1]) {
+  std::optional<std::int64_t> moldLength;
+  if (arguments[1]) { // MOLD=
     moldType = arguments[1]->GetType();
+    if (moldType && moldType->category() == TypeCategory::Character) {
+      if (const auto *chExpr{UnwrapExpr<Expr<SomeCharacter>>(arguments[1])}) {
+        moldLength = ToInt64(Fold(context, chExpr->LEN()));
+      }
+    }
   }
   std::optional<ConstantSubscripts> extents;
   if (arguments.size() == 2) { // no SIZE=

       }
     }
   }
-  if (sourceBytes && IsActuallyConstant(*source) && moldType && extents) {
+  if (sourceBytes && IsActuallyConstant(*source) && moldType && extents &&
+      (moldLength || moldType->category() != TypeCategory::Character)) {
     std::size_t elements{
         extents->empty() ? 1 : static_cast<std::size_t>((*extents)[0])};
     std::size_t totalBytes{*sourceBytes * elements};

           image.Add(0, *sourceBytes, *source, context)};
       CHECK(imageResult == InitialImage::Ok);
       return image.AsConstant(
-          context, *moldType, *extents, true /*pad with 0*/);
+          context, *moldType, moldLength, *extents, true /*pad with 0*/);
     }
   }
   return std::nullopt;

flang/lib/Evaluate/initial-image.cpp

   using Result = std::optional<Expr<SomeType>>;
   using Types = AllTypes;
   AsConstantHelper(FoldingContext &context, const DynamicType &type,
-      const ConstantSubscripts &extents, const InitialImage &image,
-      bool padWithZero = false, ConstantSubscript offset = 0)
-      : context_{context}, type_{type}, image_{image}, extents_{extents},
-        padWithZero_{padWithZero}, offset_{offset} {
+      std::optional<std::int64_t> charLength, const ConstantSubscripts &extents,
+      const InitialImage &image, bool padWithZero = false,
+      ConstantSubscript offset = 0)
+      : context_{context}, type_{type}, charLength_{charLength}, image_{image},
+        extents_{extents}, padWithZero_{padWithZero}, offset_{offset} {
     CHECK(!type.IsPolymorphic());
   }
   template <typename T> Result Test() {

     using Scalar = typename Const::Element;
     std::size_t elements{TotalElementCount(extents_)};
     std::vector<Scalar> typedValue(elements);
-    auto elemBytes{
-        ToInt64(type_.MeasureSizeInBytes(context_, GetRank(extents_) > 0))};
+    auto elemBytes{ToInt64(type_.MeasureSizeInBytes(
+        context_, GetRank(extents_) > 0, charLength_))};
     CHECK(elemBytes && *elemBytes >= 0);
     std::size_t stride{static_cast<std::size_t>(*elemBytes)};
     CHECK(offset_ + elements * stride <= image_.data_.size() || padWithZero_);

             CHECK(componentExtents.has_value());
             for (std::size_t j{0}; j < elements; ++j, at += stride) {
               if (Result value{image_.AsConstant(context_, *componentType,
-                      *componentExtents, padWithZero_, at)}) {
+                      std::nullopt, *componentExtents, padWithZero_, at)}) {
                 typedValue[j].emplace(component, std::move(*value));
               }
             }

 private:
   FoldingContext &context_;
   const DynamicType &type_;
+  std::optional<std::int64_t> charLength_;
   const InitialImage &image_;
   ConstantSubscripts extents_; // a copy
   bool padWithZero_;

 };
 
 std::optional<Expr<SomeType>> InitialImage::AsConstant(FoldingContext &context,
-    const DynamicType &type, const ConstantSubscripts &extents,
-    bool padWithZero, ConstantSubscript offset) const {
-  return common::SearchTypes(
-      AsConstantHelper{context, type, extents, *this, padWithZero, offset});
+    const DynamicType &type, std::optional<std::int64_t> charLength,
+    const ConstantSubscripts &extents, bool padWithZero,
+    ConstantSubscript offset) const {
+  return common::SearchTypes(AsConstantHelper{
+      context, type, charLength, extents, *this, padWithZero, offset});
 }
 
 std::optional<Expr<SomeType>> InitialImage::AsConstantPointer(

flang/lib/Evaluate/type.cpp

 }
 
 std::optional<Expr<SubscriptInteger>> DynamicType::MeasureSizeInBytes(
-    FoldingContext &context, bool aligned) const {
+    FoldingContext &context, bool aligned,
+    std::optional<std::int64_t> charLength) const {
   switch (category_) {
   case TypeCategory::Integer:
   case TypeCategory::Real:

     return Expr<SubscriptInteger>{
         context.targetCharacteristics().GetByteSize(category_, kind_)};
   case TypeCategory::Character:
-    if (auto len{GetCharLength()}) {
+    if (auto len{charLength ? Expr<SubscriptInteger>{Constant<SubscriptInteger>{
+                                  *charLength}}
+                            : GetCharLength()}) {
       return Fold(context,
           Expr<SubscriptInteger>{
               context.targetCharacteristics().GetByteSize(category_, kind_)} *

flang/lib/Semantics/data-to-inits.cpp

               if (auto extents{evaluate::GetConstantExtents(
                       foldingContext, component)}) {
                 if (auto extant{init.image.AsConstant(foldingContext, *dyType,
-                        *extents, false /*don't pad*/, componentOffset)}) {
+                        std::nullopt, *extents, false /*don't pad*/,
+                        componentOffset)}) {
                   initialized = !(*extant == *object->init());
                 }
               }

       }
     } else if (auto symbolType{evaluate::DynamicType::From(symbol)}) {
       if (auto extents{evaluate::GetConstantExtents(context, symbol)}) {
-        mutableObject.set_init(
-            initialization.image.AsConstant(context, *symbolType, *extents));
+        mutableObject.set_init(initialization.image.AsConstant(
+            context, *symbolType, std::nullopt, *extents));
       } else {
         exprAnalyzer.Say(symbol.name(),
             "internal: unknown shape for '%s' while constructing initializer from DATA"_err_en_US,

flang/test/Evaluate/fold-transfer.f90

   character*5, parameter :: le1c(*) = transfer(le1, [character(5)::])
   character*5, parameter :: be1c(*) = transfer(be1, [character(5)::])
   logical, parameter :: test_i2c_s = all(le1c == ["abcd"//char(0)]) .or. all(be1c == ["efgh"//char(0)])
+
+  character*4, parameter :: i2ss1 = transfer(int(z'61626364', 4), "12345678"(2:5))
+  logical, parameter :: test_i2ss1 = any(i2ss1 == ["abcd", "dcba"])
 end module