[flang] Fix CHARACTER length folding problem

Do not rewrite LEN(x) or x%len to the expression that specifies
the length of x when that length is not a constant expression.
Its value may have changed since the value of the expression was
first captured in the definition of the object.

Reviewed By: tskeith, sscalpone

Differential Revision: https://reviews.llvm.org/D83352

flang/include/flang/Evaluate/type.h

@@ -146,7 +146,7 @@ public:
   DynamicType ResultTypeForMultiply(const DynamicType &) const;
 
   bool IsAssumedLengthCharacter() const;
-  bool IsUnknownLengthCharacter() const;
+  bool IsNonConstantLengthCharacter() const;
   bool IsTypelessIntrinsicArgument() const;
   constexpr bool IsAssumedType() const { // TYPE(*)
     return kind_ == AssumedTypeKind;

flang/lib/Evaluate/fold-integer.cpp

@@ -612,7 +612,9 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldOperation(
         if (iter != scope->end()) {
           const Symbol &symbol{*iter->second};
           const auto *details{symbol.detailsIf<semantics::TypeParamDetails>()};
-          if (details && details->init()) {
+          if (details && details->init() &&
+              (details->attr() == common::TypeParamAttr::Kind ||
+                  IsConstantExpr(*details->init()))) {
             Expr<SomeInteger> expr{*details->init()};
             return Fold(context,
                 Expr<IntKIND>{

flang/lib/Evaluate/shape.cpp

@@ -205,7 +205,7 @@ auto GetLowerBoundHelper::operator()(const Symbol &symbol0) -> Result {
       if (j++ == dimension_) {
         if (const auto &bound{shapeSpec.lbound().GetExplicit()}) {
           return Fold(context_, common::Clone(*bound));
-        } else if (semantics::IsDescriptor(symbol)) {
+        } else if (IsDescriptor(symbol)) {
           return ExtentExpr{DescriptorInquiry{NamedEntity{symbol0},
               DescriptorInquiry::Field::LowerBound, dimension_}};
         } else {
@@ -230,7 +230,7 @@ auto GetLowerBoundHelper::operator()(const Component &component) -> Result {
         if (j++ == dimension_) {
           if (const auto &bound{shapeSpec.lbound().GetExplicit()}) {
             return Fold(context_, common::Clone(*bound));
-          } else if (semantics::IsDescriptor(symbol)) {
+          } else if (IsDescriptor(symbol)) {
             return ExtentExpr{
                 DescriptorInquiry{NamedEntity{common::Clone(component)},
                     DescriptorInquiry::Field::LowerBound, dimension_}};

flang/lib/Evaluate/type.cpp

@@ -22,17 +22,21 @@
 
 // IsDescriptor() predicate: true when a symbol is implemented
 // at runtime with a descriptor.
-// TODO there's probably a better place for this predicate than here
 namespace Fortran::semantics {
 
-static bool IsDescriptor(const ObjectEntityDetails &details) {
+static bool IsDescriptor(const DeclTypeSpec *type) {
-  if (const auto *type{details.type()}) {
+  if (type) {
     if (auto dynamicType{evaluate::DynamicType::From(*type)}) {
-      if (dynamicType->RequiresDescriptor()) {
+      return dynamicType->RequiresDescriptor();
-        return true;
-      }
     }
   }
+  return false;
+}
+
+static bool IsDescriptor(const ObjectEntityDetails &details) {
+  if (IsDescriptor(details.type())) {
+    return true;
+  }
   // TODO: Automatic (adjustable) arrays - are they descriptors?
   for (const ShapeSpec &shapeSpec : details.shape()) {
     const auto &lb{shapeSpec.lbound().GetExplicit()};
@@ -62,6 +66,7 @@ bool IsDescriptor(const Symbol &symbol) {
                        symbol.attrs().test(Attr::EXTERNAL)) &&
                 IsDescriptor(d);
           },
+          [&](const EntityDetails &d) { return IsDescriptor(d.type()); },
           [](const AssocEntityDetails &d) {
             if (const auto &expr{d.expr()}) {
               if (expr->Rank() > 0) {
@@ -149,7 +154,7 @@ bool DynamicType::IsAssumedLengthCharacter() const {
       charLength_->isAssumed();
 }
 
-bool DynamicType::IsUnknownLengthCharacter() const {
+bool DynamicType::IsNonConstantLengthCharacter() const {
   if (category_ != TypeCategory::Character) {
     return false;
   } else if (!charLength_) {
@@ -471,7 +476,7 @@ DynamicType DynamicType::ResultTypeForMultiply(const DynamicType &that) const {
 }
 
 bool DynamicType::RequiresDescriptor() const {
-  return IsPolymorphic() || IsUnknownLengthCharacter() ||
+  return IsPolymorphic() || IsNonConstantLengthCharacter() ||
       (derived_ && CountNonConstantLenParameters(*derived_) > 0);
 }
 

flang/lib/Evaluate/variable.cpp

@@ -8,6 +8,7 @@
 
 #include "flang/Evaluate/variable.h"
 #include "flang/Common/idioms.h"
+#include "flang/Evaluate/check-expression.h"
 #include "flang/Evaluate/fold.h"
 #include "flang/Evaluate/tools.h"
 #include "flang/Parser/char-block.h"
@@ -259,16 +260,13 @@ static std::optional<Expr<SubscriptInteger>> SymbolLEN(const Symbol &sym) {
     if (const semantics::ParamValue * len{dyType->charLength()}) {
       if (len->isExplicit()) {
         if (auto intExpr{len->GetExplicit()}) {
-          return ConvertToType<SubscriptInteger>(*std::move(intExpr));
+          if (IsConstantExpr(*intExpr)) {
-        } else {
+            return ConvertToType<SubscriptInteger>(*std::move(intExpr));
-          // There was an error constructing this symbol's type.  It should
+          }
-          // have a length expression, but we couldn't retrieve it
-          return std::nullopt;
         }
-      } else {
-        return Expr<SubscriptInteger>{
-            DescriptorInquiry{NamedEntity{sym}, DescriptorInquiry::Field::Len}};
       }
+      return Expr<SubscriptInteger>{
+          DescriptorInquiry{NamedEntity{sym}, DescriptorInquiry::Field::Len}};
     }
   }
   return std::nullopt;