diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp --- a/flang/lib/Semantics/expression.cpp +++ b/flang/lib/Semantics/expression.cpp @@ -1474,7 +1474,7 @@ } else if (type_->kind() == T::kind) { ArrayConstructor result{MakeSpecific(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 @@ // 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 @@ private: using ImpliedDoIntType = ResultType; + std::optional> 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 @@ } 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 @@ // 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 @@ 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 @@ 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 --- /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