[flang] Fix CHARACTER length folding problem

[klausler]

Summary

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.

flang/include/flang/Evaluate/type.h

public:
   std::optional<common::ConstantSubscript> GetCharLength() const;
   std::optional<std::size_t> MeasureSizeInBytes() const;
 
   std::string AsFortran() const;
   std::string AsFortran(std::string &&charLenExpr) const;
   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;
   }
   constexpr bool IsPolymorphic() const { // TYPE(*) or CLASS()
     return kind_ == ClassKind || IsAssumedType();
   }
   constexpr bool IsUnlimitedPolymorphic() const { // TYPE(*) or CLASS(*)

flang/lib/Evaluate/fold-integer.cpp

Expr<Type<TypeCategory::Integer, KIND>> FoldOperation(
   if (!inquiry.base()) {
     // A "bare" type parameter: replace with its value, if that's now known.
     if (const auto *pdt{context.pdtInstance()}) {
       if (const semantics::Scope * scope{context.pdtInstance()->scope()}) {
         auto iter{scope->find(inquiry.parameter().name())};
         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>{
                     Convert<IntKIND, TypeCategory::Integer>(std::move(expr))});
           }
         }
       }
       if (const auto *value{pdt->FindParameter(inquiry.parameter().name())}) {

flang/lib/Evaluate/shape.cpp

 auto GetLowerBoundHelper::operator()(const Symbol &symbol0) -> Result {
   const Symbol &symbol{symbol0.GetUltimate()};
   if (const auto *details{symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
     int j{0};
     for (const auto &shapeSpec : details->shape()) {
       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 {
           break;
         }
       }
     }
   } else if (const auto *assoc{
                  symbol.detailsIf<semantics::AssocEntityDetails>()}) {
     return (*this)(assoc->expr());
   }
   return Default();
 }
 
 auto GetLowerBoundHelper::operator()(const Component &component) -> Result {
   if (component.base().Rank() == 0) {
     const Symbol &symbol{component.GetLastSymbol().GetUltimate()};
     if (const auto *details{
             symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
       int j{0};
       for (const auto &shapeSpec : details->shape()) {
         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_}};
           } else {
             break;
           }
         }
       }

flang/lib/Evaluate/type.cpp

 #include "flang/Semantics/tools.h"
 #include "flang/Semantics/type.h"
 #include <algorithm>
 #include <optional>
 #include <string>
 
 // 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) {
-  if (const auto *type{details.type()}) {
+static bool IsDescriptor(const DeclTypeSpec *type) {
+  if (type) {
     if (auto dynamicType{evaluate::DynamicType::From(*type)}) {
-      if (dynamicType->RequiresDescriptor()) {
-        return true;
-      }
-    }
+      return dynamicType->RequiresDescriptor();
+    }
+  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()};
     const auto &ub{shapeSpec.ubound().GetExplicit()};
     if (!lb || !ub || !IsConstantExpr(*lb) || !IsConstantExpr(*ub)) {
       return true;
     }
return std::visit(
           [&](const ObjectEntityDetails &d) {
             return IsAllocatableOrPointer(symbol) || IsDescriptor(d);
           },
           [&](const ProcEntityDetails &d) {
             return (symbol.attrs().test(Attr::POINTER) ||
                        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) {
                 return true;
               }
               if (const auto dynamicType{expr->GetType()}) {
                 if (dynamicType->RequiresDescriptor()) {
                   return true;
std::optional<std::size_t> DynamicType::MeasureSizeInBytes() const {
   return std::nullopt;
 }
 
 bool DynamicType::IsAssumedLengthCharacter() const {
   return category_ == TypeCategory::Character && charLength_ &&
       charLength_->isAssumed();
 }
 
-bool DynamicType::IsUnknownLengthCharacter() const {
+bool DynamicType::IsNonConstantLengthCharacter() const {
   if (category_ != TypeCategory::Character) {
     return false;
   } else if (!charLength_) {
     return true;
   } else if (const auto &expr{charLength_->GetExplicit()}) {
     return !IsConstantExpr(*expr);
   } else {
     return true;
case TypeCategory::Logical:
     break;
   default:
     CRASH_NO_CASE;
   }
   return *this;
 }
 
 bool DynamicType::RequiresDescriptor() const {
-  return IsPolymorphic() || IsUnknownLengthCharacter() ||
+  return IsPolymorphic() || IsNonConstantLengthCharacter() ||
       (derived_ && CountNonConstantLenParameters(*derived_) > 0);
 }
 
 bool DynamicType::HasDeferredTypeParameter() const {
   if (derived_) {
     for (const auto &pair : derived_->parameters()) {
       if (pair.second.isDeferred()) {
         return true;

flang/lib/Evaluate/variable.cpp

 //===-- lib/Evaluate/variable.cpp -----------------------------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 #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"
 #include "flang/Parser/characters.h"
 #include "flang/Parser/message.h"
 #include "flang/Semantics/symbol.h"
 #include <type_traits>
 

 }
 
 // LEN()
 static std::optional<Expr<SubscriptInteger>> SymbolLEN(const Symbol &sym) {
   if (auto dyType{DynamicType::From(sym)}) {
     if (const semantics::ParamValue * len{dyType->charLength()}) {
       if (len->isExplicit()) {
         if (auto intExpr{len->GetExplicit()}) {
+          if (IsConstantExpr(*intExpr)) {
             return ConvertToType<SubscriptInteger>(*std::move(intExpr));
-        } else {
-          // 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 std::nullopt;
 }
 
 std::optional<Expr<SubscriptInteger>> BaseObject::LEN() const {
   return std::visit(
       common::visitors{
           [](const Symbol &symbol) { return SymbolLEN(symbol); },
           [](const StaticDataObject::Pointer &object)