[Flang] Checks for constraint C7110-C7115.

[sameeranjoshi]

Summary

Added more tests.

	 Annotate sources and tests.
	 Improve error message.

[DavidTruby]

flang/lib/Semantics/expression.cpp

1205

I think we usually use braces for initialization in flang, e.g.:
bool messageDisplayedOnce {true};

1271

Are these extra parentheses needed here?

[PeteSteinfeld]

In addition to my comment, I agree with all of @DavidTruby's comments.

Thanks for working on this! I've verified that everything builds, tests and (aside from the comments in this review) looks good.

flang/lib/Semantics/expression.cpp

1268–1271

This string can fit onto two lines.

[sameeranjoshi]

Upstream comments addressed.

[PeteSteinfeld]

All builds, tests, and looks good.

Can you please move the associated cards in https://github.com/orgs/flang-compiler/projects/7 to the "Done" column after you've merged these changes?

[sameeranjoshi]

@PeteSteinfeld I see that I have no access to move it.

[PeteSteinfeld]

I wondered about that. I'll take care of it.

flang/lib/Semantics/expression.cpp

private:
 
   // Nested array constructors all reference the same ExpressionAnalyzer,
   // which represents the nest of active implied DO loop indices.
   ExpressionAnalyzer &exprAnalyzer_;
   std::optional<DynamicTypeWithLength> type_;
   bool explicitType_{type_.has_value()};
   std::optional<std::int64_t> constantLength_;
   ArrayConstructorValues<SomeType> values_;
+  bool messageDisplayedOnce{false};
 };
 
 void ArrayConstructorContext::Push(MaybeExpr &&x) {
   if (!x) {
     return;
   }
   if (auto dyType{x->GetType()}) {
     DynamicTypeWithLength xType{*dyType};
if (!type_) {
               type_->length = xType.LEN();
             }
           } else {
             constantLength_ = *thisLen;
             type_->length = xType.LEN();
           }
         }
       } else {
+        if (!messageDisplayedOnce) {
           exprAnalyzer_.Say(
               "Values in array constructor must have the same declared type "
-            "when no explicit type appears"_err_en_US);
+              "when no explicit type appears"_err_en_US); // C7110
+          messageDisplayedOnce = true;
+        }
       }
     } else {
       if (auto cast{ConvertToType(*type_, std::move(*x))}) {
         values_.Push(std::move(*cast));
       } else {
         exprAnalyzer_.Say(
-            "Value in array constructor could not be converted to the type "
-            "of the array"_err_en_US);
+            "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
       }
     }
   }
 }
 
 void ArrayConstructorContext::Add(const parser::AcValue &x) {
   using IntType = ResultType<ImpliedDoIndex>;
   std::visit(
       common::visitors{
std::visit(
           [&](const common::Indirection<parser::Expr> &expr) {
             auto restorer{exprAnalyzer_.GetContextualMessages().SetLocation(
                 expr.value().source)};
             if (MaybeExpr v{exprAnalyzer_.Analyze(expr.value())}) {
               if (auto exprType{v->GetType()}) {
                 if (exprType->IsUnlimitedPolymorphic()) {
                   exprAnalyzer_.Say(
                       "Cannot have an unlimited polymorphic value in an "
-                      "array constructor"_err_en_US);
+                      "array constructor"_err_en_US); // C7113
                 }
               }
               Push(std::move(*v));
             }
           },
           [&](const common::Indirection<parser::AcImpliedDo> &impliedDo) {
             const auto &control{
                 std::get<parser::AcImpliedDoControl>(impliedDo.value().t)};
std::visit(
                 std::swap(v, values_);
                 values_.Push(ImpliedDo<SomeType>{name, std::move(*lower),
                     std::move(*upper), std::move(*stride), std::move(v)});
               }
               exprAnalyzer_.RemoveImpliedDo(name);
             } else {
               exprAnalyzer_.SayAt(name,
                   "Implied DO index is active in surrounding implied DO loop "
-                  "and may not have the same name"_err_en_US);
+                  "and may not have the same name"_err_en_US); // C7115
             }
           },
       },
       x.u);
 }
 
 MaybeExpr ArrayConstructorContext::ToExpr() {
   return common::SearchTypes(std::move(*this));
MaybeExpr ExpressionAnalyzer::Analyze(
   const auto &typeDetails{typeSymbol.get<semantics::DerivedTypeDetails>()};
   const Symbol *parentComponent{typeDetails.GetParentComponent(*spec.scope())};
 
   if (typeSymbol.attrs().test(semantics::Attr::ABSTRACT)) { // C796
     AttachDeclaration(Say(typeName,
                           "ABSTRACT derived type '%s' may not be used in a "
                           "structure constructor"_err_en_US,
                           typeName),
-        typeSymbol);
+        typeSymbol); // C7114
   }
 
   // This iterator traverses all of the components in the derived type and its
   // parents.  The symbols for whole parent components appear after their
   // own components and before the components of the types that extend them.
   // E.g., TYPE :: A; REAL X; END TYPE
   //       TYPE, EXTENDS(A) :: B; REAL Y; END TYPE
   // produces the component list X, A, Y.

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

+! RUN: %S/test_errors.sh %s %t %f18
+! Confirm enforcement of constraints and restrictions in 7.8
+! C7110, C7111, C7112, C7113, C7114, C7115
+
+subroutine arrayconstructorvalues()
+  integer :: intarray(5)
+  integer(KIND=8) :: k8 = 20
+
+  TYPE EMPLOYEE
+    INTEGER AGE
+    CHARACTER (LEN = 30) NAME
+  END TYPE EMPLOYEE
+  TYPE EMPLOYEER
+    CHARACTER (LEN = 30) NAME
+  END TYPE EMPLOYEER
+
+  TYPE(EMPLOYEE) :: emparray(3)
+  class(*), pointer :: unlim_polymorphic
+  TYPE, ABSTRACT :: base_type
+    INTEGER :: CARPRIZE
+  END TYPE
+  ! Different declared type
+  !ERROR: Values in array constructor must have the same declared type when no explicit type appears
+  intarray = (/ 1, 2, 3, 4., 5/)  ! C7110
+  ! Different kind type parameter
+  !ERROR: Values in array constructor must have the same declared type when no explicit type appears
+  intarray = (/ 1,2,3,4, k8 /)    ! C7110
+
+  ! C7111
+  !ERROR: Value in array constructor of type 'LOGICAL(4)' could not be converted to the type of the array 'INTEGER(4)'
+  intarray = [integer:: .true., 2, 3, 4, 5]
+  !ERROR: Value in array constructor of type 'CHARACTER(1)' could not be converted to the type of the array 'INTEGER(4)'
+  intarray = [integer:: "RAM stores information", 2, 3, 4, 5]
+  !ERROR: Value in array constructor of type 'employee' could not be converted to the type of the array 'INTEGER(4)'
+  intarray = [integer:: EMPLOYEE (19, "Jack"), 2, 3, 4, 5]
+
+  ! 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 /)
+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)]
+  !ERROR: Implied DO index is active in surrounding implied DO loop and may not have the same name
+  !ERROR: 'i' is already declared in this scoping unit
+  real, dimension(100), parameter :: bad = [((88.8, i = 1, 10), i = 1, 10)]
+end subroutine checkC7115