[flasg] Debug folding of substring references

[klausler]

Summary

Character substrings weren't being folded correctly;
add tests and rework the implementation so that substrings
of literals and named constant character scalars & arrays
are properly folded for use in constant expressions.

[PeteSteinfeld]

All builds, tests, and looks good.

flang/include/flang/Evaluate/constant.h

std::optional<Scalar<Result>> GetScalarValue() const {
     } else {
       return std::nullopt;
     }
   }
 
   // Apply subscripts, if any.
   Scalar<Result> At(const ConstantSubscripts &) const;
 
+  // Extract substring(s); returns nullopt for errors.
+  std::optional<Constant> Substring(ConstantSubscript, ConstantSubscript) const;
+
   Constant Reshape(ConstantSubscripts &&) const;
   llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const;
   static constexpr DynamicType GetType() {
     return {TypeCategory::Character, KIND};
   }
   std::size_t CopyFrom(const Constant &source, std::size_t count,
       ConstantSubscripts &resultSubscripts, const std::vector<int> *dimOrder);
 

flang/lib/Evaluate/constant.cpp

 template <int KIND>
 auto Constant<Type<TypeCategory::Character, KIND>>::At(
     const ConstantSubscripts &index) const -> Scalar<Result> {
   auto offset{SubscriptsToOffset(index)};
   return values_.substr(offset * length_, length_);
 }
 
 template <int KIND>
