[flang] Track CHARACTER length better in TypeAndShape

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.

Differential revision: https://reviews.llvm.org/D88689

diff --git a/flang/include/flang/Evaluate/characteristics.h b/flang/include/flang/Evaluate/characteristics.h
index bde734c..5d30586 100644 (file)
--- a/flang/include/flang/Evaluate/characteristics.h
+++ b/flang/include/flang/Evaluate/characteristics.h
@@ -84,10 +84,6 @@ public:
   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 &);
@@ -108,7 +104,7 @@ public:
         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)));
             }
           }
         }
@@ -141,8 +137,8 @@ public:
     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;
   }
@@ -154,16 +150,22 @@ public:
   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};

diff --git a/flang/lib/Evaluate/characteristics.cpp b/flang/lib/Evaluate/characteristics.cpp
index a28f4dd..3206f0a 100644 (file)
--- a/flang/lib/Evaluate/characteristics.cpp
+++ b/flang/lib/Evaluate/characteristics.cpp
@@ -65,7 +65,14 @@ std::optional<TypeAndShape> TypeAndShape::Characterize(
   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()};
@@ -106,7 +113,15 @@ 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;
@@ -129,18 +144,32 @@ std::optional<TypeAndShape> TypeAndShape::Characterize(
 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();
@@ -178,7 +207,7 @@ 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));
       }
     }
   }
@@ -445,8 +474,8 @@ bool FunctionResult::operator==(const FunctionResult &that) const {
 
 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,
           {

diff --git a/flang/lib/Evaluate/shape.cpp b/flang/lib/Evaluate/shape.cpp
index eb5ec83..bfc2447 100644 (file)
--- a/flang/lib/Evaluate/shape.cpp
+++ b/flang/lib/Evaluate/shape.cpp
@@ -649,9 +649,9 @@ auto GetShapeHelper::operator()(const ProcedureRef &call) const -> Result {
             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) *

diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index 7e1d57c..74cf2f8 100644 (file)
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -74,22 +74,24 @@ static void CheckImplicitInterfaceArg(
 // 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) {
+        messages.Say(
+            "Actual length '%jd' is less than expected length '%jd'"_en_US,
+            *actualLength, *dummyLength);
+        auto converted{ConvertToType(dummyType.type(), std::move(actual))};
+        CHECK(converted);
+        actual = std::move(*converted);
+        actualType.set_LEN(SubscriptIntExpr{*dummyLength});
       }
     }
   }
@@ -142,7 +144,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
 
   // 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) {