[flang] Added Semantic Checks for 5 Data Constraints

[anchu-rajendran]

Summary

Semantic checks for 5 data constraints : C874, C875, C878, C880 and C881 are implemented.

[tskeith]

LGTM, after fixing the clang-format problems.

flang/lib/Semantics/check-data.cpp

27–29

I think this is clearer as:

CheckIfConstantSubscript(std::get<0>(triplet.t));
CheckIfConstantSubscript(std::get<1>(triplet.t));
CheckIfConstantSubscript(std::get<2>(triplet.t));

[anchu-rajendran]

Fixed the clang format problems

[anchu-rajendran]

flang/lib/Semantics/check-data.cpp

27–29

Hi, Thank your for the comment! I have made the change suggested and fixed the formatting issues.

[anchu-rajendran]

Fixed the formatting issues

[anchu-rajendran]

Changes in formatting

[anchu-rajendran]

flang/lib/Semantics/check-data.cpp

15–16

@klausler , I have made the checks on analyzed expressions as suggested by you. Please let me know if there are any concerns.

[klausler]

Your code is still checking the *parse tree* for a data-ref rather than calculating a typed expression representation for the variable with AnalyzeExpr and applying constraint checks to its result.

[klausler]

I think you should just merge the code you have so I can clean it up here.

[anchu-rajendran]

In D78008#1989233, @klausler wrote:

I think you should just merge the code you have so I can clean it up here.

Thank you! I have merged the changes.

flang/lib/Semantics/check-data.h

 #include "flang/Semantics/tools.h"
 
 namespace Fortran::semantics {
 class DataChecker : public virtual BaseChecker {
 public:
   DataChecker(SemanticsContext &context) : context_{context} {}
   void Leave(const parser::DataStmtRepeat &);
   void Leave(const parser::DataStmtConstant &);
+  void Leave(const parser::DataStmtObject &);
+  void Leave(const parser::DataImpliedDo &);
 
 private:
   SemanticsContext &context_;
+  template<typename T> void CheckIfConstantSubscript(const T &);
+  void CheckSubscript(const parser::SectionSubscript &);
+  bool CheckAllSubscriptsInDataRef(const parser::DataRef &, parser::CharBlock);
 };
-} // namespace Fortran::semantics
-#endif // FORTRAN_SEMANTICS_CHECK_DATA_H_
+}
+#endif  // FORTRAN_SEMANTICS_CHECK_DATA_H_

