[flang] Re-land PR#97337 (llvm#98656)

Pull request llvm#97337 was
reverted by llvm#98612 due
to two failing tests in llvm-test-suite -- which I ran, as always,
but must have bungled or misinterpreted (mea culpa).
    
The failing tests were llvm-test-suite/Fortran/gfortran/regression/
char_length_{20,21}.f90.  They have array constructors with
explicit character types whose dynamic length values are negative
at runtime, which must be interpreted as zero.
    
This patch extends the original to cover those cases.

Author: klausler

flang/lib/Semantics/expression.cpp

@@ -63,7 +63,7 @@ std::optional<Expr<SubscriptInteger>> DynamicTypeWithLength::LEN() const {
 }
 
 static std::optional<DynamicTypeWithLength> AnalyzeTypeSpec(
-    const std::optional<parser::TypeSpec> &spec) {
+    const std::optional<parser::TypeSpec> &spec, FoldingContext &context) {
   if (spec) {
     if (const semantics::DeclTypeSpec *typeSpec{spec->declTypeSpec}) {
       // Name resolution sets TypeSpec::declTypeSpec only when it's valid
@@ -80,7 +80,13 @@ static std::optional<DynamicTypeWithLength> AnalyzeTypeSpec(
             const semantics::ParamValue &len{cts.length()};
             // N.B. CHARACTER(LEN=*) is allowed in type-specs in ALLOCATE() &
             // type guards, but not in array constructors.
-            return DynamicTypeWithLength{DynamicType{kind, len}};
+            DynamicTypeWithLength type{DynamicType{kind, len}};
+            if (auto lenExpr{type.LEN()}) {
+              type.length = Fold(context,
+                  AsExpr(Extremum<SubscriptInteger>{Ordering::Greater,
+                      Expr<SubscriptInteger>{0}, std::move(*lenExpr)}));
+            }
+            return type;
           } else {
             return DynamicTypeWithLength{DynamicType{category, kind}};
           }
@@ -1584,7 +1590,8 @@ class ArrayConstructorContext {
   std::optional<Expr<SubscriptInteger>> LengthIfGood() const {
     if (type_) {
       auto len{type_->LEN()};
-      if (len && IsConstantExpr(*len) && !ContainsAnyImpliedDoIndex(*len)) {
+      if (explicitType_ ||
+          (len && IsConstantExpr(*len) && !ContainsAnyImpliedDoIndex(*len))) {
         return len;
       }
     }
@@ -1939,7 +1946,8 @@ MaybeExpr ArrayConstructorContext::ToExpr() {
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::ArrayConstructor &array) {
   const parser::AcSpec &acSpec{array.v};
-  ArrayConstructorContext acContext{*this, AnalyzeTypeSpec(acSpec.type)};
+  ArrayConstructorContext acContext{
+      *this, AnalyzeTypeSpec(acSpec.type, GetFoldingContext())};
   for (const parser::AcValue &value : acSpec.values) {
     acContext.Add(value);
   }

flang/test/Lower/HLFIR/array-ctor-character.f90

@@ -93,10 +93,11 @@ subroutine test_set_length_sanitize(i, c1)
   call takes_char([character(len=i):: c1])
 end subroutine
 ! CHECK-LABEL:   func.func @_QPtest_set_length_sanitize(
-! CHECK:   %[[VAL_6:.*]]:2 = hlfir.declare {{.*}}Ec1
-! CHECK:   %[[VAL_9:.*]]:2 = hlfir.declare {{.*}}Ei
-! CHECK:   %[[VAL_25:.*]] = fir.load %[[VAL_9]]#0 : !fir.ref<i64>
+! CHECK:   %[[VAL_2:.*]]:2 = hlfir.declare {{.*}}Ec1
+! CHECK:   %[[VAL_3:.*]]:2 = hlfir.declare %arg0
+! CHECK:   %[[VAL_4:.*]] = fir.load %[[VAL_3]]#0 : !fir.ref<i64>
+! CHECK:   %[[VAL_25:.*]] = fir.load %[[VAL_3]]#0 : !fir.ref<i64>
 ! CHECK:   %[[VAL_26:.*]] = arith.constant 0 : i64
 ! CHECK:   %[[VAL_27:.*]] = arith.cmpi sgt, %[[VAL_25]], %[[VAL_26]] : i64
 ! CHECK:   %[[VAL_28:.*]] = arith.select %[[VAL_27]], %[[VAL_25]], %[[VAL_26]] : i64
-! CHECK:   %[[VAL_29:.*]] = hlfir.set_length %[[VAL_6]]#0 len %[[VAL_28]] : (!fir.boxchar<1>, i64) -> !hlfir.expr<!fir.char<1,?>>
+! CHECK:   %[[VAL_29:.*]] = hlfir.set_length %[[VAL_2]]#0 len %[[VAL_28]] : (!fir.boxchar<1>, i64) -> !hlfir.expr<!fir.char<1,?>>

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

@@ -10,6 +10,5 @@ subroutine subr(s,n)
   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
-  !ERROR: Array constructor implied DO loop has no iterations and indeterminate character length
   print *, [character(n)::(s(1:n),j=1,0)]
 end