[flang] Added Semantic Checks for 2 Data constraints and fixed the semantic errors in 3 test cases

[anchu-rajendran]

Summary

• C876, C877 checks are implemented.
• Modified pre-fir-tree02.f90, block-data01.f90 and data01.f90 as they were not conforming to C876
• Fixed IsConstantExpr to check C879

[anchu-rajendran]

@klausler, Current implementation of C877 may change and may depend on the modifications which will be made by you. I will make changes accordingly after your changes are merged.

[tskeith]

flang/lib/Semantics/check-data.cpp

16

const auto is better here.

21

I think "right-most part" is better.

21

Is it possible to point at the part that is a pointer rather than at the entire data-ref?

41

symbol->detailsIf

48

This message is misleading. It can be in a named common block in a block data program unit.
I suggest something like: "Data object must not be in a named COMMON block outside a BLOCK DATA program unit".

57

Rather than copying all of this from resolve-names-utils.cpp, why not figure out a way to share the code?

[kiranchandramohan]

flang/lib/Semantics/check-data.cpp

16

Is the analyzer used?

[kiranchandramohan]

flang/lib/Semantics/check-data.cpp

14–15

Nit: The new ones in CheckDesignator have O with caps in 'Object'.

30

Should this catch the case where the component is not allocatable but the structure is?

program simple_alloc
  type t1
    real r
  end type
  type t2
    type(t1), allocatable :: arr(:)
  end type
  type(t2) d
  data d%arr(3)%r/10.0/
end

36

Should this check fire for the data statement in the following program where the type is defined in a module but the variable itself is not?

module dt
  type d
    real r
  end type
end module
program test
  use dt
  type(d) :: d1
  data d1%r/2.5/
end program

flang/test/Semantics/data04.f90

2

Can you add some tests with derived types?

[anchu-rajendran]

• Abstracted the code to IsAutomaticArray Function.
• Added implementation to catch semantic bugs related to fields of derived type variables.
• Made the changes suggested.

[anchu-rajendran]

flang/lib/Semantics/check-data.cpp

41

Thank you for your review comments! I have made the suggested modifications.

41

The code has been changed to check all symbols so the related semantic errors with derived types can be caught.

flang/test/Semantics/data04.f90

2

Thank you for your suggestions! I have added extra code for handling derived types and tests with derived types for checking constraints related to automatic arrays, use association, allocatable variables and common blocks.

[kiranchandramohan]

Thanks for addressing the comments.

Also check the following.

type t1
 integer, allocatable :: arr(:)
end type
type(t1) d1
data d1/t1((/0,1/))/

Besides the constraints for the data statement, there are several other points mentioned in the data statement section. Like point 8 in 8.6.7 (test below) which says that the number of variables and data-statement-constants shall be the same. Are these outside the scope of your work? If so, please create a ticket somewhere so that we can come back to it later.

program mn
  character(len=3) :: n1, n2
  data n1, n2 / 'f18' /
end

flang/lib/Semantics/check-data.cpp

36

I wasn't sure whether using the type from the module makes the variable d1 a use associated variable. What is your conclusion?

[tskeith]

flang/include/flang/Semantics/tools.h

159

I don't think there is any reason for this to be inline.

[anchu-rajendran]

Fixed a few corner cases:
Implemented a function: GetFirstName

module dt
  type d
    real r
  end type
end module
program test
  use dt
  type(d) :: d1
  data d1%r/2.5/
end program

In the above example, d1%r should not be identified as use-associated since, d1 is declared in the same scope. Previous revision identifies d1%r as use associated since the semantic checks were performed on last name r and not on first name:d1. The current revision applies checks on first name.

A few other corner cases will also be caught with this modification. An example follows:

 module m2
    type newType
      integer number
    end type
    contains
    subroutine checkDerivedType(m2_number)
      type(newType) m2_number
      DATA m2_number%number /1/
   end
end

In the above example, m2_number%number should not be used as a data obect as it is a dummy argument. This constraint will only be checked if check is applied on first name.

[anchu-rajendran]

flang/lib/Semantics/check-data.cpp

36

Hi,
Thank you for pointing this out! That was a corner case which was not checked properly. I have modified the implementation and included tests for the same.

[anchu-rajendran]

In D78424#1993281, @kiranchandramohan wrote:

Thanks for addressing the comments.

Also check the following.

type t1
 integer, allocatable :: arr(:)
end type
type(t1) d1
data d1/t1((/0,1/))/

Besides the constraints for the data statement, there are several other points mentioned in the data statement section. Like point 8 in 8.6.7 (test below) which says that the number of variables and data-statement-constants shall be the same. Are these outside the scope of your work? If so, please create a ticket somewhere so that we can come back to it later.

program mn
  character(len=3) :: n1, n2
  data n1, n2 / 'f18' /
end

I see that there are a few more constraints listed as you mentioned which requires expression evaluations and type checking. I will create a ticket for them now.

