[flang] Issue flang-compiler/f18#992 : Implementing Semantic checks for DATA Stateme...

This commit covers Semantic Constraints C882 - C887

C882 : It was partially Implemented. Finished the implementation
and added test case
C884 : Implemented and added test case
C883 : Implementation was there already. Added test case
C885, C886, C887 : Implementation was there already. Added test case for
data-repeat.

Original-commit: flang-compiler/f18@822129736b6b7a96b6ff3ffe810d842ce42e3672
Reviewed-on: https://github.com/flang-compiler/f18/pull/992

diff --git a/flang/include/flang/semantics/expression.h b/flang/include/flang/semantics/expression.h
index 110a0bd..79360fc 100644 (file)
--- a/flang/include/flang/semantics/expression.h
+++ b/flang/include/flang/semantics/expression.h
@@ -186,7 +186,7 @@ public:
     auto result{Analyze(x.thing)};
     if (result) {
       *result = Fold(std::move(*result));
-      if (!IsConstantExpr(*result)) {
+      if (!IsConstantExpr(*result)) { //C886,C887
         SayAt(x, "Must be a constant value"_err_en_US);
         ResetExpr(x);
         return std::nullopt;

diff --git a/flang/lib/semantics/CMakeLists.txt b/flang/lib/semantics/CMakeLists.txt
index d06c8a2..5f2e3c6 100644 (file)
--- a/flang/lib/semantics/CMakeLists.txt
+++ b/flang/lib/semantics/CMakeLists.txt
@@ -15,6 +15,7 @@ add_library(FortranSemantics
   check-arithmeticif.cpp
   check-call.cpp
   check-coarray.cpp
+  check-data.cpp
   check-deallocate.cpp
   check-declarations.cpp
   check-do-forall.cpp

diff --git a/flang/lib/semantics/check-data.cpp b/flang/lib/semantics/check-data.cpp
new file mode 100644 (file)
index 0000000..e831bf7
--- /dev/null
+++ b/flang/lib/semantics/check-data.cpp
@@ -0,0 +1,50 @@
+//===-- 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 {
+
+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
+          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
+
+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
+            context_.Say(designator->source,
+                "Repeat count for data value must not be negative"_err_en_US);
+          }
+        }
+      }
+    }
+  }
+}
+}

diff --git a/flang/lib/semantics/check-data.h b/flang/lib/semantics/check-data.h
new file mode 100644 (file)
index 0000000..b2e9651
--- /dev/null
+++ b/flang/lib/semantics/check-data.h
@@ -0,0 +1,28 @@
+//===-------lib/semantics/check-data.h ------------------------------------===//
+//
+// 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
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_SEMANTICS_CHECK_DATA_H_
+#define FORTRAN_SEMANTICS_CHECK_DATA_H_
+
+#include "flang/parser/parse-tree.h"
+#include "flang/parser/tools.h"
+#include "flang/semantics/semantics.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 &);
+
+private:
+  SemanticsContext &context_;
+};
+}
+#endif  // FORTRAN_SEMANTICS_CHECK_DATA_H_

