[flang] Track CHARACTER length better in TypeAndShape

[klausler]

Summary

CHARACTER length expressions were not always being
captured or computed as part of procedure "characteristics",
leading to test failures due to an inability to compute
memory size expressions accurately.

[klausler]

ping

[jeanPerier]

Looks good to me.

flang/include/flang/Evaluate/characteristics.h

public:
   bool operator==(const TypeAndShape &) const;
   bool operator!=(const TypeAndShape &that) const { return !(*this == that); }
 
   static std::optional<TypeAndShape> Characterize(
       const semantics::Symbol &, FoldingContext &);
   static std::optional<TypeAndShape> Characterize(
       const semantics::ObjectEntityDetails &);
   static std::optional<TypeAndShape> Characterize(
-      const semantics::AssocEntityDetails &, FoldingContext &);
-  static std::optional<TypeAndShape> Characterize(
-      const semantics::ProcEntityDetails &);
-  static std::optional<TypeAndShape> Characterize(
       const semantics::ProcInterface &);
   static std::optional<TypeAndShape> Characterize(
       const semantics::DeclTypeSpec &);
   static std::optional<TypeAndShape> Characterize(
       const ActualArgument &, FoldingContext &);
 
   template <typename A>
   static std::optional<TypeAndShape> Characterize(
       const A &x, FoldingContext &context) {
     if (const auto *symbol{UnwrapWholeSymbolDataRef(x)}) {
       if (auto result{Characterize(*symbol, context)}) {
         return result;
       }
     }
     if (auto type{x.GetType()}) {
       if (auto shape{GetShape(context, x)}) {
         TypeAndShape result{*type, std::move(*shape)};
         if (type->category() == TypeCategory::Character) {
           if (const auto *chExpr{UnwrapExpr<Expr<SomeCharacter>>(x)}) {
             if (auto length{chExpr->LEN()}) {
-              result.set_LEN(Expr<SomeInteger>{std::move(*length)});
+              result.set_LEN(Fold(context, std::move(*length)));
             }
           }
         }
         return result;
       }
     }
     return std::nullopt;
   }
static std::optional<TypeAndShape> Characterize(
     }
   }
 
   DynamicType type() const { return type_; }
   TypeAndShape &set_type(DynamicType t) {
     type_ = t;
     return *this;
   }