[anchu-rajendran]

Removed inline specifier from IsAutomaticArray

[anchu-rajendran]

In D78424#1993281, @kiranchandramohan wrote:

Thanks for addressing the comments.

Also check the following.

type t1
 integer, allocatable :: arr(:)
end type
type(t1) d1
data d1/t1((/0,1/))/

The current revision does not catch this error. I dont think this case is covered under the Constraint C876 (or C877)
C876 says a variable whose designator appears as a data-stmt-object shall not be an allocatable variable . This means d1 cannot be an allocatable (and it does not say anything about the fields of d1). In this case, d1 is not.

[klausler]

In D78424#1998443, @anchu-rajendran wrote:

In D78424#1993281, @kiranchandramohan wrote:

Thanks for addressing the comments.

Also check the following.

type t1
 integer, allocatable :: arr(:)
end type
type(t1) d1
data d1/t1((/0,1/))/

The current revision does not catch this error. I dont think this case is covered under the Constraint C876 (or C877)
C876 says a variable whose designator appears as a data-stmt-object shall not be an allocatable variable . This means d1 cannot be an allocatable (and it does not say anything about the fields of d1). In this case, d1 is not.

The code is in error because the structure constructor is not a constant expression in the sense of 10.1.12. I have a fix for this in my rework of DATA statement semantics in progress.

[anchu-rajendran]

In D78424#1999895, @klausler wrote:

In D78424#1998443, @anchu-rajendran wrote:

In D78424#1993281, @kiranchandramohan wrote:

Thanks for addressing the comments.

Also check the following.

type t1
 integer, allocatable :: arr(:)
end type
type(t1) d1
data d1/t1((/0,1/))/

The current revision does not catch this error. I dont think this case is covered under the Constraint C876 (or C877)
C876 says a variable whose designator appears as a data-stmt-object shall not be an allocatable variable . This means d1 cannot be an allocatable (and it does not say anything about the fields of d1). In this case, d1 is not.

The code is in error because the structure constructor is not a constant expression in the sense of 10.1.12. I have a fix for this in my rework of DATA statement semantics in progress.

@klausler, Okay, Thank you for pointing that out! I have fixed the bug with IsConstantExpr in my local branch which was causing C879 not to be checked properly which I shall submit for review after merging this patch. @kiranchandramohan , I hope all the concerns are addressed so I can merge this.

[kiranchandramohan]

If all the concerns are addressed, you can merge. Thanks for working on this.

[tskeith]

flang/lib/Semantics/check-data.cpp

19

symbol might be null so you need to check it here.

[klausler]

In D78424#2001397, @kiranchandramohan wrote:

If all the concerns are addressed, you can merge. Thanks for working on this.

Earlier, Anchu said that she would change this code to use typed expressions. Has this been done? It doesn't look like it. It took me most of the week to rework her earlier patch to use the right representation. None of these analyses should be done on the parse tree, and the new functions in parser/tools.h aren't necessary.

[klausler]

https://reviews.llvm.org/D78834 contains the patch that reworks check-data.{h,cpp} to check typed expressions rather than the raw parse tree. Please adjust this change to do the same, if possible.

[klausler]

flang/lib/Semantics/check-data.cpp

50

Every serious production Fortran compiler allows DATA initialization of COMMON in any subprogram;. Ignore the standard here, or change the error into a warning message.

[anchu-rajendran]

In D78424#2002860, @klausler wrote:

https://reviews.llvm.org/D78834 contains the patch that reworks check-data.{h,cpp} to check typed expressions rather than the raw parse tree. Please adjust this change to do the same, if possible.

Thank You! I went through your patch and now, I get your point on why we should implement semantic checks on typed expressions. I have tried to implement C876 and C877 on top of this patch and I could perform those checks on typed expressions. I will submit those for review after you merge your patch.