+auto Constant<Type<TypeCategory::Character, KIND>>::Substring(
+    ConstantSubscript lo, ConstantSubscript hi) const
+    -> std::optional<Constant> {
+  std::vector<Element> elements;
+  ConstantSubscript n{GetSize(shape())};
+  ConstantSubscript newLength{0};
+  if (lo > hi) { // zero-length results
+    while (n-- > 0) {
+      elements.emplace_back(); // ""
+    }
+  } else if (lo < 1 || hi > length_) {
+    return std::nullopt;
+  } else {
+    newLength = hi - lo + 1;
+    for (ConstantSubscripts at{lbounds()}; n-- > 0; IncrementSubscripts(at)) {
+      elements.emplace_back(At(at).substr(lo - 1, newLength));
+    }
+  }
+  return Constant{newLength, std::move(elements), ConstantSubscripts{shape()}};
+}
+
+template <int KIND>
 auto Constant<Type<TypeCategory::Character, KIND>>::Reshape(
     ConstantSubscripts &&dims) const -> Constant<Result> {
   std::size_t n{TotalElementCount(dims)};
   CHECK(!empty() || n == 0);
   std::vector<Element> elements;
   ConstantSubscript at{0},
       limit{static_cast<ConstantSubscript>(values_.size())};
   while (n-- > 0) {

flang/lib/Evaluate/fold-implementation.h

std::optional<Constant<T>> Folder<T>::GetConstantComponent(Component &component,
   }
 }
 
 template <typename T> Expr<T> Folder<T>::Folding(Designator<T> &&designator) {
   if constexpr (T::category == TypeCategory::Character) {
     if (auto *substring{common::Unwrap<Substring>(designator.u)}) {
       if (std::optional<Expr<SomeCharacter>> folded{
               substring->Fold(context_)}) {
-        if (auto value{GetScalarConstantValue<T>(*folded)}) {
-          return Expr<T>{*value};
+        if (const auto *specific{std::get_if<Expr<T>>(&folded->u)}) {
+          return std::move(*specific);
         }
       }
       if (auto length{ToInt64(Fold(context_, substring->LEN()))}) {
         if (*length == 0) {
           return Expr<T>{Constant<T>{Scalar<T>{}}};
         }
       }
     }

flang/lib/Evaluate/variable.cpp

 }
 
 Substring &Substring::set_upper(Expr<SubscriptInteger> &&expr) {
   upper_.emplace(std::move(expr));
   return *this;
 }
 
 std::optional<Expr<SomeCharacter>> Substring::Fold(FoldingContext &context) {
+  if (!upper_) {
+    upper_ = upper();
+    if (!upper_) {
+      return std::nullopt;
+    }
+  }
+  upper_.value() = evaluate::Fold(context, std::move(upper_.value().value()));
+  std::optional<ConstantSubscript> ubi{ToInt64(upper_.value().value())};
+  if (!ubi) {
+    return std::nullopt;
+  }
   if (!lower_) {
     lower_ = AsExpr(Constant<SubscriptInteger>{1});
   }
   lower_.value() = evaluate::Fold(context, std::move(lower_.value().value()));
   std::optional<ConstantSubscript> lbi{ToInt64(lower_.value().value())};
-  if (lbi && *lbi < 1) {
-    context.messages().Say(
-        "Lower bound (%jd) on substring is less than one"_en_US, *lbi);
-    *lbi = 1;
-    lower_ = AsExpr(Constant<SubscriptInteger>{1});
-  }
-  if (!upper_) {
-    upper_ = upper();
-    if (!upper_) {
-      return std::nullopt;
-    }
+  if (!lbi) {
+  if (*lbi > *ubi) { // empty result; canonicalize
+    *lbi = 1;
+    *ubi = 0;
+    lower_ = AsExpr(Constant<SubscriptInteger>{*lbi});
+    upper_ = AsExpr(Constant<SubscriptInteger>{*ubi});
   }
-  upper_.value() = evaluate::Fold(context, std::move(upper_.value().value()));
-  if (std::optional<ConstantSubscript> ubi{ToInt64(upper_.value().value())}) {
-    auto *literal{std::get_if<StaticDataObject::Pointer>(&parent_)};
-    std::optional<ConstantSubscript> length;
-    if (literal) {
-      length = (*literal)->data().size();
-    } else if (const Symbol * symbol{GetLastSymbol()}) {
-      if (const semantics::DeclTypeSpec * type{symbol->GetType()}) {
-        if (type->category() == semantics::DeclTypeSpec::Character) {
-          length = ToInt64(type->characterTypeSpec().length().GetExplicit());
-        }
+  std::optional<Expr<SomeCharacter>> strings; // a Constant<Character>
+  if (const auto *literal{std::get_if<StaticDataObject::Pointer>(&parent_)}) {
+    if (auto str{(*literal)->AsString()}) {
+      strings =
+          Expr<SomeCharacter>(Expr<Ascii>(Constant<Ascii>{std::move(*str)}));
+  } else if (const auto *dataRef{std::get_if<DataRef>(&parent_)}) {
+    if (auto expr{AsGenericExpr(DataRef{*dataRef})}) {
+      auto folded{evaluate::Fold(context, std::move(*expr))};
+      if (IsActuallyConstant(folded)) {
+        if (const auto *value{UnwrapExpr<Expr<SomeCharacter>>(folded)}) {
+          strings = *value;
         }
       }
-    if (*ubi < 1 || (lbi && *ubi < *lbi)) {
-      // Zero-length string: canonicalize
-      *lbi = 1, *ubi = 0;
-      lower_ = AsExpr(Constant<SubscriptInteger>{*lbi});
-      upper_ = AsExpr(Constant<SubscriptInteger>{*ubi});
-    } else if (length && *ubi > *length) {
-      context.messages().Say("Upper bound (%jd) on substring is greater "
-                             "than character length (%jd)"_en_US,
-          *ubi, *length);
-      *ubi = *length;
     }
-    if (lbi && literal) {
-      auto newStaticData{StaticDataObject::Create()};
-      auto items{0}; // If the lower bound is greater, the length is 0
-      if (*ubi >= *lbi) {
-        items = *ubi - *lbi + 1;
-      }
-      auto width{(*literal)->itemBytes()};
-      auto bytes{items * width};
-      auto startByte{(*lbi - 1) * width};
-      const auto *from{&(*literal)->data()[0] + startByte};
-      for (auto j{0}; j < bytes; ++j) {
-        newStaticData->data().push_back(from[j]);
-      }
-      parent_ = newStaticData;
+  std::optional<Expr<SomeCharacter>> result;
+  if (strings) {
+    result = std::visit(
+        [&](const auto &expr) -> std::optional<Expr<SomeCharacter>> {
+          using Type = typename std::decay_t<decltype(expr)>::Result;
+          if (const auto *cc{std::get_if<Constant<Type>>(&expr.u)}) {
+            if (auto substr{cc->Substring(*lbi, *ubi)}) {
+              return Expr<SomeCharacter>{Expr<Type>{*substr}};
+            }
+          }
+          return std::nullopt;
+        },
+        strings->u);
+  }
+  if (!result) { // error cases
+    if (*lbi < 1) {
+      context.messages().Say(
+          "Lower bound (%jd) on substring is less than one"_en_US,
+          static_cast<std::intmax_t>(*lbi));
+      *lbi = 1;
       lower_ = AsExpr(Constant<SubscriptInteger>{1});
-      ConstantSubscript length = newStaticData->data().size();
-      upper_ = AsExpr(Constant<SubscriptInteger>{length});
-      switch (width) {
-      case 1:
-        return {
-            AsCategoryExpr(AsExpr(Constant<Type<TypeCategory::Character, 1>>{
-                *newStaticData->AsString()}))};
-      case 2:
-        return {AsCategoryExpr(Constant<Type<TypeCategory::Character, 2>>{
-            *newStaticData->AsU16String()})};
-      case 4:
-        return {AsCategoryExpr(Constant<Type<TypeCategory::Character, 4>>{
-            *newStaticData->AsU32String()})};
-      default:
-        CRASH_NO_CASE;
-      }
+    if (length && *ubi > *length) {
+      context.messages().Say(
+          "Upper bound (%jd) on substring is greater than character length (%jd)"_en_US,
+          static_cast<std::intmax_t>(*ubi),
+          static_cast<std::intmax_t>(*length));
+      *ubi = *length;
+      upper_ = AsExpr(Constant<SubscriptInteger>{*ubi});
     }
   }
-  return std::nullopt;
+  return result;
 }
 
 DescriptorInquiry::DescriptorInquiry(
     const NamedEntity &base, Field field, int dim)
     : base_{base}, field_{field}, dimension_{dim} {
   const Symbol &last{base_.GetLastSymbol()};
   CHECK(IsDescriptor(last));
   CHECK(((field == Field::Len || field == Field::Rank) && dim == 0) ||

flang/test/Evaluate/fold-substr.f90

+! RUN: %python %S/test_folding.py %s %flang_fc1
+! Test folding of substrings
+module m
+  logical, parameter :: test_01a = "abc"(1:3) == "abc"
+  logical, parameter :: test_01b = len("abc"(1:3)) == 3
+  logical, parameter :: test_02a = "abc"(-1:-2) == ""
+  logical, parameter :: test_02b = len("abc"(-1:-2)) == 0
+  logical, parameter :: test_03a = "abc"(9999:4) == ""
+  logical, parameter :: test_03b = len("abc"(9999:4)) == 0
+  character(4), parameter :: ca(3) = ["abcd", "efgh", "ijkl"]
+  logical, parameter :: test_04a = ca(2)(2:4) == "fgh"
+  logical, parameter :: test_04b = len(ca(2)(2:4)) == 3
+  logical, parameter :: test_05a = all(ca(:)(2:4) == ["bcd", "fgh", "jkl"])
+  logical, parameter :: test_05b = len(ca(:)(2:4)) == 3
+  logical, parameter :: test_06a = ca(1)(1:2)//ca(2)(2:3)//ca(3)(3:4) == "abfgkl"
+  logical, parameter :: test_06b = len(ca(1)(1:2)//ca(2)(2:3)//ca(3)(3:4)) == 6
+end module