[flang] Fix semantic checks for C919

[peixin]

Summary

The previous semantic analysis does not consider when the last part-ref
is scalar or complex part. Refactor the previous code and bring all the
checks into one place. The check starts from the designator by
extracting the dataref wrapped including the substring and complex part
and recursively check the base objects.

Co-authored-by: Peter Klausler <[e-mail]>

[peixin]

flang/lib/Semantics/expression.cpp

260

I think this message is not clear enough. For example, users fixing one problem for call sub(t(:)%t3(:)%t2(:)%t1(:)%s(1,:)(1:2)) by changing from s(1,:)(1:2) into s(1,1)(1:2) will get another error.

[klausler]

flang/lib/Semantics/expression.cpp

252

This message is misspelled and inaccurate, and the loop does not do what I think you think it does. It is traversing the subscripts of an array reference like A%C(:,:), not multiple component part-refs.

296

This new message is also misspelled and will be inaccurate for a case like A(:)%C where there is only one component.

1105

Similar problems as previous messages, and perhaps redundant with the other checks. Is there a case that this new code catches that the other checks do not?

[peixin]

flang/lib/Semantics/expression.cpp

252

Right. This may can be the following:

A derived type accessbility cannot have more than one part references with nonzero rank

296

Same as above.

1105

Sorry, my bad. When I fix the test cases, I missed this.

The case not covered by previous checks is when the last part ref is scalar variable.

program m
  type mt
    integer :: x
    character(10) :: s
  end type
  type mt2
    type(mt) :: t1(2)
  end type
  type mt3
    type(mt2) :: t2(2)
  end type
  type mt4
    type(mt3) :: t3(2)
  end type
  type(mt4) :: t(2)

  call sub(t%t3%t2%t1%x)
  call sub2(t%t3%t2%t1%s(1:2))
end

[peixin]

flang/lib/Semantics/expression.cpp

252

I am thinking why we don't use the description the standard says.

The data reference cannot have more than one part references with nonzero rank

BTW, here are gfortran and ifort message:

gfortran: Two or more part references with nonzero rank must not be specified at (1)
ifort: A component cannot be an array if the encompassing structure is an array

[klausler]

flang/lib/Semantics/expression.cpp

252

I understand the constraint. I'll figure out why the existing checks didn't catch the case of a scalar terminal component.

[klausler]

The existing checks nearly work, but they don't recurse to check base objects. Try this patch and see whether you like it -- it brings the checks into one place and handles all of the cases:

diff --git a/flang/include/flang/Semantics/expression.h b/flang/include/flang/Semantics/expression.h
index 6c0d385a..c3755f0a 100644
--- a/flang/include/flang/Semantics/expression.h
+++ b/flang/include/flang/Semantics/expression.h
@@ -322,6 +322,7 @@ private:
       DataRef &&, const Symbol &, const semantics::Scope &);
   MaybeExpr CompleteSubscripts(ArrayRef &&);
   MaybeExpr ApplySubscripts(DataRef &&, std::vector<Subscript> &&);
+  void CheckRanks(const DataRef &);
   MaybeExpr TopLevelChecks(DataRef &&);
   std::optional<Expr<SubscriptInteger>> GetSubstringBound(
       const std::optional<parser::ScalarIntExpr> &);
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index b2330db5..c8685d8f 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -249,20 +249,6 @@ MaybeExpr ExpressionAnalyzer::CompleteSubscripts(ArrayRef &&ref) {
           symbolRank, symbol.name(), subscripts);
     }
     return std::nullopt;
