[flang] Support known constant lengths in DynamicType

[klausler]

Summary

The constexpr-capable class evaluate::DynamicType represented
CHARACTER length only with a nullable pointer into the declared
parameters of types in the symbol table, which works fine for
anything with a declaration but turns out to not suffice to
describe the results of the ACHAR() and CHAR() intrinsic
functions. So extend DynamicType to also accommodate known
constant CHARACTER lengths, too; use them for ACHAR & CHAR;
clean up several use sites and fix regressions found in test.

[PeteSteinfeld]

All builds, tests, and looks good.

[jeanPerier]

Looks good to me

[mstorsjo]

FYI, this change broke compiling flang with GCC 7 on Ubuntu 18.04, with build errors like these:

In file included from /home/ubuntu/code/llvm-project/flang/include/flang/Evaluate/call.h:12:0,
                 from /home/ubuntu/code/llvm-project/flang/include/flang/Evaluate/intrinsics.h:12,
                 from /home/ubuntu/code/llvm-project/flang/lib/Evaluate/intrinsics.cpp:9:
/home/ubuntu/code/llvm-project/flang/include/flang/Evaluate/common.h:187:16: error: explicitly defaulted function ‘constexpr Fortran::evaluate::DynamicType& Fortran::evaluate::DynamicType::operator=(const Fortran::evaluate::DynamicType&)’ cannot be declared as constexpr because the implicit declaration is not constexpr:
   constexpr t &operator=(const t &) = default; \
                ^
/home/ubuntu/code/llvm-project/flang/include/flang/Evaluate/type.h:103:3: note: in expansion of macro ‘CONSTEXPR_CONSTRUCTORS_AND_ASSIGNMENTS’
   CONSTEXPR_CONSTRUCTORS_AND_ASSIGNMENTS(DynamicType)
   ^
In file included from /usr/include/c++/7/bits/node_handle.h:39:0,
                 from /usr/include/c++/7/bits/hashtable.h:37,
                 from /usr/include/c++/7/unordered_map:47,
                 from /usr/include/c++/7/functional:60,
                 from /home/ubuntu/code/llvm-project/flang/include/flang/Common/idioms.h:27,
                 from /home/ubuntu/code/llvm-project/flang/include/flang/Common/Fortran.h:15,
                 from /home/ubuntu/code/llvm-project/flang/include/flang/Evaluate/common.h:12,
                 from /home/ubuntu/code/llvm-project/flang/include/flang/Evaluate/call.h:12,
                 from /home/ubuntu/code/llvm-project/flang/include/flang/Evaluate/intrinsics.h:12,
                 from /home/ubuntu/code/llvm-project/flang/lib/Evaluate/intrinsics.cpp:9:
/usr/include/c++/7/optional:453:11: note: defaulted constructor calls non-constexpr ‘std::optional<long int>& std::optional<long int>::operator=(const std::optional<long int>&)’
     class optional
           ^~~~~~~~
/usr/include/c++/7/optional:453:11: note: ‘std::optional<long int>& std::optional<long int>::operator=(const std::optional<long int>&)’ is not usable as a constexpr function because:
/usr/include/c++/7/optional:351:7: note: defaulted constructor calls non-constexpr ‘std::_Optional_base<_Tp>& std::_Optional_base<_Tp>::operator=(const std::_Optional_base<_Tp>&) [with _Tp = long int]’
       operator=(const _Optional_base& __other)
       ^~~~~~~~

[clementval]

In D103571#2832896, @mstorsjo wrote:

FYI, this change broke compiling flang with GCC 7 on Ubuntu 18.04, with build errors like these:

In file included from /home/ubuntu/code/llvm-project/flang/include/flang/Evaluate/call.h:12:0,
                 from /home/ubuntu/code/llvm-project/flang/include/flang/Evaluate/intrinsics.h:12,
                 from /home/ubuntu/code/llvm-project/flang/lib/Evaluate/intrinsics.cpp:9:
/home/ubuntu/code/llvm-project/flang/include/flang/Evaluate/common.h:187:16: error: explicitly defaulted function ‘constexpr Fortran::evaluate::DynamicType& Fortran::evaluate::DynamicType::operator=(const Fortran::evaluate::DynamicType&)’ cannot be declared as constexpr because the implicit declaration is not constexpr:
   constexpr t &operator=(const t &) = default; \
                ^
/home/ubuntu/code/llvm-project/flang/include/flang/Evaluate/type.h:103:3: note: in expansion of macro ‘CONSTEXPR_CONSTRUCTORS_AND_ASSIGNMENTS’
   CONSTEXPR_CONSTRUCTORS_AND_ASSIGNMENTS(DynamicType)
   ^
