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

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.

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

2 files changed, 42 insertions, 7 deletions

diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index be67ae8..777ef3b 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -1474,7 +1474,7 @@ public:
       } 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
@@ -1488,9 +1488,7 @@ public:
             // 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));
-            }
+            result.set_LEN(std::move(*len));
           }
         }
         return AsMaybeExpr(std::move(result));
@@ -1502,6 +1500,19 @@ public:
 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 &);
@@ -1611,7 +1622,8 @@ void ArrayConstructorContext::Push(MaybeExpr &&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) &&
@@ -1628,12 +1640,14 @@ void ArrayConstructorContext::Push(MaybeExpr &&x) {
             // 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)) {
@@ -1735,6 +1749,7 @@ void ArrayConstructorContext::Add(const parser::AcImpliedDo &impliedDo) {
       bool isNonemptyConstant{isConstant &&
           ((*cStride > 0 && *cLower <= *cUpper) ||
               (*cStride < 0 && *cLower >= *cUpper))};
+      bool isEmpty{isConstant && !isNonemptyConstant};
       bool unrollConstantLoop{false};
       parser::Messages buffer;
       auto saveMessagesDisplayed{messageDisplayedSet_};
@@ -1754,6 +1769,12 @@ void ArrayConstructorContext::Add(const parser::AcImpliedDo &impliedDo) {
               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);
diff --git a/flang/test/Semantics/array-constr-len.f90 b/flang/test/Semantics/array-constr-len.f90
new file mode 100644
index 0000000..11460a0
--- /dev/null
+++ b/flang/test/Semantics/array-constr-len.f90
@@ -0,0 +1,14 @@
+! 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