[flang] Fix assert on character literal substrings as arguments

[PeteSteinfeld]

Summary

Character literal substrings used as arguments were causing asserts. This
happened when the code was trying to get the DynamicType of the substring. We
were only recording the DynamicType of the Designator on which the substring
was based. For character literal substrings, the Designator was a character
literal, and we weren't handling getting its type.

I fixed this by changing the GetType() method for DynamicType to check to
see if we were getting the type of a Substring and calling the GetType()
method of Substring in that case. This required adding a GetType() method
to the Substring class. This, in turn, required modifying the Substring
constructors to take the kind of the base substring as an argument.

I also changed the test resolve49.f90 with some tests, one of which causes
the original crash.

[klausler]

flang/include/flang/Evaluate/variable.h

306

Why does Substring need to have an explicit kind value -- can't this always be determined by the type of the parent string?

331

Can't the type be computed from that of the Parent?

[PeteSteinfeld]

I decided it would be easier to just add the necessary functionality to
Designator<T>::GetType() rather than add a GetType() method to Substring.

[PeteSteinfeld]

Reworked the implementation of GetType() based on feedback from Peter.

[PeteSteinfeld]

I've created a cleaner version of this -- https://reviews.llvm.org/D85908.

flang/include/flang/Evaluate/variable.h

 // The base object of a substring can be a literal.
 // In the F2018 standard, substrings of array sections are parsed as
 // variants of sections instead.
 class Substring {
   using Parent = std::variant<DataRef, StaticDataObject::Pointer>;
 
 public:
   CLASS_BOILERPLATE(Substring)
-  Substring(DataRef &&parent, std::optional<Expr<SubscriptInteger>> &&lower,
+  Substring(DataRef &&parent, int kind,
+      std::optional<Expr<SubscriptInteger>> &&lower,
       std::optional<Expr<SubscriptInteger>> &&upper)
-      : parent_{std::move(parent)} {
+      : parent_{std::move(parent)}, kind_{kind} {
     SetBounds(lower, upper);
   }
-  Substring(StaticDataObject::Pointer &&parent,
+  Substring(StaticDataObject::Pointer &&parent, int kind,
       std::optional<Expr<SubscriptInteger>> &&lower,
       std::optional<Expr<SubscriptInteger>> &&upper)
-      : parent_{std::move(parent)} {
+      : parent_{std::move(parent)}, kind_{kind} {
     SetBounds(lower, upper);
   }
 
   Expr<SubscriptInteger> lower() const;
   Substring &set_lower(Expr<SubscriptInteger> &&);
   std::optional<Expr<SubscriptInteger>> upper() const;
   Substring &set_upper(Expr<SubscriptInteger> &&);
   const Parent &parent() const { return parent_; }
   Parent &parent() { return parent_; }
+  int kind() { return kind_; }
 
   int Rank() const;
   template <typename A> const A *GetParentIf() const {
     return std::get_if<A>(&parent_);
   }
+  std::optional<DynamicType> GetType() const {
+    return DynamicType(TypeCategory::Character, kind_);
+  }
   BaseObject GetBaseObject() const;
   const Symbol *GetLastSymbol() const;
   std::optional<Expr<SubscriptInteger>> LEN() const;
   bool operator==(const Substring &) const;
   llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const;
 
   std::optional<Expr<SomeCharacter>> Fold(FoldingContext &);
 
 private:
   void SetBounds(std::optional<Expr<SubscriptInteger>> &,
       std::optional<Expr<SubscriptInteger>> &);
   Parent parent_;
+  int kind_{0};
   std::optional<IndirectSubscriptIntegerExpr> lower_, upper_;
 };
 
 // R915 complex-part-designator
 // In the F2018 standard, complex parts of array sections are parsed as
 // variants of sections instead.
 class ComplexPart {
 public:

flang/lib/Evaluate/fold-designator.cpp

if (auto type{DynamicType::From(symbol)}) {
             }
           } else if (auto *cExpr{
                          std::get_if<Expr<SomeCharacter>>(&result->u)}) {
             if (offset > 0 || size != *elementBytes) {
               // Select a substring
               return std::visit(
                   [&](const auto &x) -> std::optional<Expr<SomeType>> {
                     using T = typename std::decay_t<decltype(x)>::Result;
-                    return AsGenericExpr(Designator<T>{
-                        Substring{ExtractDataRef(std::move(*cExpr)).value(),
-                            std::optional<Expr<SubscriptInteger>>{
-                                1 + (offset / T::kind)},
-                            std::optional<Expr<SubscriptInteger>>{
-                                1 + ((offset + size - 1) / T::kind)}}});
+                    return AsGenericExpr(Designator<T>{Substring{
+                        ExtractDataRef(std::move(*cExpr)).value(), T::kind,
                   },
                   cExpr->u);
             }
           }
         }
         if (offset == 0) {
           return result;
         }

flang/lib/Evaluate/fold.cpp

return std::visit(common::visitors{
       std::move(dataRef.u));
 }
 
 Substring FoldOperation(FoldingContext &context, Substring &&substring) {
   auto lower{Fold(context, substring.lower())};
   auto upper{Fold(context, substring.upper())};
   if (const DataRef * dataRef{substring.GetParentIf<DataRef>()}) {
     return Substring{FoldOperation(context, DataRef{*dataRef}),
-        std::move(lower), std::move(upper)};
+        substring.kind(), std::move(lower), std::move(upper)};
   } else {
     auto p{*substring.GetParentIf<StaticDataObject::Pointer>()};
-    return Substring{std::move(p), std::move(lower), std::move(upper)};
+    return Substring{
+        std::move(p), substring.kind(), std::move(lower), std::move(upper)};
   }
 }
 
 ComplexPart FoldOperation(FoldingContext &context, ComplexPart &&complexPart) {
   DataRef complex{complexPart.complex()};
   return ComplexPart{
       FoldOperation(context, std::move(complex)), complexPart.part()};
 }

flang/lib/Evaluate/variable.cpp

#endif
           },
       },
       u);
 }
 
 template <typename T>
 std::optional<DynamicType> Designator<T>::GetType() const {
   if constexpr (IsLengthlessIntrinsicType<Result>) {
-    return {Result::GetType()};
+    return Result::GetType();
+  } else if constexpr (Result::category == TypeCategory::Character) {
+    if (const Symbol * symbol{GetLastSymbol()}) {
+      return DynamicType::From(symbol);
+    } else if (const Substring * substring{std::get_if<Substring>(&u)}) {
+      // Only really needed for character literal substrings
+      return substring->GetType();
+    }
   } else {
     return DynamicType::From(GetLastSymbol());
   }
+  return std::nullopt;
 }
 
 static NamedEntity AsNamedEntity(const SymbolVector &x) {
   CHECK(!x.empty());
   NamedEntity result{x.front()};
   int j{0};
   for (const Symbol &symbol : x) {
     if (j++ != 0) {

flang/lib/Semantics/expression.cpp

if (std::optional<DataRef> dataRef{ExtractDataRef(std::move(*baseExpr))}) {
           std::optional<Expr<SubscriptInteger>> last{
               GetSubstringBound(std::get<1>(range.t))};
           const Symbol &symbol{checked->GetLastSymbol()};
           if (std::optional<DynamicType> dynamicType{
                   DynamicType::From(symbol)}) {
             if (dynamicType->category() == TypeCategory::Character) {
               return WrapperHelper<TypeCategory::Character, Designator,
                   Substring>(dynamicType->kind(),
-                  Substring{std::move(checked.value()), std::move(first),
-                      std::move(last)});
+                  Substring{std::move(checked.value()), dynamicType->kind(),
+                      std::move(first), std::move(last)});
             }
           }
           Say("substring may apply only to CHARACTER"_err_en_US);
         }
       }
     }
   }
   return std::nullopt;