The change to convert code to have checks on typed expressions was asked by you on my previous patch (https://reviews.llvm.org/D78008). I asked for a merge as I was not sure about the changes you were expecting and I thought the code in this patch would be least affected. Sorry for my misunderstanding and thanks for the changes!

[anchu-rajendran]

In D78424#2002860, @klausler wrote:

https://reviews.llvm.org/D78834 contains the patch that reworks check-data.{h,cpp} to check typed expressions rather than the raw parse tree. Please adjust this change to do the same, if possible.

I have tried to rework the implementation as suggested. Please let me know if improvements are required.

[klausler]

flang/lib/Evaluate/check-expression.cpp

63

The logic here is wrong. Just recurse on the base (return (*this)(component.base());). If the base is an array element reference with non-constant subscripts, the component reference isn't a constant.

flang/lib/Semantics/check-data.cpp

61

This code doesn't implement the C877 constraint correctly. A pointer is allowed in a DATA statement object only if it is the entire rightmost part-ref. Your code would accept subscripts or a substring reference that was applied to a pointer component (A%PTR(1)(2:3)).

150

This member function doesn't use any state from the class; it could be made static, but it would be even better if it were in lib/Semantics/tools.cpp as it will probably be useful in other cases.

157

Please follow the naming conventions.

flang/lib/Semantics/tools.cpp

584

This code would return true for an explicit-shape dummy argument array with non-constant bounds, yes? Such objects are not "automatic". I think that you need a better name for this predicate.

[anchu-rajendran]

• Addressed the review comments
• Modified IsAutomaticArray to check all automatic objects as described in 3.11
• Added extra checks to emit error if right most pointer reference in a component is subscripted (C877)

[anchu-rajendran]

@klausler , Thank you for the review comments! I have made the suggested changes.

flang/lib/Semantics/tools.cpp

584

Thank You! I have changed the implementation according to the description of automatic data objects given in 3.11

[anchu-rajendran]

Made changes to update the variable symbolCheckStatus correctly.

[anchu-rajendran]

Ping @klausler . Can you please take another look and let me know if any concerns need to be addressed. I have tried to address your comments.

[klausler]

flang/lib/Semantics/check-data.cpp

62

These state variables are still too confusing and they're going to lead to bugs later when people modify this code.

I think it would be more clear if there were a single state variable that allowed a pointer to appear, and it would be initialized to true if and only if the entire designator were a simple Symbol or a Component. The state variable would be reset to false during the analysis of a Component.

94

This looks like you don't apply checks for dummy arguments, functions, blank COMMON, and so on if the designator is a component. If so, that's wrong. DATA DUMMYARG%X / 1.0 /.

flang/lib/Semantics/tools.cpp

585

What about pointers and allocatables and functions and statement functions and construct entities and probably other types of symbol? I think your function can return true for them, and that seems wrong if the symbol isn't a local object.

flang/test/Semantics/data04.f90

43

Please extend these tests to include cases where the dummy argument (or whatever) is not the whole designator; add subscripts, substring references, components, &c.

[anchu-rajendran]

flang/lib/Semantics/check-data.cpp

94

@klausler ,This is implemented in line 76 in the same file . I see that, (for the examples I could think of,) when a component is used, only the first symbol needs to be checked for checks in CheckFirstSymbol. Line 116 in data04.f90 covers this case and emits proper error message as the checks are done on component. similarly lines 88, 119, 140 in the same file covers other cases
One thing that is lacking here is none of these tests are done on subscripts. However, I could not create a test case were subscript is a constant (enforced by C875) and would violate one of the other constraints. (eg, C874 is not checked on subscripts). Can I know your opinion on this?

[anchu-rajendran]

Reduced the use of state variables while handling component
Added code to check constraints on subscripts and restricted pointers inside subscript.

[tskeith]

flang/lib/Semantics/check-data.cpp

73

Do you need to continue after an error is reported or can you just return false? The latter would simplify the code.

99

Why do you need a new DataVarChecker here rather than continuing to use the existing one?

[anchu-rajendran]

Removed the err variable while handling Component

[anchu-rajendran]

flang/lib/Semantics/check-data.cpp

73

I have returned false than reporting the errors. Thank you!

99

Subscripts can have any kind of DataRef. If a subscript is a%b%c(i), i think it is better to have tests on this DataRef separately so functions like CheckFirstSymbol will be called on a and say if a is a dummy argument, it reports an error.

For eg., consider a%b(c%d) is the data object being analyzed, where b is an array. In this case, when execution reaches checks on subscript, this.isFirstSymbolChecked_ will be true and this.hasSubscript_ will be true. For any checks that need to be done on subscript , I think it is better to set these variables for each subscript separately as it can mark the beginning of a DataRef. However I cannot find an use case where this checker will be used to report more errors (as the subscript needs to be a constant). I shall remove this part of code if it not expected to catch more semantic errors.

flang/lib/Semantics/tools.cpp

585

If it is a dummy, the function returns false. The only cases it returns true are (i) if length of a character is given by a non-constant expression (ii) the arrays with atleast one of the bounds is a non-constant expression. Else, the conservative value returned is false. Standard defines automatic object as
"nondummy data object with a type parameter or array bound that depends on the value of a specification-expr that is not a constant expression "
As kind parameter is always a constant expression, i did checks on only the length parameter.

For the cases you pointed out, I did check for pointers & allocatables and I saw it returns false. @klausler, Can you hint me an example code that would make this not behave as expected?

flang/test/Semantics/data04.f90

43

lines 88, 116, 119, 140 in the same file cover the cases

[anchu-rajendran]

Updated IsAutomaticObject to return false if the symbol is an allocatable or a pointer and test cases are added to data04.f90

[anchu-rajendran]

Added a test with derived type for C876 checking the object should not be in blank COMMON

[anchu-rajendran]

flang/lib/Semantics/check-data.cpp

94

The line numbers are changed in recent diff to 119, 122, 148, 154 in data04.f90 for CheckFirstSymbol and 85, 88, 91 for CheckAnySymbol

flang/lib/Semantics/tools.cpp

585

Pointers and allocatables are checked and examples are added to data04.f90 at line numbers: 42, 45

flang/test/Semantics/data04.f90

43

The line numbers are changed in recent diff to 119, 122, 148, 154 for CheckFirstSymbol and 85, 88, 91 for CheckAnySymbol

[anchu-rajendran]

ping!

[anchu-rajendran]

ping @klausler. If there are further improvements to be made, can you please suggest those. I have raised a few concerns related to questions which you have posted before.

[klausler]

I'm nearly done with the implementation of the rest of semantic processing for DATA statements (iterating through the objects and values, putting them into correspondence, and constructing a single initializer for each object).

You might as well commit your changes, and I'll clean up any remaining problems here when I merge your changes with mine.

flang/include/flang/Semantics/tools.h

 }
 inline bool IsImpliedDoIndex(const Symbol &symbol) {
   return symbol.owner().kind() == Scope::Kind::ImpliedDos;
 }
 bool IsFinalizable(const Symbol &);
 bool IsFinalizable(const DerivedTypeSpec &);
 bool HasImpureFinal(const DerivedTypeSpec &);
 bool IsCoarray(const Symbol &);
