[flang-commits] [flang] 53bf28b - [flang] Track CHARACTER length better in TypeAndShape

peter klausler via flang-commits flang-commits at lists.llvm.org
Tue Oct 6 08:51:59 PDT 2020


Author: peter klausler
Date: 2020-10-06T08:45:46-07:00
New Revision: 53bf28b80cf9fec53c807922b19e0af2832dfeba

URL: https://github.com/llvm/llvm-project/commit/53bf28b80cf9fec53c807922b19e0af2832dfeba
DIFF: https://github.com/llvm/llvm-project/commit/53bf28b80cf9fec53c807922b19e0af2832dfeba.diff

LOG: [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

Added: 
    

Modified: 
    flang/include/flang/Evaluate/characteristics.h
    flang/lib/Evaluate/characteristics.cpp
    flang/lib/Evaluate/shape.cpp
    flang/lib/Semantics/check-call.cpp

Removed: 
    


################################################################################
diff  --git a/flang/include/flang/Evaluate/characteristics.h b/flang/include/flang/Evaluate/characteristics.h
index bde734cd510d..5d3058694cf9 100644
--- a/flang/include/flang/Evaluate/characteristics.h
+++ b/flang/include/flang/Evaluate/characteristics.h
@@ -83,10 +83,6 @@ class TypeAndShape {
       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(
@@ -108,7 +104,7 @@ class TypeAndShape {
         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 @@ class TypeAndShape {
     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 @@ class TypeAndShape {
   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 a28f4dd004cc..3206f0a25208 100644
--- 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 eb5ec8367670..bfc2447bd300 100644
--- 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 7e1d57cf579e..74cf2f89479a 100644
--- 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) {


        


More information about the flang-commits mailing list