-  } else if (Component * component{ref.base().UnwrapComponent()}) {
-    int baseRank{component->base().Rank()};
-    if (baseRank > 0) {
-      int subscriptRank{0};
-      for (const auto &expr : ref.subscript()) {
-        subscriptRank += expr.Rank();
-      }
-      if (subscriptRank > 0) { // C919a
-        Say("Subscripts of component '%s' of rank-%d derived type "
-            "array have rank %d but must all be scalar"_err_en_US,
-            symbol.name(), baseRank, subscriptRank);
-        return std::nullopt;
-      }
-    }
   } else if (const auto *object{
                  symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
     // C928 & C1002
@@ -306,20 +292,48 @@ MaybeExpr ExpressionAnalyzer::ApplySubscripts(
       std::move(dataRef.u));
 }

+// C919a - only one part-ref of a data-ref may have rank > 0
+void ExpressionAnalyzer::CheckRanks(const DataRef &dataRef) {
+  common::visit(
+      common::visitors{
+          [this](const Component &component) {
+            const Symbol &symbol{component.GetLastSymbol()};
+            if (int componentRank{symbol.Rank()}; componentRank > 0) {
+              if (int baseRank{component.base().Rank()}; baseRank > 0) {
+                Say("Reference to whole rank-%d component '%s' of rank-%d array of derived type is not allowed"_err_en_US,
+                    componentRank, symbol.name(), baseRank);
+              }
+            } else {
+              CheckRanks(component.base());
+            }
+          },
+          [this](const ArrayRef &arrayRef) {
+            if (const auto *component{arrayRef.base().UnwrapComponent()}) {
+              int subscriptRank{0};
+              for (const Subscript &subscript : arrayRef.subscript()) {
+                subscriptRank += subscript.Rank();
+              }
+              if (subscriptRank > 0) {
+                if (int componentBaseRank{component->base().Rank()};
+                    componentBaseRank > 0) {
+                  Say("Subscripts of component '%s' of rank-%d derived type array have rank %d but must all be scalar"_err_en_US,
+                      component->GetLastSymbol().name(), componentBaseRank,
+                      subscriptRank);
+                }
+              } else {
+                CheckRanks(component->base());
+              }
+            }
+          },
+          [](const SymbolRef &) {},
+          [](const CoarrayRef &) {},
+      },
+      dataRef.u);
+}
+
 // Top-level checks for data references.
 MaybeExpr ExpressionAnalyzer::TopLevelChecks(DataRef &&dataRef) {
-  if (Component * component{std::get_if<Component>(&dataRef.u)}) {
-    const Symbol &symbol{component->GetLastSymbol()};
-    int componentRank{symbol.Rank()};
-    if (componentRank > 0) {
-      int baseRank{component->base().Rank()};
-      if (baseRank > 0) { // C919a
-        Say("Reference to whole rank-%d component '%%%s' of "
-            "rank-%d array of derived type is not allowed"_err_en_US,
-            componentRank, symbol.name(), baseRank);
-      }
-    }
-  }
+  CheckRanks(dataRef);
   return Designate(std::move(dataRef));
 }

[peixin]

In D126595#3544202, @klausler wrote:

The existing checks nearly work, but they don't recurse to check base objects. Try this patch and see whether you like it -- it brings the checks into one place and handles all of the cases:

diff --git a/flang/include/flang/Semantics/expression.h b/flang/include/flang/Semantics/expression.h
index 6c0d385a..c3755f0a 100644
--- a/flang/include/flang/Semantics/expression.h
+++ b/flang/include/flang/Semantics/expression.h
@@ -322,6 +322,7 @@ private:
       DataRef &&, const Symbol &, const semantics::Scope &);
   MaybeExpr CompleteSubscripts(ArrayRef &&);
   MaybeExpr ApplySubscripts(DataRef &&, std::vector<Subscript> &&);
+  void CheckRanks(const DataRef &);
   MaybeExpr TopLevelChecks(DataRef &&);
   std::optional<Expr<SubscriptInteger>> GetSubstringBound(
       const std::optional<parser::ScalarIntExpr> &);
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index b2330db5..c8685d8f 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -249,20 +249,6 @@ MaybeExpr ExpressionAnalyzer::CompleteSubscripts(ArrayRef &&ref) {
           symbolRank, symbol.name(), subscripts);
     }
     return std::nullopt;