+bool IsInBlankCommon(const Symbol &);
+bool IsAutomaticObject(const Symbol &);
 inline bool IsAssumedSizeArray(const Symbol &symbol) {
   const auto *details{symbol.detailsIf<ObjectEntityDetails>()};
   return details && details->IsAssumedSize();
 }
 inline bool IsAssumedRankArray(const Symbol &symbol) {
   const auto *details{symbol.detailsIf<ObjectEntityDetails>()};
   return details && details->IsAssumedRank();
 }
 bool IsAssumedLengthCharacter(const Symbol &);
 bool IsExternal(const Symbol &);
 // Is the symbol modifiable in this scope
 std::optional<parser::MessageFixedText> WhyNotModifiable(
     const Symbol &, const Scope &);
 std::optional<parser::Message> WhyNotModifiable(SourceName, const SomeExpr &,
     const Scope &, bool vectorSubscriptIsOk = false);
 const Symbol *IsExternalInPureContext(const Symbol &, const Scope &);
 bool HasCoarray(const parser::Expr &);

flang/lib/Evaluate/check-expression.cpp

for (const auto &[symRef, expr] : constructor) {
       } else if (IsPointer(*symRef)) {
         return IsNullPointer(expr.value()) || IsInitialDataTarget(expr.value());
       } else if (!(*this)(expr.value())) {
         return false;
       }
     }
     return true;
   }