-  const std::optional<Expr<SomeInteger>> &LEN() const { return LEN_; }
-  TypeAndShape &set_LEN(Expr<SomeInteger> &&len) {
+  const std::optional<Expr<SubscriptInteger>> &LEN() const { return LEN_; }
+  TypeAndShape &set_LEN(Expr<SubscriptInteger> &&len) {
     LEN_ = std::move(len);
     return *this;
   }
   const Shape &shape() const { return shape_; }
   const Attrs &attrs() const { return attrs_; }
   int corank() const { return corank_; }
 
   int Rank() const { return GetRank(shape_); }
   bool IsCompatibleWith(parser::ContextualMessages &, const TypeAndShape &that,
       const char *thisIs = "POINTER", const char *thatIs = "TARGET",
       bool isElemental = false) const;
+  std::optional<Expr<SubscriptInteger>> MeasureSizeInBytes(
+      FoldingContext * = nullptr) const;
 
   llvm::raw_ostream &Dump(llvm::raw_ostream &) const;
 
 private:
+  static std::optional<TypeAndShape> Characterize(
+      const semantics::AssocEntityDetails &, FoldingContext &);
+  static std::optional<TypeAndShape> Characterize(
+      const semantics::ProcEntityDetails &);
   void AcquireShape(const semantics::ObjectEntityDetails &);
   void AcquireLEN();
 
 protected:
   DynamicType type_;
-  std::optional<Expr<SomeInteger>> LEN_;
+  std::optional<Expr<SubscriptInteger>> LEN_;
   Shape shape_;
   Attrs attrs_;
   int corank_{0};
 };
 
 // 15.3.2.2
 struct DummyDataObject {
   ENUM_CLASS(Attr, Optional, Allocatable, Asynchronous, Contiguous, Value,

flang/lib/Evaluate/characteristics.cpp

return type_ == that.type_ && ShapesAreCompatible(shape_, that.shape_) &&
       attrs_ == that.attrs_ && corank_ == that.corank_;
 }
 
 std::optional<TypeAndShape> TypeAndShape::Characterize(
     const semantics::Symbol &symbol, FoldingContext &context) {
   return std::visit(
       common::visitors{
           [&](const semantics::ObjectEntityDetails &object) {
-            return Characterize(object);
+            auto result{Characterize(object)};
+            if (result &&
+                result->type().category() == TypeCategory::Character) {
+              if (auto len{DataRef{symbol}.LEN()}) {
+                result->set_LEN(Fold(context, std::move(*len)));
+              }
+            }
+            return result;
           },
           [&](const semantics::ProcEntityDetails &proc) {
             const semantics::ProcInterface &interface{proc.interface()};
             if (interface.type()) {
               return Characterize(*interface.type());
             } else if (interface.symbol()) {
               return Characterize(*interface.symbol(), context);
             } else {
if (auto type{DynamicType::From(object.type())}) {
     return std::nullopt;
   }
 }
 
 std::optional<TypeAndShape> TypeAndShape::Characterize(
     const semantics::AssocEntityDetails &assoc, FoldingContext &context) {
   if (auto type{DynamicType::From(assoc.type())}) {
     if (auto shape{GetShape(context, assoc.expr())}) {
-      return TypeAndShape{std::move(*type), std::move(*shape)};
+      TypeAndShape result{std::move(*type), std::move(*shape)};
+      if (type->category() == TypeCategory::Character) {
+        if (const auto *chExpr{UnwrapExpr<Expr<SomeCharacter>>(assoc.expr())}) {
+          if (auto len{chExpr->LEN()}) {
+            result.set_LEN(Fold(context, std::move(*len)));
+          }
+        }
+      }
+      return std::move(result);
     }
   }
   return std::nullopt;
 }
 
 std::optional<TypeAndShape> TypeAndShape::Characterize(
     const semantics::DeclTypeSpec &spec) {
   if (auto type{DynamicType::From(spec)}) {
     return TypeAndShape{std::move(*type)};
   } else {
     return std::nullopt;
   }
 }
 
 std::optional<TypeAndShape> TypeAndShape::Characterize(
     const ActualArgument &arg, FoldingContext &context) {
   return Characterize(arg.UnwrapExpr(), context);
 }
 
 bool TypeAndShape::IsCompatibleWith(parser::ContextualMessages &messages,
     const TypeAndShape &that, const char *thisIs, const char *thatIs,
     bool isElemental) const {
-  const auto &len{that.LEN()};
   if (!type_.IsTkCompatibleWith(that.type_)) {
+    const auto &len{that.LEN()};
     messages.Say(
         "%1$s type '%2$s' is not compatible with %3$s type '%4$s'"_err_en_US,
         thatIs, that.type_.AsFortran(len ? len->AsFortran() : ""), thisIs,
-        type_.AsFortran());
+        type_.AsFortran(LEN_ ? LEN_->AsFortran() : ""));
     return false;
   }
   return isElemental ||
       CheckConformance(messages, shape_, that.shape_, thisIs, thatIs);
 }
 
+std::optional<Expr<SubscriptInteger>> TypeAndShape::MeasureSizeInBytes(
+    FoldingContext *foldingContext) const {
+  if (type_.category() == TypeCategory::Character && LEN_) {
+    Expr<SubscriptInteger> result{
+        common::Clone(*LEN_) * Expr<SubscriptInteger>{type_.kind()}};
+    if (foldingContext) {
+      result = Fold(*foldingContext, std::move(result));
+    }
+    return result;
+  } else {
+    return type_.MeasureSizeInBytes(foldingContext);
+  }
+}
+
 void TypeAndShape::AcquireShape(const semantics::ObjectEntityDetails &object) {
   CHECK(shape_.empty() && !attrs_.test(Attr::AssumedRank));
   corank_ = object.coshape().Rank();
   if (object.IsAssumedRank()) {
     attrs_.set(Attr::AssumedRank);
     return;
   }
   if (object.IsAssumedShape()) {
for (const semantics::ShapeSpec &dim : object.shape()) {
     }
   }
 }
 
 void TypeAndShape::AcquireLEN() {
   if (type_.category() == TypeCategory::Character) {
     if (const auto *param{type_.charLength()}) {
       if (const auto &intExpr{param->GetExplicit()}) {
-        LEN_ = *intExpr;
+        LEN_ = ConvertToType<SubscriptInteger>(common::Clone(*intExpr));
       }
     }
   }
 }
 
 llvm::raw_ostream &TypeAndShape::Dump(llvm::raw_ostream &o) const {
   o << type_.AsFortran(LEN_ ? LEN_->AsFortran() : "");
   attrs_.Dump(o, EnumToString);

 FunctionResult::~FunctionResult() {}
 
 bool FunctionResult::operator==(const FunctionResult &that) const {
   return attrs == that.attrs && u == that.u;
 }
 
 std::optional<FunctionResult> FunctionResult::Characterize(
     const Symbol &symbol, const IntrinsicProcTable &intrinsics) {
-  if (const auto *obj{symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
-    if (auto type{TypeAndShape::Characterize(*obj)}) {
+  if (const auto *object{symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
+    if (auto type{TypeAndShape::Characterize(*object)}) {
       FunctionResult result{std::move(*type)};
       CopyAttrs<FunctionResult, FunctionResult::Attr>(symbol, result,
           {
               {semantics::Attr::ALLOCATABLE, FunctionResult::Attr::Allocatable},
               {semantics::Attr::CONTIGUOUS, FunctionResult::Attr::Contiguous},
               {semantics::Attr::POINTER, FunctionResult::Attr::Pointer},
           });
       return result;

flang/lib/Evaluate/shape.cpp

if (intrinsic->name == "shape" || intrinsic->name == "lbound" ||
           // SIZE= is absent and MOLD= is array: result is vector whose
           // length is determined by sizes of types.  See 16.9.193p4 case(ii).
           if (auto sourceTypeAndShape{
                   characteristics::TypeAndShape::Characterize(
                       call.arguments().at(0), context_)}) {
             auto sourceElements{
                 GetSize(common::Clone(sourceTypeAndShape->shape()))};
             auto sourceElementBytes{
-                sourceTypeAndShape->type().MeasureSizeInBytes(&context_)};
+                sourceTypeAndShape->MeasureSizeInBytes(&context_)};
             auto moldElementBytes{
-                moldTypeAndShape->type().MeasureSizeInBytes(&context_)};
+                moldTypeAndShape->MeasureSizeInBytes(&context_)};
             if (sourceElements && sourceElementBytes && moldElementBytes) {
               ExtentExpr extent{Fold(context_,
                   ((std::move(*sourceElements) *
                        std::move(*sourceElementBytes)) +
                       common::Clone(*moldElementBytes) - ExtentExpr{1}) /
                       common::Clone(*moldElementBytes))};
               return Shape{MaybeExtentExpr{std::move(extent)}};
             }

flang/lib/Semantics/check-call.cpp

if (const auto *expr{arg.UnwrapExpr()}) {
     }
   }
 }
 
 // When scalar CHARACTER actual arguments are known to be short,
 // we extend them on the right with spaces and a warning.
 static void PadShortCharacterActual(evaluate::Expr<evaluate::SomeType> &actual,
     const characteristics::TypeAndShape &dummyType,
-    const characteristics::TypeAndShape &actualType,
-    parser::ContextualMessages &messages) {
+    characteristics::TypeAndShape &actualType,
+    evaluate::FoldingContext &context, parser::ContextualMessages &messages) {
   if (dummyType.type().category() == TypeCategory::Character &&
       actualType.type().category() == TypeCategory::Character &&
       dummyType.type().kind() == actualType.type().kind() &&
       GetRank(actualType.shape()) == 0) {
-    if (auto dummyLEN{ToInt64(dummyType.LEN())}) {
-      if (auto actualLEN{ToInt64(actualType.LEN())}) {
-        if (*actualLEN < *dummyLEN) {
-          messages.Say(
-              "Actual length '%jd' is less than expected length '%jd'"_en_US,
-              *actualLEN, *dummyLEN);
-          auto converted{ConvertToType(dummyType.type(), std::move(actual))};
-          CHECK(converted);
-          actual = std::move(*converted);
-        }
+    if (dummyType.LEN() && actualType.LEN()) {
+      auto dummyLength{ToInt64(Fold(context, common::Clone(*dummyType.LEN())))};
+      auto actualLength{
+          ToInt64(Fold(context, common::Clone(*actualType.LEN())))};
+      if (dummyLength && actualLength && *actualLength < *dummyLength) {
+            *actualLength, *dummyLength);
+        actualType.set_LEN(SubscriptIntExpr{*dummyLength});
       }
     }
   }
 }
 
 // Automatic conversion of different-kind INTEGER scalar actual
 // argument expressions (not variables) to INTEGER scalar dummies.
 // We return nonstandard INTEGER(8) results from intrinsic functions

 static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
     const std::string &dummyName, evaluate::Expr<evaluate::SomeType> &actual,
     characteristics::TypeAndShape &actualType, bool isElemental,
     bool actualIsArrayElement, evaluate::FoldingContext &context,
     const Scope *scope) {
 
   // Basic type & rank checking
   parser::ContextualMessages &messages{context.messages()};
-  PadShortCharacterActual(actual, dummy.type, actualType, messages);
+  PadShortCharacterActual(actual, dummy.type, actualType, context, messages);
   ConvertIntegerActual(actual, dummy.type, actualType, messages);
   bool typesCompatible{dummy.type.type().IsTkCompatibleWith(actualType.type())};
   if (typesCompatible) {
     if (isElemental) {
     } else if (dummy.type.attrs().test(
                    characteristics::TypeAndShape::Attr::AssumedRank)) {
     } else if (!dummy.type.attrs().test(
                    characteristics::TypeAndShape::Attr::AssumedShape) &&