[flang] Catch case of character array constructor with indeterminable length

[klausler]

Summary

F'2023 7.8 para 5 requires that an implied DO loop with no iterations
in a character array constructor should have items whose lengths are
constant expressions independent of the value of the implied DO loop
index.

[clementval]

LGTM

flang/lib/Semantics/expression.cpp

if (type_ && type_->category() == T::category) {
       if constexpr (T::category == TypeCategory::Derived) {
         if (!type_->IsUnlimitedPolymorphic()) {
           return AsMaybeExpr(ArrayConstructor<T>{type_->GetDerivedTypeSpec(),
               MakeSpecific<T>(std::move(values_))});
         }
       } else if (type_->kind() == T::kind) {
         ArrayConstructor<T> result{MakeSpecific<T>(std::move(values_))};
         if constexpr (T::category == TypeCategory::Character) {
-          if (auto len{type_->LEN()}) {
+          if (auto len{LengthIfGood()}) {
             // The ac-do-variables may be treated as constant expressions,
             // if some conditions on ac-implied-do-control hold (10.1.12 (12)).
             // At the same time, they may be treated as constant expressions
             // only in the context of the ac-implied-do, but setting
             // the character length here may result in complete elimination
             // of the ac-implied-do. For example:
             //   character(10) :: c
             //   ... len([(c(i:i), integer(8)::i = 1,4)])
             // would be evaulated into:
             //   ... int(max(0_8,i-i+1_8),kind=4)
             // with a dangling reference to the ac-do-variable.
             // Prevent this by checking for the ac-do-variable references
             // in the 'len' expression.
-            if (!ContainsAnyImpliedDoIndex(*len) && IsConstantExpr(*len)) {
-              result.set_LEN(std::move(*len));
-            }
-          }
-        }
         return AsMaybeExpr(std::move(result));
       }
     }
     return std::nullopt;
   }
 
 private:
   using ImpliedDoIntType = ResultType<ImpliedDoIndex>;
 
+  std::optional<Expr<SubscriptInteger>> LengthIfGood() const {
+    if (type_) {
+      auto len{type_->LEN()};
+      if (len && IsConstantExpr(*len) && !ContainsAnyImpliedDoIndex(*len)) {
+        return len;
+      }
+    }
+    return std::nullopt;
+  }
+  bool NeedLength() const {
+    return !explicitType_ && type_ &&
+        type_->category() == TypeCategory::Character && !LengthIfGood();
+  }
   void Push(MaybeExpr &&);
   void Add(const parser::AcValue::Triplet &);
   void Add(const parser::Expr &);
   void Add(const parser::AcImpliedDo &);
   void UnrollConstantImpliedDo(const parser::AcImpliedDo &,
       parser::CharBlock name, std::int64_t lower, std::int64_t upper,
       std::int64_t stride);
 
if (!type_) {
     // determine the type, and convert the others to that type.
     CHECK(!explicitType_);
     type_ = std::move(xType);
     constantLength_ = ToInt64(type_->length);
     values_.Push(std::move(*x));
   } else if (!explicitType_) {
     if (type_->IsTkCompatibleWith(xType) && xType.IsTkCompatibleWith(*type_)) {
       values_.Push(std::move(*x));
-      if (auto thisLen{ToInt64(xType.LEN())}) {
+      auto xLen{xType.LEN()};
+      if (auto thisLen{ToInt64(xLen)}) {
         if (constantLength_) {
           if (exprAnalyzer_.context().ShouldWarn(
                   common::LanguageFeature::DistinctArrayConstructorLengths) &&
               *thisLen != *constantLength_) {
             if (!(messageDisplayedSet_ & 1)) {
               exprAnalyzer_.Say(
                   "Character literal in array constructor without explicit "
                   "type has different length than earlier elements"_port_en_US);
               messageDisplayedSet_ |= 1;
             }
           }
           if (*thisLen > *constantLength_) {
             // Language extension: use the longest literal to determine the
             // length of the array constructor's character elements, not the
             // first, when there is no explicit type.
             *constantLength_ = *thisLen;
-            type_->length = xType.LEN();
+            type_->length = std::move(xLen);
           }
         } else {
           constantLength_ = *thisLen;
-          type_->length = xType.LEN();
+          type_->length = std::move(xLen);
         }
+      } else if (xLen && NeedLength()) {
+        type_->length = std::move(xLen);
       }
     } else {
       if (!(messageDisplayedSet_ & 2)) {
         exprAnalyzer_.Say(
             "Values in array constructor must have the same declared type "
             "when no explicit type appears"_err_en_US); // C7110
         messageDisplayedSet_ |= 2;
       }
if (exprAnalyzer_.AddImpliedDo(name, kind)) {
         exprAnalyzer_.SayAt(bounds.step.value().thing.thing.value().source,
             "The stride of an implied DO loop must not be zero"_err_en_US);
         messageDisplayedSet_ |= 0x10;
       }
       bool isConstant{cLower && cUpper && cStride && *cStride != 0};
       bool isNonemptyConstant{isConstant &&
           ((*cStride > 0 && *cLower <= *cUpper) ||
               (*cStride < 0 && *cLower >= *cUpper))};
+      bool isEmpty{isConstant && !isNonemptyConstant};
       bool unrollConstantLoop{false};
       parser::Messages buffer;
       auto saveMessagesDisplayed{messageDisplayedSet_};
       {
         auto messageRestorer{
             exprAnalyzer_.GetContextualMessages().SetMessages(buffer)};
         auto v{std::move(values_)};
         for (const auto &value :
             std::get<std::list<parser::AcValue>>(impliedDo.t)) {
           Add(value);
         }
         std::swap(v, values_);
         if (isNonemptyConstant && buffer.AnyFatalError()) {
           unrollConstantLoop = true;
         } else {
           values_.Push(ImpliedDo<SomeType>{name, std::move(*lower),
               std::move(*upper), std::move(*stride), std::move(v)});
         }
       }
+      // F'2023 7.8 p5
+      if (!(messageDisplayedSet_ & 0x100) && isEmpty && NeedLength()) {
+        exprAnalyzer_.SayAt(name,
+            "Array constructor implied DO loop has no iterations and indeterminate character length"_err_en_US);
+        messageDisplayedSet_ |= 0x100;
+      }
       if (unrollConstantLoop) {
         messageDisplayedSet_ = saveMessagesDisplayed;
         UnrollConstantImpliedDo(impliedDo, name, *cLower, *cUpper, *cStride);
       } else if (auto *messages{
                      exprAnalyzer_.GetContextualMessages().messages()}) {
         messages->Annex(std::move(buffer));
       }
       exprAnalyzer_.RemoveImpliedDo(name);

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

+! RUN: %python %S/test_errors.py %s %flang_fc1
+! Confirm enforcement of F'2023 7.8 p5
+subroutine subr(s,n)
+  character*(*) s
+  !ERROR: Array constructor implied DO loop has no iterations and indeterminate character length
+  print *, [(s(1:n),j=1,0)]
+  !ERROR: Array constructor implied DO loop has no iterations and indeterminate character length
+  print *, [(s(1:n),j=0,1,-1)]
+  !ERROR: Array constructor implied DO loop has no iterations and indeterminate character length
+  print *, [(s(1:j),j=1,0)]
+  print *, [(s(1:1),j=1,0)] ! ok
+  print *, [character(2)::(s(1:n),j=1,0)] ! ok
+  print *, [character(n)::(s(1:n),j=1,0)] ! ok
+end