-
+  bool operator()(const Component &component) const {
+    return (*this)(component.base());
+  }
   // Forbid integer division by zero in constants.
   template <int KIND>
   bool operator()(
       const Divide<Type<TypeCategory::Integer, KIND>> &division) const {
     using T = Type<TypeCategory::Integer, KIND>;
     if (const auto divisor{GetScalarConstantValue<T>(division.right())}) {
       return !divisor->IsZero();
     } else {

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"
 #include "flang/Evaluate/traverse.h"
 #include "flang/Semantics/expression.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
           exprAnalyzer_.Say(parsedExpr.source,
               "Structure constructor in data value must be a constant expression"_err_en_US);
         }
       }
     }
   }
 }
 
 // Ensures that references to an implied DO loop control variable are
 // represented as such in the "body" of the implied DO loop.
 void DataChecker::Enter(const parser::DataImpliedDo &x) {
   auto name{std::get<parser::DataImpliedDo::Bounds>(x.t).name.thing.thing};
   int kind{evaluate::ResultType<evaluate::ImpliedDoIndex>::kind};
   if (const auto dynamicType{evaluate::DynamicType::From(*name.symbol)}) {
     kind = dynamicType->kind();
   }
   exprAnalyzer_.AddImpliedDo(name.source, kind);
 }
 
 void DataChecker::Leave(const parser::DataImpliedDo &x) {
   auto name{std::get<parser::DataImpliedDo::Bounds>(x.t).name.thing.thing};
   exprAnalyzer_.RemoveImpliedDo(name.source);
 }
 
 class DataVarChecker : public evaluate::AllTraverse<DataVarChecker, true> {
 public:
   using Base = evaluate::AllTraverse<DataVarChecker, true>;
   DataVarChecker(SemanticsContext &c, parser::CharBlock src)
       : Base{*this}, context_{c}, source_{src} {}
   using Base::operator();
   bool HasComponentWithoutSubscripts() const {
     return hasComponent_ && !hasSubscript_;
   }
   bool operator()(const evaluate::Component &component) {
     hasComponent_ = true;
-    return (*this)(component.base());
+    const Symbol &lastSymbol{component.GetLastSymbol()};
+    if (isPointerAllowed_) {
+      if (IsPointer(lastSymbol) && hasSubscript_) { // C877
+        context_.Say(source_,
+            "Rightmost data object pointer '%s' must not be subscripted"_err_en_US,
+            lastSymbol.name().ToString());
+        return false;
       }
-  bool operator()(const evaluate::Subscript &subs) {
+      RestrictPointer();
+    } else {
+      if (IsPointer(lastSymbol)) { // C877
+        context_.Say(source_,
+            "Data object must not contain pointer '%s' as a non-rightmost part"_err_en_US,
+            lastSymbol.name().ToString());
+        return false;
+      }
+    }
+    if (!isFirstSymbolChecked_) {
+      isFirstSymbolChecked_ = true;
+      if (!CheckFirstSymbol(component.GetFirstSymbol())) {
+        return false;
+      }
+    }
+    return (*this)(component.base()) && (*this)(lastSymbol);
+  }
+  bool operator()(const evaluate::ArrayRef &arrayRef) {
     hasSubscript_ = true;
+    return (*this)(arrayRef.base()) && (*this)(arrayRef.subscript());
+  }
+  bool operator()(const evaluate::Substring &substring) {
+    hasSubscript_ = true;
+    return (*this)(substring.parent()) && (*this)(substring.lower()) &&
+        (*this)(substring.upper());
+  }
+  bool operator()(const evaluate::CoarrayRef &) { // C874
+    hasSubscript_ = true;
+    context_.Say(
+        source_, "Data object must not be a coindexed variable"_err_en_US);
+    return false;
+  }
+  bool operator()(const evaluate::Symbol &symbol) {
+    if (!isFirstSymbolChecked_) {
+      return CheckFirstSymbol(symbol) && CheckAnySymbol(symbol);
+    } else {
+      return CheckAnySymbol(symbol);
+    }
+  }
+  bool operator()(const evaluate::Subscript &subs) {
+    DataVarChecker subscriptChecker{context_, source_};
+    subscriptChecker.RestrictPointer();
     return std::visit(
                common::visitors{
                    [&](const evaluate::IndirectSubscriptIntegerExpr &expr) {
                      return CheckSubscriptExpr(expr);
                    },
                    [&](const evaluate::Triplet &triplet) {
                      return CheckSubscriptExpr(triplet.lower()) &&
                          CheckSubscriptExpr(triplet.upper()) &&
                          CheckSubscriptExpr(triplet.stride());
                    },
                },
-        subs.u);
+               subs.u) &&
+        subscriptChecker(subs.u);
   }
   template <typename T>
   bool operator()(const evaluate::FunctionRef<T> &) const { // C875
     context_.Say(source_,
         "Data object variable must not be a function reference"_err_en_US);
     return false;
   }
-  bool operator()(const evaluate::CoarrayRef &) const { // C874
-    context_.Say(
-        source_, "Data object must not be a coindexed variable"_err_en_US);
-    return false;
-  }
+  void RestrictPointer() { isPointerAllowed_ = false; }
 
 private:
   bool CheckSubscriptExpr(
       const std::optional<evaluate::IndirectSubscriptIntegerExpr> &x) const {
     return !x || CheckSubscriptExpr(*x);
   }
   bool CheckSubscriptExpr(
       const evaluate::IndirectSubscriptIntegerExpr &expr) const {
     return CheckSubscriptExpr(expr.value());
   }
   bool CheckSubscriptExpr(
       const evaluate::Expr<evaluate::SubscriptInteger> &expr) const {
     if (!evaluate::IsConstantExpr(expr)) { // C875,C881
       context_.Say(
           source_, "Data object must have constant subscripts"_err_en_US);
       return false;
     } else {
       return true;
     }
   }
+  bool CheckFirstSymbol(const Symbol &symbol);
+  bool CheckAnySymbol(const Symbol &symbol);
 
   SemanticsContext &context_;
   parser::CharBlock source_;
   bool hasComponent_{false};
   bool hasSubscript_{false};
+  bool isPointerAllowed_{true};
+  bool isFirstSymbolChecked_{false};
 };
 