-  } else if (Component * component{ref.base().UnwrapComponent()}) {
-    int baseRank{component->base().Rank()};
-    if (baseRank > 0) {
-      int subscriptRank{0};
-      for (const auto &expr : ref.subscript()) {
-        subscriptRank += expr.Rank();
-      }
-      if (subscriptRank > 0) { // C919a
-        Say("Subscripts of component '%s' of rank-%d derived type "
-            "array have rank %d but must all be scalar"_err_en_US,
-            symbol.name(), baseRank, subscriptRank);
-        return std::nullopt;
-      }
-    }
   } else if (const auto *object{
                  symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
     // C928 & C1002
@@ -306,20 +292,48 @@ MaybeExpr ExpressionAnalyzer::ApplySubscripts(
       std::move(dataRef.u));
 }

+// C919a - only one part-ref of a data-ref may have rank > 0
+void ExpressionAnalyzer::CheckRanks(const DataRef &dataRef) {
+  common::visit(
+      common::visitors{
+          [this](const Component &component) {
+            const Symbol &symbol{component.GetLastSymbol()};
+            if (int componentRank{symbol.Rank()}; componentRank > 0) {
+              if (int baseRank{component.base().Rank()}; baseRank > 0) {
+                Say("Reference to whole rank-%d component '%s' of rank-%d array of derived type is not allowed"_err_en_US,
+                    componentRank, symbol.name(), baseRank);
+              }
+            } else {
+              CheckRanks(component.base());
+            }
+          },
+          [this](const ArrayRef &arrayRef) {
+            if (const auto *component{arrayRef.base().UnwrapComponent()}) {
+              int subscriptRank{0};
+              for (const Subscript &subscript : arrayRef.subscript()) {
+                subscriptRank += subscript.Rank();
+              }
+              if (subscriptRank > 0) {
+                if (int componentBaseRank{component->base().Rank()};
+                    componentBaseRank > 0) {
+                  Say("Subscripts of component '%s' of rank-%d derived type array have rank %d but must all be scalar"_err_en_US,
+                      component->GetLastSymbol().name(), componentBaseRank,
+                      subscriptRank);
+                }
+              } else {
+                CheckRanks(component->base());
+              }
+            }
+          },
+          [](const SymbolRef &) {},
+          [](const CoarrayRef &) {},
+      },
+      dataRef.u);
+}
+
 // Top-level checks for data references.
 MaybeExpr ExpressionAnalyzer::TopLevelChecks(DataRef &&dataRef) {
-  if (Component * component{std::get_if<Component>(&dataRef.u)}) {
-    const Symbol &symbol{component->GetLastSymbol()};
-    int componentRank{symbol.Rank()};
-    if (componentRank > 0) {
-      int baseRank{component->base().Rank()};
-      if (baseRank > 0) { // C919a
-        Say("Reference to whole rank-%d component '%%%s' of "
-            "rank-%d array of derived type is not allowed"_err_en_US,
-            componentRank, symbol.name(), baseRank);
-      }
-    }
-  }
+  CheckRanks(dataRef);
   return Designate(std::move(dataRef));
 }

Thanks for this.

it brings the checks into one place and handles all of the cases

This is really what I like. I have two more concerns.

1. TopLevelChecks is called in both Analyze(const parser::Substring & and Analyze(const parser::Designator. There is redundant check for the sub1 call in the following case:

program m
  type mt
    integer :: x
    character(10) :: s
  end type
  type mt2
    type(mt) :: t1(2)
  end type
  type mt3
    type(mt2) :: t2(2)
  end type
  type mt4
    type(mt3) :: t3(2)
  end type
  type(mt4) :: t(2)
  call sub(t%t3%t2%t1%x)
  call sub1(t(1)%t3(1)%t2(1)%t1(1)%s(1:))
end

| | | | | ActualArg -> Expr = 't%t3%t2%t1%x'
| | | | | | Designator -> DataRef -> StructureComponent
| | | | | | | DataRef -> StructureComponent
| | | | | | | | DataRef -> StructureComponent
| | | | | | | | | DataRef -> StructureComponent
| | | | | | | | | | DataRef -> Name = 't'
| | | | | | | | | | Name = 't3'
| | | | | | | | | Name = 't2'
| | | | | | | | Name = 't1'
| | | | | | | Name = 'x'
| | | | | ActualArg -> Expr = 't(1_8)%t3(1_8)%t2(1_8)%t1(1_8)%s(1_8:10_8)'
| | | | | | Designator -> Substring
| | | | | | | DataRef -> StructureComponent
| | | | | | | | DataRef -> ArrayElement
| | | | | | | | | DataRef -> StructureComponent
| | | | | | | | | | DataRef -> ArrayElement
| | | | | | | | | | | DataRef -> StructureComponent
| | | | | | | | | | | | DataRef -> ArrayElement
| | | | | | | | | | | | | DataRef -> StructureComponent
| | | | | | | | | | | | | | DataRef -> ArrayElement
| | | | | | | | | | | | | | | DataRef -> Name = 't'
| | | | | | | | | | | | | | | SectionSubscript -> Integer -> Expr = '1_4'
| | | | | | | | | | | | | | | | LiteralConstant -> IntLiteralConstant = '1'
| | | | | | | | | | | | | | Name = 't3'
| | | | | | | | | | | | | SectionSubscript -> Integer -> Expr = '1_4'
| | | | | | | | | | | | | | LiteralConstant -> IntLiteralConstant = '1'
| | | | | | | | | | | | Name = 't2'
| | | | | | | | | | | SectionSubscript -> Integer -> Expr = '1_4'
| | | | | | | | | | | | LiteralConstant -> IntLiteralConstant = '1'
| | | | | | | | | | Name = 't1'
| | | | | | | | | SectionSubscript -> Integer -> Expr = '1_4'
| | | | | | | | | | LiteralConstant -> IntLiteralConstant = '1'
| | | | | | | | Name = 's'
| | | | | | | SubstringRange
| | | | | | | | Scalar -> Integer -> Expr = '1_4'
| | | | | | | | | LiteralConstant -> IntLiteralConstant = '1'

To look at the parse-tree, moving CheckRanks inside Analyze(const parser::Designator seems to be better.

2. The purpose of returning void for CheckRanks is to give users more semantic error messages, right? Can we return one boolean value for it and return std::nullopt in caller if it fails? In this case, for one expression, we abort the analysis if there is one error in case there will be one internal error or seg fault? This is not one hard suggestion.

[klausler]

Your suggestions seem fine to me. If you move CheckRanks out of TopLevelChecks, then TopLevelChecks can just become a call to Designate, too.

[peixin]

If you move CheckRanks out of TopLevelChecks, then TopLevelChecks can just become a call to Designate, too.

Yes, that's what I also wanted to suggest, too. Thanks for the confirm. Do you want to fix this patch and create one PR considering you contribute more than me for this patch, or let me finish it with some more regression tests of the last symbol is scalar non-char and char and name you as an co-author?

[klausler]

In D126595#3544554, @peixin wrote:

If you move CheckRanks out of TopLevelChecks, then TopLevelChecks can just become a call to Designate, too.

Yes, that's what I also wanted to suggest, too. Thanks for the confirm. Do you want to fix this patch and create one PR considering you contribute more than me for this patch, or let me finish it with some more regression tests of the last symbol is scalar non-char and char and name you as an co-author?

I'm happy either way, just let me know.

[peixin]

@klausler Sorry, I may mislead you.

1. I dig deep for this and find my proposed suggestions are not entirely correct. Your solution also cannot support all the cases. The DataRef is defined here (https://github.com/llvm/llvm-project/blob/42c3c70a9e3f0a697b8794f4e8b603091ffb12a4/flang/include/flang/Evaluate/variable.h#L285-L299). It does not contain the substring. So I missed the substring.

And Designator is used as follows:

(gdb) pt d
type = const struct Fortran::parser::Designator {
    Fortran::parser::CharBlock source;
    std::variant<Fortran::parser::DataRef, Fortran::parser::Substring> u;

subroutine s()
  interface
    function real_info(i)
    end
  end interface
  type mt
    complex :: c, c2(2)
    integer :: x, x2(2)
    character(10) :: s, s2(2)
   contains
    procedure, nopass :: info => real_info
  end type
  type mt2
    type(mt) :: t1(2)
  end type
  type mt3
    type(mt2) :: t2(2)
  end type
  type mt4
    type(mt3) :: t3(2)
  end type
  type(mt4) :: t(2)
  call sub5(t%t3%t2%t1%c%RE)
  call sub6(t%t3%t2%t1%c2(1)%RE)
end

The parse tree is like the following:

| | | | | ActualArg -> Expr = 't%t3%t2%t1%c%RE'
| | | | | | Designator -> DataRef -> StructureComponent
| | | | | | | DataRef -> StructureComponent
| | | | | ActualArg -> Expr = 't%t3%t2%t1%c2(1_8)%RE'
| | | | | | Designator -> DataRef -> StructureComponent
| | | | | | | DataRef -> ArrayElement
| | | | | | | | DataRef -> StructureComponent

The CheckRanks cannot be at the position of previous TopLevelChecks (https://github.com/llvm/llvm-project/blob/88af539c0eaa5a282e6c1632797d33dfc0ebcb65/flang/lib/Semantics/expression.cpp#L374-L376) since the result after Analyze for complex part and others are different and the dataRef for complex part is empty. So the real solution should be like the following:

MaybeExpr ExpressionAnalyzer::Analyze(const parser::Designator &d) {
  auto restorer{GetContextualMessages().SetLocation(d.source)};
  FixMisparsedSubstring(d);
  if (auto *dataRef{std::get_if<parser::DataRef>(&d.u)}) {
    if (!CheckRanks(std::move(*dataRef))) {
      return std::nullopt;
    }
  } else if (auto *substr{std::get_if<parser::Substring>(&d.u)}) {
    ...
  }

  // These checks have to be deferred to these "top level" data-refs where
  // we can be sure that there are no following subscripts (yet).
  if (MaybeExpr result{Analyze(d.u)}) {
    if (std::optional<DataRef> dataRef{ExtractDataRef(std::move(result))}) {
      return Designate(std::move(*dataRef));
    }
    return result;
  }
  return std::nullopt;
}

If you agree, I would like to finish this.

2. I hit some more unimplemented semantic checks:

function real_info1(i)
end
subroutine real_info2()
end
subroutine s()
  interface
    function real_info1(i)
    end
    subroutine real_info2()
    end
  end interface
  type mt
    complex :: c, c2(2)
    integer :: x, x2(2)
    character(10) :: s, s2(2)
   contains
    procedure, nopass :: info1 => real_info1
    procedure, nopass :: info2 => real_info2
  end type
  type mt2
    type(mt) :: t1(2)
  end type
  type mt3
    type(mt2) :: t2(2)
  end type
  type mt4
    type(mt3) :: t3(2)
  end type
  type(mt4) :: t(2)

  call sub0(t%t3%t2%t1%info1(i))
  call sub1(t%t3%t2%t1%info2) ! test this when remove the nopass
  call t%t3%t2%t1%info2
  call sub2(t%t3%t2%t1%info2) ! test this with nopass attribute
end

These four are not implemented. Do you want to take up some, then I can file some tickets for you? After finish this patch, I will also start to look at one or more.

3. When I read the code in expression.cpp, some regression tests are missed. I mean, only have function code. The test cases in this patch is one example. Do you have any plans to add them? I can also help add some when I read the code and find the missed ones.

[peixin]

@klausler Please check if this is the right fix. This should be able to cover all the scenarios. And I think the previous ExtractDataRef is not complete.

[klausler]

I just don't understand your last two comments. But if you find checks missing in semantics, and they're not related to this patch, please file them as bugs.

[peixin]

In D126595#3545939, @klausler wrote:

I just don't understand your last two comments. But if you find checks missing in semantics, and they're not related to this patch, please file them as bugs.

For the second comment, I find some checks missing in semantics when I extend the test cases. I will file them.

For the third comment, I mean there are some semantic checks without regression tests. Should we add the regression tests later?

These two comments are not related to this patch. Sorry, I should ask you by creating one issue in llvm-project.

[peixin]

1. Add description in summary.
2. Add co-author.
3. Add regression tests.

[peixin]

@klausler Is the current revision the right solution? If not, please feel free to take up this.

flang/include/flang/Evaluate/tools.h

if (!typeParam->base()) {
         }
       }
     }
   }
   return nullptr;
 }
 
 // If an expression simply wraps a DataRef, extract and return it.
-// The Boolean argument controls the handling of Substring
+// The Boolean argument controls the handling of Substring and ComplexPart
 // references: when true (not default), it extracts the base DataRef
-// of a substring, if it has one.
+// of a substring or complex part, if it has one.
 template <typename A>
 common::IfNoLvalue<std::optional<DataRef>, A> ExtractDataRef(
-    const A &, bool intoSubstring) {
+    const A &, bool intoSubstring, bool intoComplexPart) {
   return std::nullopt; // default base case
 }
 template <typename T>
-std::optional<DataRef> ExtractDataRef(
-    const Designator<T> &d, bool intoSubstring = false) {
+std::optional<DataRef> ExtractDataRef(const Designator<T> &d,
+    bool intoSubstring = false, bool intoComplexPart = false) {
   return common::visit(
       [=](const auto &x) -> std::optional<DataRef> {
         if constexpr (common::HasMember<decltype(x), decltype(DataRef::u)>) {
           return DataRef{x};
         }
         if constexpr (std::is_same_v<std::decay_t<decltype(x)>, Substring>) {
           if (intoSubstring) {
             return ExtractSubstringBase(x);
           }
         }
+        if constexpr (std::is_same_v<std::decay_t<decltype(x)>, ComplexPart>) {
+          if (intoComplexPart) {
+            return x.complex();
+          }
+        }
         return std::nullopt; // w/o "else" to dodge bogus g++ 8.1 warning
       },
       d.u);
 }
 template <typename T>
-std::optional<DataRef> ExtractDataRef(
-    const Expr<T> &expr, bool intoSubstring = false) {
+std::optional<DataRef> ExtractDataRef(const Expr<T> &expr,
+    bool intoSubstring = false, bool intoComplexPart = false) {
   return common::visit(
-      [=](const auto &x) { return ExtractDataRef(x, intoSubstring); }, expr.u);
+      [=](const auto &x) {
+        return ExtractDataRef(x, intoSubstring, intoComplexPart);
+      },
+      expr.u);
 }
 template <typename A>
-std::optional<DataRef> ExtractDataRef(
-    const std::optional<A> &x, bool intoSubstring = false) {
+std::optional<DataRef> ExtractDataRef(const std::optional<A> &x,
+    bool intoSubstring = false, bool intoComplexPart = false) {
   if (x) {
-    return ExtractDataRef(*x, intoSubstring);
+    return ExtractDataRef(*x, intoSubstring, intoComplexPart);
   } else {
     return std::nullopt;
   }
 }
 template <typename A>
-std::optional<DataRef> ExtractDataRef(const A *p, bool intoSubstring = false) {
+std::optional<DataRef> ExtractDataRef(
+    const A *p, bool intoSubstring = false, bool intoComplexPart = false) {
   if (p) {
-    return ExtractDataRef(*p, intoSubstring);
+    return ExtractDataRef(*p, intoSubstring, intoComplexPart);
   } else {
     return std::nullopt;
   }
 }
 std::optional<DataRef> ExtractDataRef(
     const ActualArgument &, bool intoSubstring = false);
 
 std::optional<DataRef> ExtractSubstringBase(const Substring &);

flang/include/flang/Semantics/expression.h

private:
   std::optional<Subscript> AnalyzeSectionSubscript(
       const parser::SectionSubscript &);
   std::vector<Subscript> AnalyzeSectionSubscripts(
       const std::list<parser::SectionSubscript> &);
   std::optional<Component> CreateComponent(
       DataRef &&, const Symbol &, const semantics::Scope &);
   MaybeExpr CompleteSubscripts(ArrayRef &&);
   MaybeExpr ApplySubscripts(DataRef &&, std::vector<Subscript> &&);
-  MaybeExpr TopLevelChecks(DataRef &&);
+  bool CheckRanks(const DataRef &); // Return false if error exists.
   std::optional<Expr<SubscriptInteger>> GetSubstringBound(
       const std::optional<parser::ScalarIntExpr> &);
   MaybeExpr AnalyzeDefinedOp(const parser::Name &, ActualArguments &&);
 
   struct CalleeAndArguments {
     // A non-component function reference may constitute a misparsed
     // structure constructor, in which case its derived type's Symbol
     // will appear here.

flang/lib/Semantics/expression.cpp

MaybeExpr ExpressionAnalyzer::CompleteSubscripts(ArrayRef &&ref) {
   if (subscripts == 0) {
     return std::nullopt; // error recovery
   } else if (subscripts != symbolRank) {
     if (symbolRank != 0) {
       Say("Reference to rank-%d object '%s' has %d subscripts"_err_en_US,
           symbolRank, symbol.name(), subscripts);
     }
     return std::nullopt;
-  } else if (Component * component{ref.base().UnwrapComponent()}) {
-    int baseRank{component->base().Rank()};
-    if (baseRank > 0) {
-      int subscriptRank{0};
-      for (const auto &expr : ref.subscript()) {
-        subscriptRank += expr.Rank();
-      }
-      if (subscriptRank > 0) { // C919a
-        Say("Subscripts of component '%s' of rank-%d derived type "
-            "array have rank %d but must all be scalar"_err_en_US,
-            symbol.name(), baseRank, subscriptRank);
-        return std::nullopt;
-      }
-    }
   } else if (const auto *object{
                  symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
     // C928 & C1002
     if (Triplet * last{std::get_if<Triplet>(&ref.subscript().back().u)}) {
       if (!last->upper() && object->IsAssumedSize()) {
         Say("Assumed-size array '%s' must have explicit final "
             "subscript upper bound value"_err_en_US,
             symbol.name());
         return std::nullopt;
return common::visit(
           [&](auto &&) -> MaybeExpr {
             DIE("bad base for ArrayRef");
             return std::nullopt;
           },
       },
       std::move(dataRef.u));
 }
 
-// Top-level checks for data references.
-MaybeExpr ExpressionAnalyzer::TopLevelChecks(DataRef &&dataRef) {
-  if (Component * component{std::get_if<Component>(&dataRef.u)}) {
-    const Symbol &symbol{component->GetLastSymbol()};
-    int componentRank{symbol.Rank()};
-    if (componentRank > 0) {
-      int baseRank{component->base().Rank()};
-      if (baseRank > 0) { // C919a
-        Say("Reference to whole rank-%d component '%%%s' of "
-            "rank-%d array of derived type is not allowed"_err_en_US,
+// C919a - only one part-ref of a data-ref may have rank > 0
+bool ExpressionAnalyzer::CheckRanks(const DataRef &dataRef) {
+  return common::visit(
+      common::visitors{
+          [this](const Component &component) {
+            const Symbol &symbol{component.GetLastSymbol()};
+            if (int componentRank{symbol.Rank()}; componentRank > 0) {
+              if (int baseRank{component.base().Rank()}; baseRank > 0) {
+                Say("Reference to whole rank-%d component '%s' of rank-%d array of derived type is not allowed"_err_en_US,
                     componentRank, symbol.name(), baseRank);
+                return false;
               }
+            } else {
+              return CheckRanks(component.base());
             }
+            return true;
+          },
+          [this](const ArrayRef &arrayRef) {
+            if (const auto *component{arrayRef.base().UnwrapComponent()}) {
+              int subscriptRank{0};
+              for (const Subscript &subscript : arrayRef.subscript()) {
+                subscriptRank += subscript.Rank();
               }
-  return Designate(std::move(dataRef));
+              if (subscriptRank > 0) {
+                if (int componentBaseRank{component->base().Rank()};
+                    componentBaseRank > 0) {
+                  Say("Subscripts of component '%s' of rank-%d derived type array have rank %d but must all be scalar"_err_en_US,
+                      component->GetLastSymbol().name(), componentBaseRank,
+                      subscriptRank);
+                  return false;
+                }
+              } else {
+                return CheckRanks(component->base());
+              }
+            }
+            return true;
+          },
+          [](const SymbolRef &) { return true; },
+          [](const CoarrayRef &) { return true; },
+      },
+      dataRef.u);
 }
 
 // Parse tree correction after a substring S(j:k) was misparsed as an
 // array section.  N.B. Fortran substrings have to have a range, not a
 // single index.
 static void FixMisparsedSubstring(const parser::Designator &d) {
   auto &mutate{const_cast<parser::Designator &>(d)};
   if (auto *dataRef{std::get_if<parser::DataRef>(&mutate.u)}) {
static void FixMisparsedSubstring(const parser::Designator &d) {
   }
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::Designator &d) {
   auto restorer{GetContextualMessages().SetLocation(d.source)};
   FixMisparsedSubstring(d);
   // These checks have to be deferred to these "top level" data-refs where
   // we can be sure that there are no following subscripts (yet).
-  // Substrings have already been run through TopLevelChecks() and
-  // won't be returned by ExtractDataRef().
   if (MaybeExpr result{Analyze(d.u)}) {
     if (std::optional<DataRef> dataRef{ExtractDataRef(std::move(result))}) {
-      return TopLevelChecks(std::move(*dataRef));
+      if (!CheckRanks(std::move(*dataRef))) {
+        return std::nullopt;
+      }
+      return Designate(std::move(*dataRef));
+    } else if (std::optional<DataRef> dataRef{
+                   ExtractDataRef(std::move(result), /*intoSubstring=*/true)}) {
+      if (!CheckRanks(std::move(*dataRef))) {
+        return std::nullopt;
+      }
+    } else if (std::optional<DataRef> dataRef{ExtractDataRef(std::move(result),
+                   /*intoSubstring=*/false, /*intoComplexPart=*/true)}) {
+      if (!CheckRanks(std::move(*dataRef))) {
+        return std::nullopt;
+      }
     }
     return result;
   }
   return std::nullopt;
 }
 
 // A utility subroutine to repackage optional expressions of various levels
 // of type specificity as fully general MaybeExpr values.
if (bound) {
     }
   }
   return std::nullopt;
 }
 
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::Substring &ss) {
   if (MaybeExpr baseExpr{Analyze(std::get<parser::DataRef>(ss.t))}) {
     if (std::optional<DataRef> dataRef{ExtractDataRef(std::move(*baseExpr))}) {
-      if (MaybeExpr newBaseExpr{TopLevelChecks(std::move(*dataRef))}) {
+      if (MaybeExpr newBaseExpr{Designate(std::move(*dataRef))}) {
         if (std::optional<DataRef> checked{
                 ExtractDataRef(std::move(*newBaseExpr))}) {
           const parser::SubstringRange &range{
               std::get<parser::SubstringRange>(ss.t)};
           std::optional<Expr<SubscriptInteger>> first{
               GetSubstringBound(std::get<0>(range.t))};
           std::optional<Expr<SubscriptInteger>> last{
               GetSubstringBound(std::get<1>(range.t))};
if (sym->detailsIf<semantics::TypeParamDetails>()) {
             "A type parameter inquiry must be applied to "
             "a designator"_err_en_US);
       }
     } else if (!dtSpec || !dtSpec->scope()) {
       CHECK(context_.AnyFatalError() || !foldingContext_.messages().empty());
       return std::nullopt;
     } else if (std::optional<DataRef> dataRef{
                    ExtractDataRef(std::move(*dtExpr))}) {
       if (auto component{
               CreateComponent(std::move(*dataRef), *sym, *dtSpec->scope())}) {
         return Designate(DataRef{std::move(*component)});
       } else {
         Say(name, "Component is not in scope of derived TYPE(%s)"_err_en_US,
             dtSpec->typeSymbol().name());
       }
     } else {
       Say(name,

flang/test/Semantics/expr-errors04.f90

+! RUN: %python %S/test_errors.py %s %flang_fc1
+! Regression test for more than one part-ref with nonzero rank
+
+program m
+  type mt
+    complex :: c, c2(2)
+    integer :: x, x2(2)
+    character(10) :: s, s2(2)
+  end type
+  type mt2
+    type(mt) :: t1(2,2)
+  end type
+  type mt3
+    type(mt2) :: t2(2)
+  end type
+  type mt4
+    type(mt3) :: t3(2)
+  end type
+  type(mt4) :: t(2)
+
+  print *, t(1)%t3(1)%t2(1)%t1%x ! no error
+  print *, t(1)%t3(1)%t2(1)%t1%x2(1) ! no error
+  print *, t(1)%t3(1)%t2(1)%t1%s(1:2) ! no error
+  print *, t(1)%t3(1)%t2(1)%t1%s2(1)(1:2) ! no error
+  print *, t(1)%t3(1)%t2(1)%t1%c%RE ! no error
+  print *, t(1)%t3(1)%t2(1)%t1%c%IM ! no error
+  print *, t(1)%t3(1)%t2(1)%t1%c2(1)%RE ! no error
+  print *, t(1)%t3(1)%t2(1)%t1%c2(1)%IM ! no error
+
+  !ERROR: Reference to whole rank-2 component 't1' of rank-1 array of derived type is not allowed
+  print *, t%t3%t2%t1%x
+  !ERROR: Reference to whole rank-2 component 't1' of rank-1 array of derived type is not allowed
+  print *, t(1)%t3%t2%t1%x
+  !ERROR: Reference to whole rank-2 component 't1' of rank-1 array of derived type is not allowed
+  print *, t(1)%t3(1)%t2%t1%x
+  !ERROR: Reference to whole rank-2 component 't1' of rank-1 array of derived type is not allowed
+  print *, t(1)%t3%t2(1)%t1%x
+  !ERROR: Reference to whole rank-2 component 't1' of rank-1 array of derived type is not allowed
+  print *, t%t3%t2%t1%x2(1)
+  !ERROR: Reference to whole rank-1 component 'x2' of rank-2 array of derived type is not allowed
+  print *, t(1)%t3%t2%t1%x2
+  !ERROR: Reference to whole rank-2 component 't1' of rank-1 array of derived type is not allowed
+  print *, t(1)%t3(1)%t2%t1%x2(1)
+  !ERROR: Subscripts of component 'x2' of rank-2 derived type array have rank 1 but must all be scalar
+  print *, t(1)%t3(1)%t2(1)%t1%x2(1:)
+  !ERROR: Reference to whole rank-2 component 't1' of rank-1 array of derived type is not allowed
+  print *, t%t3%t2%t1%s(1:2)
+  !ERROR: Reference to whole rank-2 component 't1' of rank-1 array of derived type is not allowed
+  print *, t(1)%t3%t2(1)%t1%s(1:2)
+  !ERROR: Subscripts of component 't1' of rank-1 derived type array have rank 1 but must all be scalar
+  print *, t%t3%t2%t1(1,:)%s(1:2)
+  !ERROR: Reference to whole rank-2 component 't1' of rank-1 array of derived type is not allowed
+  print *, t%t3%t2%t1%s2(1)(1:2)
+  !ERROR: Subscripts of component 's2' of rank-2 derived type array have rank 1 but must all be scalar
+  print *, t(1)%t3%t2%t1%s2(1:)(1:2)
+  !ERROR: Reference to whole rank-2 component 't1' of rank-1 array of derived type is not allowed
+  print *, t%t3%t2%t1%c%RE
+  !ERROR: Reference to whole rank-2 component 't1' of rank-1 array of derived type is not allowed
+  print *, t(1)%t3%t2%t1%c%RE
+  !ERROR: Reference to whole rank-2 component 't1' of rank-1 array of derived type is not allowed
+  print *, t(1)%t3(1)%t2%t1%c%RE
+  !ERROR: Reference to whole rank-2 component 't1' of rank-1 array of derived type is not allowed
+  print *, t(1)%t3%t2(1)%t1%c%RE
+  !ERROR: Reference to whole rank-2 component 't1' of rank-1 array of derived type is not allowed
+  print *, t%t3%t2%t1%c%IM
+  !ERROR: Reference to whole rank-2 component 't1' of rank-1 array of derived type is not allowed
+  print *, t%t3%t2%t1%c2(1)%RE
+  !ERROR: Reference to whole rank-2 component 't1' of rank-1 array of derived type is not allowed
+  print *, t(1)%t3%t2%t1%c2(1)%RE
+  !ERROR: Subscripts of component 'c2' of rank-2 derived type array have rank 1 but must all be scalar
+  print *, t(1)%t3(1)%t2%t1%c2(1:)%RE
+  !ERROR: Reference to whole rank-2 component 't1' of rank-1 array of derived type is not allowed
+  print *, t(1)%t3%t2(1)%t1%c2(1)%RE
+  !ERROR: Reference to whole rank-2 component 't1' of rank-1 array of derived type is not allowed
+  print *, t%t3%t2%t1%c2(1)%IM
+end