diff --git a/flang/lib/semantics/expression.cpp b/flang/lib/semantics/expression.cpp
index 054b4d1..65e9f7e 100644 (file)
--- a/flang/lib/semantics/expression.cpp
+++ b/flang/lib/semantics/expression.cpp
@@ -2471,7 +2471,7 @@ bool ExpressionAnalyzer::EnforceTypeConstraint(parser::CharBlock at,
     const MaybeExpr &result, TypeCategory category, bool defaultKind) {
   if (result) {
     if (auto type{result->GetType()}) {
-      if (type->category() != category) {
+      if (type->category() != category) { // C885
         Say(at, "Must have %s type, but is %s"_err_en_US,
             ToUpperCase(EnumToString(category)),
             ToUpperCase(type->AsFortran()));

diff --git a/flang/lib/semantics/resolve-names.cpp b/flang/lib/semantics/resolve-names.cpp
index b98b7bc..3c322b6 100644 (file)
--- a/flang/lib/semantics/resolve-names.cpp
+++ b/flang/lib/semantics/resolve-names.cpp
@@ -2957,7 +2957,7 @@ void DeclarationVisitor::Post(const parser::EntityDecl &x) {
     if (ConvertToObjectEntity(symbol)) {
       Initialization(name, *init, false);
     }
-  } else if (attrs.test(Attr::PARAMETER)) {
+  } else if (attrs.test(Attr::PARAMETER)) { // C882, C883
     Say(name, "Missing initialization for parameter '%s'"_err_en_US);
   }
 }
@@ -4408,7 +4408,7 @@ std::optional<DerivedTypeSpec> DeclarationVisitor::ResolveDerivedType(
       DerivedTypeDetails details;
       details.set_isForwardReferenced();
       symbol->set_details(std::move(details));
-    } else {
+    } else { // C883
       Say(name, "Derived type '%s' not found"_err_en_US);
       return std::nullopt;
     }

diff --git a/flang/lib/semantics/semantics.cpp b/flang/lib/semantics/semantics.cpp
index dcb1198..d64ba63 100644 (file)
--- a/flang/lib/semantics/semantics.cpp
+++ b/flang/lib/semantics/semantics.cpp
@@ -13,6 +13,7 @@
 #include "check-allocate.h"
 #include "check-arithmeticif.h"
 #include "check-coarray.h"
+#include "check-data.h"
 #include "check-deallocate.h"
 #include "check-declarations.h"
 #include "check-do-forall.h"
@@ -110,9 +111,9 @@ private:
 };
 
 using StatementSemanticsPass1 = ExprChecker;
-using StatementSemanticsPass2 = SemanticsVisitor<  //
+using StatementSemanticsPass2 = SemanticsVisitor<
     AllocateChecker, ArithmeticIfStmtChecker, AssignmentChecker, CoarrayChecker,
-    DeallocateChecker, DoForallChecker, IfStmtChecker, IoChecker,
+    DataChecker, DeallocateChecker, DoForallChecker, IfStmtChecker, IoChecker,
     NullifyChecker, OmpStructureChecker, PurityChecker, ReturnStmtChecker,
     StopChecker>;
 

diff --git a/flang/test/semantics/CMakeLists.txt b/flang/test/semantics/CMakeLists.txt
index 7d6ca5f..ff5aa3f 100644 (file)
--- a/flang/test/semantics/CMakeLists.txt
+++ b/flang/test/semantics/CMakeLists.txt
@@ -207,6 +207,7 @@ set(ERROR_TESTS
   critical02.f90
   critical03.f90
   block-data01.f90
+  data01.f90
 )
 
 # These test files have expected symbols in the source

diff --git a/flang/test/semantics/data01.f90 b/flang/test/semantics/data01.f90
new file mode 100644 (file)
index 0000000..02c4674
--- /dev/null
+++ b/flang/test/semantics/data01.f90
@@ -0,0 +1,48 @@
+!Test for checking data constraints, C882-C887
+module m1
+  type person
+    integer :: age
+    character(len=25) :: name
+  end type
+  integer, parameter::digits(5) = ( /-11,-22,-33,44,55/ )
+  integer ::notConstDigits(5) = ( /-11,-22,-33,44,55/ )
+  real, parameter::numbers(5) = ( /-11.11,-22.22,-33.33,44.44,55.55/ )
+  integer, parameter :: repeat = -1
+  integer :: myAge = 2 
+  type(person) myName
+end
+
+subroutine CheckRepeat
+  use m1
+  !C882
+  !ERROR: Missing initialization for parameter 'uninitialized'
+  integer, parameter :: uninitialized
+  !C882
+  !ERROR: Repeat count for data value must not be negative
+  DATA myName%age / repeat * 35 /
+  !C882
+  !ERROR: Repeat count for data value must not be negative
+  DATA myName%age / digits(1) * 35 /
+  !C882
+  !ERROR: Must be a constant value
+  DATA myName%age / repet * 35 /
+  !C885
+  !ERROR: Must have INTEGER type, but is REAL(4)
+  DATA myName%age / numbers(1) * 35 /
+  !C886
+  !ERROR: Must be a constant value
+  DATA myName%age / notConstDigits(1) * 35 /
+  !C887
+  !ERROR: Must be a constant value
+  DATA myName%age / digits(myAge) * 35 /
+end
+
+subroutine CheckValue
+  use m1
+  !C883
+  !ERROR: Derived type 'persn' not found
+  DATA myname / persn(2, 'Abcd Efgh') /
+  !C884
+  !ERROR: Structure constructor in data value must be a constant expression
+  DATA myname / person(myAge, 'Abcd Ijkl') /
+end