[flang] Cope with errors with array constructors

[klausler]

Summary

When a program attempts to put something like a subprogram
into an array constructor, emit an error rather than crashing.

[jeanPerier]

LGTM

flang/lib/Semantics/expression.cpp

if (auto *boz{std::get_if<BOZLiteralConstant>(&x->u)}) {
         exprAnalyzer_.Say(
             "BOZ literal in array constructor without explicit type is assumed to be default INTEGER"_en_US);
       }
       x = AsGenericExpr(ConvertToKind<TypeCategory::Integer>(
           exprAnalyzer_.GetDefaultKind(TypeCategory::Integer),
           std::move(*boz)));
     }
   }
-  if (auto dyType{x->GetType()}) {
-    DynamicTypeWithLength xType{*dyType};
-    if (Expr<SomeCharacter> * charExpr{UnwrapExpr<Expr<SomeCharacter>>(*x)}) {
-      CHECK(xType.category() == TypeCategory::Character);
-      xType.length =
-          std::visit([](const auto &kc) { return kc.LEN(); }, charExpr->u);
-    }
-    if (!type_) {
-      // If there is no explicit type-spec in an array constructor, the type
-      // of the array is the declared type of all of the elements, which must
-      // be well-defined and all match.
-      // TODO: Possible language extension: use the most general type of
-      // the values as the type of a numeric constructed array, convert all
-      // of the other values to that type.  Alternative: let the first value
-      // 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())}) {
-          if (constantLength_) {
-            if (exprAnalyzer_.context().warnOnNonstandardUsage() &&
-                *thisLen != *constantLength_) {
-              if (!(messageDisplayedSet_ & 1)) {
-                exprAnalyzer_.Say(
-                    "Character literal in array constructor without explicit "
-                    "type has different length than earlier elements"_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();
-            }
-          } else {
-            constantLength_ = *thisLen;
-            type_->length = xType.LEN();
-          }
-        }
-      } 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;
-        }
-      }
-    } else {
-      if (auto cast{ConvertToType(*type_, std::move(*x))}) {
-        values_.Push(std::move(*cast));
-      } else if (!(messageDisplayedSet_ & 4)) {
-        exprAnalyzer_.Say(
-            "Value in array constructor of type '%s' could not "
+  std::optional<DynamicType> dyType{x->GetType()};
+  if (!dyType) {
+    if (auto *boz{std::get_if<BOZLiteralConstant>(&x->u)}) {
+      if (!type_) {
+        // Treat an array constructor of BOZ as if default integer.
+        if (exprAnalyzer_.context().ShouldWarn(
+                common::LanguageFeature::BOZAsDefaultInteger)) {
+          exprAnalyzer_.Say(
+              "BOZ literal in array constructor without explicit type is assumed to be default INTEGER"_en_US);
+        }
+        x = AsGenericExpr(ConvertToKind<TypeCategory::Integer>(
+            exprAnalyzer_.GetDefaultKind(TypeCategory::Integer),
+            std::move(*boz)));
+        dyType = x.value().GetType();
+      } else if (auto cast{ConvertToType(*type_, std::move(*x))}) {
+        x = std::move(cast);
+        dyType = *type_;
+      } else {
+        if (!(messageDisplayedSet_ & 0x80)) {
+          exprAnalyzer_.Say(
+              "BOZ literal is not suitable for use in this array constructor"_err_en_US);
+          messageDisplayedSet_ |= 0x80;
+        }
+        return;
+      }
+    } else { // procedure name, &c.
+      if (!(messageDisplayedSet_ & 0x40)) {
+        exprAnalyzer_.Say(
+            "Item is not suitable for use in an array constructor"_err_en_US);
+        messageDisplayedSet_ |= 0x40;
+      }
+      return;
+    }
+  } else if (dyType->IsUnlimitedPolymorphic()) {
+    if (!(messageDisplayedSet_ & 8)) {
+      exprAnalyzer_.Say("Cannot have an unlimited polymorphic value in an "
+                        "array constructor"_err_en_US); // C7113
+      messageDisplayedSet_ |= 8;
+    }
+    return;
+  }
+  DynamicTypeWithLength xType{dyType.value()};
+    if (type_->IsTkCompatibleWith(xType) && xType.IsTkCompatibleWith(*type_)) {
+      exprAnalyzer_.Say("Value in array constructor of type '%s' could not "
                         "be converted to the type of the array '%s'"_err_en_US,
-            x->GetType()->AsFortran(), type_->AsFortran()); // C7111, C7112
-        messageDisplayedSet_ |= 4;
-      }
-    }
-  }
-}
 
 void ArrayConstructorContext::Add(const parser::AcValue &x) {
   std::visit(
       common::visitors{
           [&](const parser::AcValue::Triplet &triplet) { Add(triplet); },
           [&](const common::Indirection<parser::Expr> &expr) {
             Add(expr.value());
           },
if (lower && upper) {
     std::swap(v, values_);
     values_.Push(ImpliedDo<SomeType>{anonymous, std::move(*lower),
         std::move(*upper), std::move(*stride), std::move(v)});
   }
 }
 
 void ArrayConstructorContext::Add(const parser::Expr &expr) {
   auto restorer{exprAnalyzer_.GetContextualMessages().SetLocation(expr.source)};
-  if (MaybeExpr v{exprAnalyzer_.Analyze(expr)}) {
-    if (auto exprType{v->GetType()}) {
-      if (!(messageDisplayedSet_ & 8) && exprType->IsUnlimitedPolymorphic()) {
-        exprAnalyzer_.Say("Cannot have an unlimited polymorphic value in an "
-                          "array constructor"_err_en_US); // C7113
-        messageDisplayedSet_ |= 8;
-      }
-    }
-    Push(std::move(*v));
-  }
+  Push(exprAnalyzer_.Analyze(expr));
 }
 
 void ArrayConstructorContext::Add(const parser::AcImpliedDo &impliedDo) {
   const auto &control{std::get<parser::AcImpliedDoControl>(impliedDo.t)};
   const auto &bounds{std::get<parser::AcImpliedDoControl::Bounds>(control.t)};
   exprAnalyzer_.Analyze(bounds.name);
   parser::CharBlock name{bounds.name.thing.thing.source};
   const Symbol *symbol{bounds.name.thing.thing.symbol};

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

subroutine arrayconstructorvalues()
   ! C7112
   !ERROR: Value in array constructor of type 'INTEGER(4)' could not be converted to the type of the array 'employee'
   emparray = (/ EMPLOYEE:: EMPLOYEE(19, "Ganesh"), EMPLOYEE(22, "Omkar"), 19 /)
   !ERROR: Value in array constructor of type 'employeer' could not be converted to the type of the array 'employee'
   emparray = (/ EMPLOYEE:: EMPLOYEE(19, "Ganesh"), EMPLOYEE(22, "Ram"),EMPLOYEER("ShriniwasPvtLtd") /)
 
   ! C7113
   !ERROR: Cannot have an unlimited polymorphic value in an array constructor
-  !ERROR: Values in array constructor must have the same declared type when no explicit type appears
   intarray = (/ unlim_polymorphic, 2, 3, 4, 5/)
 
   ! C7114
   !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches operand types INTEGER(4) and TYPE(base_type)
   !ERROR: ABSTRACT derived type 'base_type' may not be used in a structure constructor
   !ERROR: Values in array constructor must have the same declared type when no explicit type appears
   intarray = (/ base_type(10), 2, 3, 4, 5 /)
+
+  !ERROR: Item is not suitable for use in an array constructor
+  intarray(1:1) = [ arrayconstructorvalues ]
 end subroutine arrayconstructorvalues
 subroutine checkC7115()
   real, dimension(10), parameter :: good1 = [(99.9, i = 1, 10)]
   real, dimension(100), parameter :: good2 = [((88.8, i = 1, 10), j = 1, 10)]
   real, dimension(-1:0), parameter :: good3 = [77.7, 66.6]
   !ERROR: Implied DO index is active in surrounding implied DO loop and may not have the same name
   real, dimension(100), parameter :: bad = [((88.8, i = 1, 10), i = 1, 10)]