In file included from /usr/include/c++/7/bits/node_handle.h:39:0,
                 from /usr/include/c++/7/bits/hashtable.h:37,
                 from /usr/include/c++/7/unordered_map:47,
                 from /usr/include/c++/7/functional:60,
                 from /home/ubuntu/code/llvm-project/flang/include/flang/Common/idioms.h:27,
                 from /home/ubuntu/code/llvm-project/flang/include/flang/Common/Fortran.h:15,
                 from /home/ubuntu/code/llvm-project/flang/include/flang/Evaluate/common.h:12,
                 from /home/ubuntu/code/llvm-project/flang/include/flang/Evaluate/call.h:12,
                 from /home/ubuntu/code/llvm-project/flang/include/flang/Evaluate/intrinsics.h:12,
                 from /home/ubuntu/code/llvm-project/flang/lib/Evaluate/intrinsics.cpp:9:
/usr/include/c++/7/optional:453:11: note: defaulted constructor calls non-constexpr ‘std::optional<long int>& std::optional<long int>::operator=(const std::optional<long int>&)’
     class optional
           ^~~~~~~~
/usr/include/c++/7/optional:453:11: note: ‘std::optional<long int>& std::optional<long int>::operator=(const std::optional<long int>&)’ is not usable as a constexpr function because:
/usr/include/c++/7/optional:351:7: note: defaulted constructor calls non-constexpr ‘std::_Optional_base<_Tp>& std::_Optional_base<_Tp>::operator=(const std::_Optional_base<_Tp>&) [with _Tp = long int]’
       operator=(const _Optional_base& __other)
       ^~~~~~~~

I have seen similar failure with GCC 7.4

[klausler]

I'll see whether there's a patch that can work around those old compilers. Thanks for the notification.

[klausler]

Fixed in https://reviews.llvm.org/D104731

flang/include/flang/Evaluate/fold.h

 // GetScalarConstantValue() extracts the known scalar constant value of
 // an expression, if it has one.  The value can be parenthesized.
 template <typename T, typename EXPR>