-// TODO: C876, C877, C879
+bool DataVarChecker::CheckFirstSymbol(const Symbol &symbol) { // C876
+  const Scope &scope{context_.FindScope(source_)};
+  if (IsDummy(symbol)) {
+    context_.Say(source_,
+        "Data object part '%s' must not be a dummy argument"_err_en_US,
+        symbol.name().ToString());
+  } else if (IsFunction(symbol)) {
+    context_.Say(source_,
+        "Data object part '%s' must not be a function name"_err_en_US,
+        symbol.name().ToString());
+  } else if (symbol.IsFuncResult()) {
+    context_.Say(source_,
+        "Data object part '%s' must not be a function result"_err_en_US,
+        symbol.name().ToString());
+  } else if (IsHostAssociated(symbol, scope)) {
+    context_.Say(source_,
+        "Data object part '%s' must not be accessed by host association"_err_en_US,
+        symbol.name().ToString());
+  } else if (IsUseAssociated(symbol, scope)) {
+    context_.Say(source_,
+        "Data object part '%s' must not be accessed by use association"_err_en_US,
+        symbol.name().ToString());
+  } else if (IsInBlankCommon(symbol)) {
+    context_.Say(source_,
+        "Data object part '%s' must not be in blank COMMON"_err_en_US,
+        symbol.name().ToString());
+  } else {
+    return true;
+  }
+  return false;
+}
+
+bool DataVarChecker::CheckAnySymbol(const Symbol &symbol) { // C876
+  if (IsAutomaticObject(symbol)) {
+    context_.Say(source_,
+        "Data object part '%s' must not be an automatic object"_err_en_US,
+        symbol.name().ToString());
+  } else if (IsAllocatable(symbol)) {
+    context_.Say(source_,
+        "Data object part '%s' must not be an allocatable object"_err_en_US,
+        symbol.name().ToString());
+  } else {
+    return true;
+  }
+  return false;
+}
+
 void DataChecker::Leave(const parser::DataIDoObject &object) {
   if (const auto *designator{
           std::get_if<parser::Scalar<common::Indirection<parser::Designator>>>(
               &object.u)}) {
     if (MaybeExpr expr{exprAnalyzer_.Analyze(*designator)}) {
       auto source{designator->thing.value().source};
-      if (evaluate::IsConstantExpr(*expr)) { // C878
+      if (evaluate::IsConstantExpr(*expr)) { // C878,C879
         exprAnalyzer_.Say(
             source, "Data implied do object must be a variable"_err_en_US);
       } else {
         DataVarChecker checker{exprAnalyzer_.context(), source};
         if (checker(*expr) && checker.HasComponentWithoutSubscripts()) { // C880
           exprAnalyzer_.Say(source,
               "Data implied do structure component must be subscripted"_err_en_US);
         }

flang/lib/Semantics/resolve-names-utils.cpp

if (const auto *derived{type->AsDerived()}) {
             ? "Derived type object '%s' with pointer ultimate component"
               " is not allowed in an equivalence set"_err_en_US
             : "Derived type object '%s' with allocatable ultimate component"
               " is not allowed in an equivalence set"_err_en_US;
       } else if (!derived->typeSymbol().get<DerivedTypeDetails>().sequence()) {
         msg = "Nonsequence derived type object '%s'"
               " is not allowed in an equivalence set"_err_en_US;
       }
-    } else if (symbol.IsObjectArray()) {
-      for (const ShapeSpec &spec : symbol.get<ObjectEntityDetails>().shape()) {
-        auto &lbound{spec.lbound().GetExplicit()};
-        auto &ubound{spec.ubound().GetExplicit()};
-        if ((lbound && !evaluate::ToInt64(*lbound)) ||
-            (ubound && !evaluate::ToInt64(*ubound))) {
-          msg = "Automatic array '%s'"
-                " is not allowed in an equivalence set"_err_en_US;
-        }
-      }
-    }
-  }
+    } else if (IsAutomaticObject(symbol)) {
+      msg = "Automatic object '%s'"
   if (!msg.text().empty()) {
     context_.Say(name.source, std::move(msg), name.source);
     return false;
   }
   return true;
 }
 
 bool EquivalenceSets::CheckArrayBound(const parser::Expr &bound) {

flang/lib/Semantics/tools.cpp

bool HasImpureFinal(const DerivedTypeSpec &derived) {
   return std::find_if(
              components.begin(), components.end(), [](const Symbol &x) {
                return x.has<FinalProcDetails>() && !x.attrs().test(Attr::PURE);
              }) != components.end();
 }
 
 bool IsCoarray(const Symbol &symbol) { return symbol.Corank() > 0; }
 
+bool IsAutomaticObject(const Symbol &symbol) {
+  if (IsDummy(symbol) || IsPointer(symbol) || IsAllocatable(symbol)) {
+    return false;
+  }
+  if (const DeclTypeSpec * type{symbol.GetType()}) {
+    if (type->category() == DeclTypeSpec::Character) {
+      ParamValue length{type->characterTypeSpec().length()};
+      if (length.isExplicit()) {
+        if (MaybeIntExpr lengthExpr{length.GetExplicit()}) {
+          if (!ToInt64(lengthExpr)) {
+            return true;
+          }
+        }
+      }
+    }
+  }
+  if (symbol.IsObjectArray()) {
+    for (const ShapeSpec &spec : symbol.get<ObjectEntityDetails>().shape()) {
+      auto &lbound{spec.lbound().GetExplicit()};
+      auto &ubound{spec.ubound().GetExplicit()};
+      if ((lbound && !evaluate::ToInt64(*lbound)) ||
+          (ubound && !evaluate::ToInt64(*ubound))) {
+        return true;
+      }
+    }
+  }
+  return false;
+}
+
 bool IsAssumedLengthCharacter(const Symbol &symbol) {
   if (const DeclTypeSpec * type{symbol.GetType()}) {
     return type->category() == DeclTypeSpec::Character &&
         type->characterTypeSpec().length().isAssumed();
   } else {
     return false;
   }
 }
 
+bool IsInBlankCommon(const Symbol &symbol) {
+  if (FindCommonBlockContaining(symbol)) {
+    if (const auto *details{
+            symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
+      if (details->commonBlock()) {
+        if (details->commonBlock()->name().empty()) {
+          return true;
+        }
+      }
+    }
+  }
+  return false;
+}
+
 // C722 and C723:  For a function to be assumed length, it must be external and
 // of CHARACTER type
 bool IsExternal(const Symbol &symbol) {
   return (symbol.has<SubprogramDetails>() && symbol.owner().IsGlobal()) ||
       symbol.attrs().test(Attr::EXTERNAL);
 }
 
 const Symbol *IsExternalInPureContext(

flang/test/Lower/pre-fir-tree02.f90

 subroutine sub3()
  print *, "normal"
   ! CHECK: EntryStmt
  entry sub4entry()
  print *, "test"
 end subroutine
 
 ! CHECK: Subroutine sub4
-subroutine sub4(i, j)
+subroutine sub4()
   integer :: i
   print*, "test"
   ! CHECK: DataStmt
   data i /1/
 end subroutine

flang/test/Semantics/block-data01.f90

 ! RUN: %S/test_errors.sh %s %t %f18
 ! Test BLOCK DATA subprogram (14.3)
 block data foo
   !ERROR: IMPORT is not allowed in a BLOCK DATA subprogram
   import
   real :: pi = asin(-1.0) ! ok
   !ERROR: An initialized variable in BLOCK DATA must be in a COMMON block
   integer :: notInCommon = 1
   integer :: uninitialized ! ok
   !ERROR: 'p' may not appear in a BLOCK DATA subprogram
   procedure(sin), pointer :: p => cos
   !ERROR: 'p' is already declared as a procedure
   common /block/ pi, p
-  real :: inBlankCommon
-  data inBlankCommon / 1.0 /
-  common inBlankCommon
   !ERROR: An initialized variable in BLOCK DATA must be in a COMMON block
   integer :: inDataButNotCommon
   data inDataButNotCommon /1/
   !ERROR: Two objects in the same EQUIVALENCE set may not be members of distinct COMMON blocks
   integer :: inCommonA, inCommonB
   common /a/ inCommonA, /b/ inCommonB
   equivalence(inCommonA, inCommonB)
   integer :: inCommonD, initialized ! ok
   common /d/ inCommonD
   equivalence(inCommonD, initialized)
   data initialized /2/
 end block data

flang/test/Semantics/data01.f90

 ! RUN: %S/test_errors.sh %s %t %f18
 !Test for checking data constraints, C882-C887
-module m1
+subroutine CheckRepeat
   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/ )
+  integer ::notConstDigits(5)
   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
+  type person
+    integer :: age
+    character(len=25) :: name
+  end type
+  integer :: myAge = 2
+  type(person) myName
   !OK: constant structure constructor
   data myname / person(1, 'Abcd Ijkl') /
   !C883
   !ERROR: 'persn' is not an array
   data myname / persn(2, 'Abcd Efgh') /
   !C884
   !ERROR: Structure constructor in data value must be a constant expression
   data myname / person(myAge, 'Abcd Ijkl') /

flang/test/Semantics/data03.f90

subroutine CheckObject
       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 structure component must be subscripted
       DATA(nums % one, i = 1, 5) / 5 * 1 /
+      !C879
+      !ERROR: Data implied do object must be a variable
+      DATA(newNums % numbers(i), i = 1, 5) / 5 * 1 /
+      !C879
+      !ERROR: Data implied do object must be a variable
+      DATA(newNumsArray(i) % 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 subscripts

flang/test/Semantics/data04.f90

+! RUN: %S/test_errors.sh %s %t %f18
+!Testing data constraints : C876, C877
+module m
+  integer :: first
+  contains
+    subroutine h
+      integer a,b
+      !C876
+      !ERROR: Data object part 'first' must not be accessed by host association
+      DATA first /1/
+    end subroutine
+
+    function g(i)
+      integer ::i
+      g = i *1024
+    end
+
+    function f(i)
+      integer ::i
+      integer ::result
+      integer, allocatable :: a
+      integer :: b(i)
+      character(len=i), pointer:: charPtr
+      character(len=i), allocatable:: charAlloc
+      !C876
+      !ERROR: Data object part 'i' must not be a dummy argument
+      DATA i /1/
+      !C876
+      !ERROR: Data object part 'f' must not be a function result
+      DATA f /1/
+      !C876
+      !ERROR: Data object part 'g' must not be a function name
+      DATA g /1/
+      !C876
+      !ERROR: Data object part 'a' must not be an allocatable object
+      DATA a /1/
+      !C876
+      !ERROR: Data object part 'b' must not be an automatic object
+      DATA b(0) /1/
+      !C876
+      !Ok: As charPtr is a pointer, it is not an automatic object
+      DATA charPtr / NULL() /
+      !C876
+      !ERROR: Data object part 'charalloc' must not be an allocatable object
+      DATA charAlloc / 'abc' /
+      f = i *1024
+    end
+
+    subroutine CheckObject(i)
+      type specialNumbers
+        integer one
+        integer numbers(5)
+        type(specialNumbers), pointer :: headOfTheList
+        integer, pointer, dimension(:) :: ptoarray
+        character, pointer, dimension(:) :: ptochar
+      end type
+      type large
+        integer, allocatable :: allocVal
+        integer, allocatable :: elt(:)
+        integer val
+        type(specialNumbers) numsArray(5)
+      end type
+      type(large) largeNumber
+      type(large), allocatable :: allocatableLarge
+      type(large) :: largeNumberArray(i)
+      type(large) :: largeArray(5)
+      character :: name(i)
+      !C877
+      !OK: Correct use
+      DATA(largeNumber % numsArray(j) % headOfTheList, j = 1, 10) / 10 * NULL() /
+      !C877
+      !ERROR: Data object must not contain pointer 'headofthelist' as a non-rightmost part
+      DATA(largeNumber % numsArray(j) % headOfTheList % one, j = 1, 10) / 10 * NULL() /
+      !C877
+      !ERROR: Rightmost data object pointer 'ptoarray' must not be subscripted
+      DATA(largeNumber % numsArray(j) % ptoarray(1), j = 1, 10) / 10 * 1 /
+      !C877
+      !ERROR: Rightmost data object pointer 'ptochar' must not be subscripted
+      DATA largeNumber % numsArray(0) % ptochar(1:2) / 'ab' /
+      !C876
+      !ERROR: Data object part 'elt' must not be an allocatable object
+      DATA(largeNumber % elt(j) , j = 1, 10) / 10 * 1/
+      !C876
+      !ERROR: Data object part 'allocval' must not be an allocatable object
+      DATA(largeArray(j) % allocVal , j = 1, 10) / 10 * 1/
+      !C876
+      !ERROR: Data object part 'allocatablelarge' must not be an allocatable object
+      DATA allocatableLarge % val / 1 /
+      !C876
+      !ERROR: Data object part 'largenumberarray' must not be an automatic object
+      DATA(largeNumberArray(j) % val, j = 1, 10) / 10 * NULL() /
+      !C876
+      !ERROR: Data object part 'name' must not be an automatic object
+      DATA name( : 2) / 'Ancd' /
+    end
+  end
+
+  block data foo
+          integer :: a,b
+          common /c/ a,b
+          !C876
+          !OK: Correct use
+          DATA a /1/
+  end block data
+
+  module m2
+    integer m2_i
+    type newType
+      integer number
+    end type
+    type(newType) m2_number1
+    contains
+
+    subroutine checkDerivedType(m2_number)
+      type(newType) m2_number
+      type(newType) m2_number3
+      !C876
+      !ERROR: Data object part 'm2_number' must not be a dummy argument
+      DATA m2_number%number /1/
+      !C876
+      !ERROR: Data object part 'm2_number1' must not be accessed by host association
+      DATA m2_number1%number /1/
+      !C876
+      !OK: m2_number3 is not associated through use association
+      DATA m2_number3%number /1/
+    end
+  end
+
+  program new
+    use m2
+    integer a
+    real    b,c
+    type seqType
+      sequence
+      integer number
+    end type
+    type(SeqType) num
+    COMMON b,a,c,num
+    type(newType) m2_number2
+    !C876
+    !ERROR: Data object part 'b' must not be in blank COMMON
+    DATA b /1/
+    !C876
+    !ERROR: Data object part 'm2_i' must not be accessed by use association
+    DATA m2_i /1/
+    !C876
+    !ERROR: Data object part 'm2_number1' must not be accessed by use association
+    DATA m2_number1%number /1/
+    !C876
+    !OK: m2_number2 is not associated through use association
+    DATA m2_number2%number /1/
+    !C876
+    !ERROR: Data object part 'num' must not be in blank COMMON
+    DATA num%number /1/
+  end program

flang/test/Semantics/equivalence01.f90

subroutine s10
   real :: y(4)
   !ERROR: Array with vector subscript 'i' is not allowed in an equivalence set
   equivalence(x(i), y)
 end
 
 subroutine s11(n)
   integer :: n
   real :: x(n), y
-  !ERROR: Automatic array 'x' is not allowed in an equivalence set
+  !ERROR: Automatic object 'x' is not allowed in an equivalence set
   equivalence(x(1), y)
 end
 
 module s12
   real, protected :: a
   integer :: b
   !ERROR: Equivalence set cannot contain 'a' with PROTECTED attribute and 'b' without
   equivalence(a, b)