if (auto *charExpr{std::get_if<Expr<SomeCharacter>>(&string->u)}) {
           [&](auto &&ckExpr) -> MaybeExpr {
             using Result = ResultType<decltype(ckExpr)>;
             auto *cp{std::get_if<Constant<Result>>(&ckExpr.u)};
             CHECK(DEREF(cp).size() == 1);
             StaticDataObject::Pointer staticData{StaticDataObject::Create()};
             staticData->set_alignment(Result::kind)
                 .set_itemBytes(Result::kind)
                 .Push(cp->GetScalarValue().value());
-            Substring substring{std::move(staticData), std::move(lower.value()),
+            CHECK(string->GetType());
+            Substring substring{std::move(staticData),
+                string->GetType()->kind(), std::move(lower.value()),
                 std::move(upper.value())};
             return AsGenericExpr(
                 Expr<Result>{Designator<Result>{std::move(substring)}});
           },
           std::move(charExpr->u));
     }
   }
   return std::nullopt;

flang/test/Semantics/resolve49.f90

 ! RUN: %S/test_errors.sh %s %t %f18
 ! Test section subscript
 program p1
   real :: a(10,10)
   real :: b(5,5)
   real :: c
   integer :: n
   n = 2
   b = a(1:10:n,1:n+3)
 end
 
 ! Test substring
 program p2
+  type t1(n1,n2)
+    integer,kind :: n1,n2
+    integer :: c2(iachar('ABCDEFGHIJ'(n1:n1)))
+  end type
   character :: a(10)
   character :: b(5)
   integer :: n
   n = 3
   b = a(n:7)
   b = a(n+3:)
   b = a(:n+2)
   a(n:7) = b
   a(n+3:) = b
   a(:n+2) = b
+  n = Iachar(1_'ABCDEFGHIJ'(1:1))
 end
 
 ! Test pointer assignment with bounds
 program p3
   integer, pointer :: a(:,:)
   integer, target :: b(2,2)
   integer :: n
   n = 2