-auto GetScalarConstantValue(const EXPR &expr) -> std::optional<Scalar<T>> {
+constexpr auto GetScalarConstantValue(const EXPR &expr)
+    -> std::optional<Scalar<T>> {
   if (const Constant<T> *constant{UnwrapConstantValue<T>(expr)}) {
     return constant->GetScalarValue();
   } else {

 // Ensure that the expression has been folded beforehand when folding might
 // be required.
 template <int KIND>
-std::optional<std::int64_t> ToInt64(
+constexpr std::optional<std::int64_t> ToInt64(
     const Expr<Type<TypeCategory::Integer, KIND>> &expr) {
   if (auto scalar{
           GetScalarConstantValue<Type<TypeCategory::Integer, KIND>>(expr)}) {

flang/include/flang/Evaluate/type.h

 // directly hold anything requiring a destructor, such as an arbitrary
 // CHARACTER length type parameter expression.  Those must be derived
 // via LEN() member functions, packaged elsewhere (e.g. as in
-// ArrayConstructor), or copied from a parameter spec in the symbol table
-// if one is supplied.
+// ArrayConstructor), copied from a parameter spec in the symbol table
+// if one is supplied, or a known integer value.
 class DynamicType {
 public:
   constexpr DynamicType(TypeCategory cat, int k) : category_{cat}, kind_{k} {
     CHECK(IsValidKindOfIntrinsicType(category_, kind_));
   }
-  constexpr DynamicType(int k, const semantics::ParamValue &pv)
-      : category_{TypeCategory::Character}, kind_{k}, charLength_{&pv} {
+  DynamicType(int charKind, const semantics::ParamValue &len);
+  constexpr DynamicType(int k, std::int64_t len)
+      : category_{TypeCategory::Character}, kind_{k}, knownLength_{len} {
     CHECK(IsValidKindOfIntrinsicType(category_, kind_));
   }
   explicit constexpr DynamicType(

     CHECK(kind_ > 0);
     return kind_;
   }
-  constexpr const semantics::ParamValue *charLength() const {
-    return charLength_;
+  constexpr const semantics::ParamValue *charLengthParamValue() const {
+    return charLengthParamValue_;
+  }
+  constexpr std::optional<std::int64_t> knownLength() const {
+    return knownLength_;
   }
   std::optional<Expr<SubscriptInteger>> GetCharLength() const;
 

 
   TypeCategory category_{TypeCategory::Derived}; // overridable default
   int kind_{0};
-  const semantics::ParamValue *charLength_{nullptr};
+  const semantics::ParamValue *charLengthParamValue_{nullptr};
+  std::optional<std::int64_t> knownLength_;
   const semantics::DerivedTypeSpec *derived_{nullptr}; // TYPE(T), CLASS(T)
 };
 

flang/lib/Evaluate/characteristics.cpp

 }
 
 void TypeAndShape::AcquireLEN() {
-  if (type_.category() == TypeCategory::Character) {
-    if (const auto *param{type_.charLength()}) {
-      if (const auto &intExpr{param->GetExplicit()}) {
-        LEN_ = ConvertToType<SubscriptInteger>(common::Clone(*intExpr));
-      }
-    }
+  if (auto len{type_.GetCharLength()}) {
+    LEN_ = std::move(len);
   }
 }
 

       const DynamicType &type{typeAndShape->type()};
       switch (type.category()) {
       case TypeCategory::Character:
-        if (const auto *param{type.charLength()}) {
+        if (type.knownLength()) {
+          return true;
+        } else if (const auto *param{type.charLengthParamValue()}) {
           if (const auto &expr{param->GetExplicit()}) {
             return IsConstantExpr(*expr); // 15.4.2.2(4)(c)
           } else if (param->isAssumed()) {

flang/lib/Evaluate/formatting.cpp

   if (derived_) {
     CHECK(category_ == TypeCategory::Derived);
     return DerivedTypeSpecAsFortran(*derived_);
-  } else if (charLength_) {
+  } else if (charLengthParamValue_ || knownLength_) {
     std::string result{"CHARACTER(KIND="s + std::to_string(kind_) + ",LEN="};
-    if (charLength_->isAssumed()) {
+    if (knownLength_) {
+      result += std::to_string(*knownLength_) + "_8";
+    } else if (charLengthParamValue_->isAssumed()) {
       result += '*';
-    } else if (charLength_->isDeferred()) {
+    } else if (charLengthParamValue_->isDeferred()) {
       result += ':';
-    } else if (const auto &length{charLength_->GetExplicit()}) {
+    } else if (const auto &length{charLengthParamValue_->GetExplicit()}) {
       result += length->AsFortran();
     }
     return result + ')';

flang/lib/Evaluate/intrinsics.cpp

       CHECK(FloatingType.test(*category));
       resultType = DynamicType{*category, defaults.doublePrecisionKind()};
       break;
-    case KindCode::defaultCharKind:
-      CHECK(result.categorySet == CharType);
-      CHECK(*category == TypeCategory::Character);
-      resultType = DynamicType{TypeCategory::Character,
-          defaults.GetDefaultKind(TypeCategory::Character)};
-      break;
     case KindCode::defaultLogicalKind:
       CHECK(result.categorySet == LogicalType);
       CHECK(*category == TypeCategory::Logical);

           CHECK(expr->Rank() == 0);
           if (auto code{ToInt64(*expr)}) {
             if (IsValidKindOfIntrinsicType(*category, *code)) {
-              resultType = DynamicType{*category, static_cast<int>(*code)};
+              if (*category == TypeCategory::Character) { // ACHAR & CHAR
+                resultType = DynamicType{static_cast<int>(*code), 1};
+              } else {
+                resultType = DynamicType{*category, static_cast<int>(*code)};
+              }
               break;
             }
           }

       } else {
         CHECK(kindDummyArg->optionality ==
             Optionality::defaultsToDefaultForResult);
-        resultType = DynamicType{*category, defaults.GetDefaultKind(*category)};
+        int kind{defaults.GetDefaultKind(*category)};
+        if (*category == TypeCategory::Character) { // ACHAR & CHAR
+          resultType = DynamicType{kind, 1};
+        } else {
+          resultType = DynamicType{*category, kind};
+        }
       }
       break;
     case KindCode::likeMultiply:

       resultType =
           DynamicType{TypeCategory::Integer, defaults.sizeIntegerKind()};
       break;
+    case KindCode::defaultCharKind:
     case KindCode::typeless:
     case KindCode::teamType:
     case KindCode::any:

flang/lib/Evaluate/tools.cpp

     if (auto *cx{UnwrapExpr<Expr<SomeCharacter>>(x)}) {
       auto converted{
           ConvertToKind<TypeCategory::Character>(type.kind(), std::move(*cx))};
-      if (type.charLength()) {
-        if (const auto &len{type.charLength()->GetExplicit()}) {
-          Expr<SomeInteger> lenParam{*len};
-          Expr<SubscriptInteger> length{Convert<SubscriptInteger>{lenParam}};
-          converted = std::visit(
-              [&](auto &&x) {
-                using Ty = std::decay_t<decltype(x)>;
-                using CharacterType = typename Ty::Result;
-                return Expr<SomeCharacter>{
-                    Expr<CharacterType>{SetLength<CharacterType::kind>{
-                        std::move(x), std::move(length)}}};
-              },
-              std::move(converted.u));
-        }
+      if (auto length{type.GetCharLength()}) {
+        converted = std::visit(
+            [&](auto &&x) {
+              using Ty = std::decay_t<decltype(x)>;
+              using CharacterType = typename Ty::Result;
+              return Expr<SomeCharacter>{
+                  Expr<CharacterType>{SetLength<CharacterType::kind>{
+                      std::move(x), std::move(*length)}}};
+            },
+            std::move(converted.u));
       }
       return Expr<SomeType>{std::move(converted)};
     }

flang/lib/Evaluate/type.cpp

 
 namespace Fortran::evaluate {
 
+DynamicType::DynamicType(int k, const semantics::ParamValue &pv)
+    : category_{TypeCategory::Character}, kind_{k} {
+  CHECK(IsValidKindOfIntrinsicType(category_, kind_));
+  if (auto n{ToInt64(pv.GetExplicit())}) {
+    knownLength_ = *n;
+  } else {
+    charLengthParamValue_ = &pv;
+  }
+}
+
 template <typename A> inline bool PointeeComparison(const A *x, const A *y) {
   return x == y || (x && y && *x == *y);
 }
 
 bool DynamicType::operator==(const DynamicType &that) const {
   return category_ == that.category_ && kind_ == that.kind_ &&
-      PointeeComparison(charLength_, that.charLength_) &&
+      PointeeComparison(charLengthParamValue_, that.charLengthParamValue_) &&
+      knownLength_.has_value() == that.knownLength_.has_value() &&
+      (!knownLength_ || *knownLength_ == *that.knownLength_) &&
       PointeeComparison(derived_, that.derived_);
 }
 
 std::optional<Expr<SubscriptInteger>> DynamicType::GetCharLength() const {
-  if (category_ == TypeCategory::Character && charLength_) {
-    if (auto length{charLength_->GetExplicit()}) {
-      return ConvertToType<SubscriptInteger>(std::move(*length));
+  if (category_ == TypeCategory::Character) {
+    if (knownLength_) {
+      return AsExpr(Constant<SubscriptInteger>(*knownLength_));
+    } else if (charLengthParamValue_) {
+      if (auto length{charLengthParamValue_->GetExplicit()}) {
+        return ConvertToType<SubscriptInteger>(std::move(*length));
+      }
     }
   }
   return std::nullopt;

 }
 
 bool DynamicType::IsAssumedLengthCharacter() const {
-  return category_ == TypeCategory::Character && charLength_ &&
-      charLength_->isAssumed();
+  return category_ == TypeCategory::Character && charLengthParamValue_ &&
+      charLengthParamValue_->isAssumed();
 }
 
 bool DynamicType::IsNonConstantLengthCharacter() const {
   if (category_ != TypeCategory::Character) {
     return false;
-  } else if (!charLength_) {
+  } else if (knownLength_) {
+    return false;
+  } else if (!charLengthParamValue_) {
     return true;
-  } else if (const auto &expr{charLength_->GetExplicit()}) {
+  } else if (const auto &expr{charLengthParamValue_->GetExplicit()}) {
     return !IsConstantExpr(*expr);
   } else {
     return true;

       }
     }
   }
-  return charLength_ && charLength_->isDeferred();
+  return charLengthParamValue_ && charLengthParamValue_->isDeferred();
 }
 
 bool SomeKind<TypeCategory::Derived>::operator==(

flang/lib/Evaluate/variable.cpp

       return chExpr->LEN();
     }
   } else if (auto dyType{DynamicType::From(ultimate)}) {
-    if (const semantics::ParamValue * len{dyType->charLength()}) {
-      if (len->isExplicit()) {
-        if (auto intExpr{len->GetExplicit()}) {
-          if (IsConstantExpr(*intExpr)) {
-            return ConvertToType<SubscriptInteger>(*std::move(intExpr));
-          }
-        }
-      }
-      if (IsDescriptor(ultimate) && !ultimate.owner().IsDerivedType()) {
-        return Expr<SubscriptInteger>{DescriptorInquiry{
-            NamedEntity{ultimate}, DescriptorInquiry::Field::Len}};
-      }
+    if (auto len{dyType->GetCharLength()}) {
+      return len;
+    } else if (IsDescriptor(ultimate) && !ultimate.owner().IsDerivedType()) {
+      return Expr<SubscriptInteger>{DescriptorInquiry{
+          NamedEntity{ultimate}, DescriptorInquiry::Field::Len}};
     }
   }
   return std::nullopt;

             return c.value().LEN();
           },
           [](const SpecificIntrinsic &i) -> T {
-            if (i.name == "char") {
-              return Expr<SubscriptInteger>{1};
-            }
-            // Some other cases whose results' lengths can be determined
+            // Some cases whose results' lengths can be determined
             // from the lengths of their arguments are handled in
-            // ProcedureRef::LEN().
+            // ProcedureRef::LEN() before coming here.
+            if (const auto &result{i.characteristics.value().functionResult}) {
+              if (const auto *type{result->GetTypeAndShape()}) {
+                if (auto length{type->type().GetCharLength()}) {
+                  return std::move(*length);
+                }
+              }
+            }
             return std::nullopt;
           },
       },

flang/lib/Semantics/expression.cpp

 std::optional<Expr<SubscriptInteger>> DynamicTypeWithLength::LEN() const {
   if (length) {
     return length;
+  } else {
+    return GetCharLength();
   }
-  if (auto *lengthParam{charLength()}) {
-    if (const auto &len{lengthParam->GetExplicit()}) {
-      return ConvertToType<SubscriptInteger>(common::Clone(*len));
-    }
-  }
-  return std::nullopt; // assumed or deferred length
 }
 
 static std::optional<DynamicTypeWithLength> AnalyzeTypeSpec(

   template <typename T> Result Test() {
     if (type_ && type_->category() == T::category) {
       if constexpr (T::category == TypeCategory::Derived) {
-        if (type_->IsUnlimitedPolymorphic()) {
-          return std::nullopt;
-        } else {
+        if (!type_->IsUnlimitedPolymorphic()) {
           return AsMaybeExpr(ArrayConstructor<T>{type_->GetDerivedTypeSpec(),
               MakeSpecific<T>(std::move(values_))});
         }

       constantLength_ = ToInt64(type_->length);
       values_.Push(std::move(*x));
     } else if (!explicitType_) {
-      if (static_cast<const DynamicType &>(*type_) ==
-          static_cast<const DynamicType &>(xType)) {
+      if (type_->IsTkCompatibleWith(xType) &&
+          xType.IsTkCompatibleWith(*type_)) {
         values_.Push(std::move(*x));
         if (auto thisLen{ToInt64(xType.LEN())}) {
           if (constantLength_) {

flang/lib/Semantics/scope.cpp

       case TypeCategory::Complex:
         return &MakeNumericType(dyType->category(), KindExpr{dyType->kind()});
       case TypeCategory::Character:
-        if (const ParamValue * lenParam{dyType->charLength()}) {
+        if (const ParamValue * lenParam{dyType->charLengthParamValue()}) {
           return &MakeCharacterType(
               ParamValue{*lenParam}, KindExpr{dyType->kind()});
         } else {

flang/test/Semantics/array-constr-values.f90

        (0.0, iDuplicate = j,3 ), &
         j = 1,5 ) ]
 end subroutine
+subroutine charLengths(c, array)
+  character(3) :: c
+  character(3) :: array(2)
+  !No error should ensue for distinct but compatible DynamicTypes
+  array = ["abc", c]
+end subroutine

flang/test/Semantics/data02.f90

     character(1) :: c
   end type
   type(t) :: x
-  !ERROR: Value in structure constructor of type INTEGER(4) is incompatible with component 'c' of type CHARACTER(KIND=1,LEN=1_4)
+  !ERROR: Value in structure constructor of type INTEGER(4) is incompatible with component 'c' of type CHARACTER(KIND=1,LEN=1_8)
   data x /t(1)/
 end
 

flang/test/Semantics/separate-mp02.f90

   end
   module subroutine s9(x, y, z, w)
     character(len=4) :: x
-    !ERROR: Dummy argument 'y' has type CHARACTER(KIND=1,LEN=5_4); the corresponding argument in the interface body has type CHARACTER(KIND=1,LEN=4_4)
+    !ERROR: Dummy argument 'y' has type CHARACTER(KIND=1,LEN=5_8); the corresponding argument in the interface body has type CHARACTER(KIND=1,LEN=4_8)
     character(len=5) :: y
     character(len=*) :: z
-    !ERROR: Dummy argument 'w' has type CHARACTER(KIND=1,LEN=4_4); the corresponding argument in the interface body has type CHARACTER(KIND=1,LEN=*)
+    !ERROR: Dummy argument 'w' has type CHARACTER(KIND=1,LEN=4_8); the corresponding argument in the interface body has type CHARACTER(KIND=1,LEN=*)
     character(len=4) :: w
   end
 end