flang/lib/Semantics/check-data.cpp

 //===-- lib/Semantics/check-data.cpp --------------------------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 #include "check-data.h"
 
 namespace Fortran::semantics {
 
+template<typename T> void DataChecker::CheckIfConstantSubscript(const T &x) {
+  evaluate::ExpressionAnalyzer exprAnalyzer{context_};
+  if (MaybeExpr checked{exprAnalyzer.Analyze(x)}) {
+    if (!evaluate::IsConstantExpr(*checked)) {  // C875,C881
+      context_.Say(parser::FindSourceLocation(x),
+          "Data object must have constant bounds"_err_en_US);
+    }
+  }
+}
+
+void DataChecker::CheckSubscript(const parser::SectionSubscript &subscript) {
+  std::visit(
+      common::visitors{
+          [&](const parser::SubscriptTriplet &triplet) {
+            std::apply(
+                [&](const auto &... x) { (..., CheckIfConstantSubscript(x)); },
+                triplet.t);
+          },
+          [&](const parser::IntExpr &intExpr) {
+            CheckIfConstantSubscript(intExpr);
+          },
+      },
+      subscript.u);
+}
+
+// Returns false if  DataRef has no subscript
+bool DataChecker::CheckAllSubscriptsInDataRef(
+    const parser::DataRef &dataRef, parser::CharBlock source) {
+  return std::visit(
+      common::visitors{
+          [&](const parser::Name &) { return false; },
+          [&](const common::Indirection<parser::StructureComponent>
+                  &structureComp) {
+            return CheckAllSubscriptsInDataRef(
+                structureComp.value().base, source);
+          },
+          [&](const common::Indirection<parser::ArrayElement> &arrayElem) {
+            for (auto &subscript : arrayElem.value().subscripts) {
+              CheckSubscript(subscript);
+            }
+            CheckAllSubscriptsInDataRef(arrayElem.value().base, source);
+            return true;
+          },
+          [&](const common::Indirection<parser::CoindexedNamedObject>
+                  &coindexedObj) {  // C874
+            context_.Say(source,
+                "Data object must not be a coindexed variable"_err_en_US);
+            CheckAllSubscriptsInDataRef(coindexedObj.value().base, source);
+            return true;
+          },
+      },
+      dataRef.u);
+}
+
 void DataChecker::Leave(const parser::DataStmtConstant &dataConst) {
   if (auto *structure{
           std::get_if<parser::StructureConstructor>(&dataConst.u)}) {
     for (const auto &component :
         std::get<std::list<parser::ComponentSpec>>(structure->t)) {
       const parser::Expr &parsedExpr{
           std::get<parser::ComponentDataSource>(component.t).v.value()};
       if (const auto *expr{GetExpr(parsedExpr)}) {
-        if (!evaluate::IsConstantExpr(*expr)) { // C884
+        if (!evaluate::IsConstantExpr(*expr)) {  // C884
           context_.Say(parsedExpr.source,
               "Structure constructor in data value must be a constant expression"_err_en_US);
         }
       }
     }
   }
-  // TODO: C886 and C887 for data-stmt-constant
 }
 
-// TODO: C874-C881
+// TODO: C876, C877, C879
+void DataChecker::Leave(const parser::DataImpliedDo &dataImpliedDo) {
+  for (const auto &object :
+      std::get<std::list<parser::DataIDoObject>>(dataImpliedDo.t)) {
+    if (const auto *designator{parser::Unwrap<parser::Designator>(object)}) {
+      if (auto *dataRef{std::get_if<parser::DataRef>(&designator->u)}) {
+        evaluate::ExpressionAnalyzer exprAnalyzer{context_};
+        if (MaybeExpr checked{exprAnalyzer.Analyze(*dataRef)}) {
+          if (evaluate::IsConstantExpr(*checked)) {  // C878
+            context_.Say(designator->source,
+                "Data implied do object must be a variable"_err_en_US);
+          }
+        }
+        if (!CheckAllSubscriptsInDataRef(
+                *dataRef, designator->source)) {  // C880
+          context_.Say(designator->source,
+              "Data implied do object must be subscripted"_err_en_US);
+        }
+      }
+    }
+  }
+}
+
+void DataChecker::Leave(const parser::DataStmtObject &dataObject) {
+  if (std::get_if<common::Indirection<parser::Variable>>(&dataObject.u)) {
+    if (const auto *designator{
+            parser::Unwrap<parser::Designator>(dataObject)}) {
+      if (auto *dataRef{std::get_if<parser::DataRef>(&designator->u)}) {
+        CheckAllSubscriptsInDataRef(*dataRef, designator->source);
+      }
+    } else {  // C875
+      context_.Say(parser::FindSourceLocation(dataObject),
+          "Data object variable must not be a function reference"_err_en_US);
+    }
+  }
+}
 
 void DataChecker::Leave(const parser::DataStmtRepeat &dataRepeat) {
   if (const auto *designator{parser::Unwrap<parser::Designator>(dataRepeat)}) {
     if (auto *dataRef{std::get_if<parser::DataRef>(&designator->u)}) {
       evaluate::ExpressionAnalyzer exprAnalyzer{context_};
       if (MaybeExpr checked{exprAnalyzer.Analyze(*dataRef)}) {
         auto expr{
             evaluate::Fold(context_.foldingContext(), std::move(checked))};
         if (auto i64{ToInt64(expr)}) {
-          if (*i64 < 0) { // C882
+          if (*i64 < 0) {  // C882
             context_.Say(designator->source,
                 "Repeat count for data value must not be negative"_err_en_US);
           }
         }
       }
     }
   }
 }
-} // namespace Fortran::semantics
+}  // namespace Fortran::semantics

flang/test/Semantics/data03.f90

+! RUN: %B/test/Semantics/test_errors.sh %s %flang %t
+!Testing data constraints : C874 - C875, C878 - C881 
+module m
+  contains
+    function f(i)
+      integer ::i
+      integer ::result
+      result = i *1024 
+    end
+    subroutine CheckObject 
+      type specialNumbers
+        integer one
+        integer numbers(5)
+      end type
+      type large
+        integer elt(10)
+        integer val
+        type(specialNumbers) nums
+        type(specialNumbers) numsArray(5)
+      end type
+      type(specialNumbers), parameter ::newNums = &
+              specialNumbers(1, (/ 1, 2, 3, 4, 5 /))
+      type(specialNumbers), parameter ::newNumsArray(2) = &
+              (/ SpecialNumbers(1, (/ 1, 2, 3, 4, 5 /)), &
+              SpecialNumbers(1, (/ 1, 2, 3,4, 5 /)) /)
+      type(specialNumbers) nums
+      type(large) largeArray(5)
+      type(large) largeNumber
+      real :: a[*]
+      real :: b(5)
+      integer :: x
+      real, parameter:: c(5) = (/ 1, 2, 3, 4, 5 /)
+      integer :: d(10, 10)
+      character :: name(12)
+      integer :: ind = 2
+      !C874
+      !ERROR: Data object must not be a coindexed variable
+      DATA a[1] / 1 /
+      !C874
+      !ERROR: Data object must not be a coindexed variable
+      DATA(a[i], i = 1, 5) / 5 * 1 /
+      !C875
+      !ERROR: Data object variable must not be a function reference
+      DATA f(1) / 1 / 
+      !C875
+      !ERROR: Data object must have constant bounds
+      DATA b(ind) / 1 /
+      !C875
+      !ERROR: Data object must have constant bounds
+      DATA name( : ind) / 'Ancd' /
+      !C875
+      !ERROR: Data object must have constant bounds
+      DATA name(ind:) / 'Ancd' /
+      !C878
+      !ERROR: Data implied do object must be a variable
+      DATA(c(i), i = 1, 5) / 5 * 1 /
+      !C878
+      !ERROR: Data implied do object must be a variable
+      DATA(newNumsArray(i), i = 1, 2) &
+              / specialNumbers(1, 2 * (/ 1, 2, 3, 4, 5 /)) /
+      !C880
+      !ERROR: Data implied do object must be subscripted
+      DATA(nums % one, i = 1, 5) / 5 * 1 /
+      !C880
+      !OK: Correct use
+      DATA(largeArray(j) % nums % one, j = 1, 10) / 10 * 1 /
+      !C880
+      !OK: Correct use
+      DATA(largeNumber % numsArray(j) % one, j = 1, 10) / 10 * 1 /
+      !C881
+      !ERROR: Data object must have constant bounds
+      DATA(b(x), i = 1, 5) / 5 * 1 /
+      !C881 
+      !OK: Correct use
+      DATA(nums % numbers(i), i = 1, 5) / 5 * 1 /
+      !C881
+      !OK: Correct use
+      DATA((d(i, j), i = 1, 10), j = 1, 10) / 100 * 1 /
+      !C881
+      !OK: Correct use
+      DATA(d(i, 1), i = 1, 10) / 10 * 1 /
+    end 
+  end