[Flang][OpenMP] Improve Semantics for Derived Type Array Elements

Flang does not allow the use of Structure Component types inside of
certain OpenMP clauses. While this has been introduced, it seemed
that Structure Component Array Elements were not being captured as
they got embedded in the parse tree. To ensure all structure component
types are identified, a new `HasStructureComponent` evaluate function
has been introduced to walk a Semantics expression, identified where
Components are used within.

This replaces the previous implementation of `CheckStructureComponent`
which just looked for the StructureComponent inside of a DataRef.

Fixes #150830

Author: Stylie777

flang/include/flang/Evaluate/tools.h

@@ -1110,6 +1110,9 @@ bool IsArraySection(const Expr<SomeType> &expr);
 // Predicate: does an expression contain constant?
 bool HasConstant(const Expr<SomeType> &);
 
+// Predicate: Does an expression contain a component
+bool HasStructureComponent(const Expr<SomeType> &expr);
+
 // Utilities for attaching the location of the declaration of a symbol
 // of interest to a message.  Handles the case of USE association gracefully.
 parser::Message *AttachDeclaration(parser::Message &, const Symbol &);

flang/lib/Evaluate/tools.cpp

@@ -1210,6 +1210,27 @@ bool HasConstant(const Expr<SomeType> &expr) {
   return HasConstantHelper{}(expr);
 }
 
+// HasStructureComponent()
+struct HasStructureComponentHelper : public AnyTraverse<HasStructureComponentHelper, bool, false> {
+  using Base = AnyTraverse<HasStructureComponentHelper, bool, false>;
+  HasStructureComponentHelper() : Base(*this) {}
+  using Base::operator();
+
+  bool operator()(const DataRef &dataRef) const {
+    return std::holds_alternative<Component>(dataRef.u);
+  }
+  bool operator()(const NamedEntity &NamedEntity) const {
+    return NamedEntity.UnwrapComponent() != nullptr;
+  }
+  bool operator()(const Component &) const {
+    return true;
+  }
+};
+
+bool HasStructureComponent(const Expr<SomeType> &expr) {
+  return HasStructureComponentHelper{}(expr);
+}
+
 parser::Message *AttachDeclaration(
     parser::Message &message, const Symbol &symbol) {
   const Symbol *unhosted{&symbol};

flang/lib/Semantics/check-omp-structure.cpp

@@ -4673,12 +4673,13 @@ void OmpStructureChecker::Enter(const parser::OmpClause::Copyin &x) {
 void OmpStructureChecker::CheckStructureComponent(
     const parser::OmpObjectList &objects, llvm::omp::Clause clauseId) {
   auto CheckComponent{[&](const parser::Designator &designator) {
-    if (auto *dataRef{std::get_if<parser::DataRef>(&designator.u)}) {
+    if (const parser::DataRef *dataRef{std::get_if<parser::DataRef>(&designator.u)}) {
       if (!IsDataRefTypeParamInquiry(dataRef)) {
-        if (auto *comp{parser::Unwrap<parser::StructureComponent>(*dataRef)}) {
-          context_.Say(comp->component.source,
-              "A variable that is part of another variable cannot appear on the %s clause"_err_en_US,
-              parser::ToUpperCaseLetters(getClauseName(clauseId).str()));
+        const auto expr = AnalyzeExpr(context_, designator);
+        if (expr.has_value() && evaluate::HasStructureComponent(expr.value())) {
+          context_.Say(designator.source,
+            "A variable that is part of another variable cannot appear on the %s clause"_err_en_US,
+            parser::ToUpperCaseLetters(getClauseName(clauseId).str()));
         }
       }
     }

flang/test/Semantics/OpenMP/in-reduction.f90

@@ -47,6 +47,7 @@ subroutine f06
     integer :: a(10)
   end type
   type(t) :: x
+!ERROR: A variable that is part of another variable cannot appear on the IN_REDUCTION clause
 !ERROR: The base expression of an array element or section in IN_REDUCTION clause must be an identifier
 !$omp target in_reduction(+: x%a(2))
 !$omp end target
@@ -57,6 +58,7 @@ subroutine f07
     integer :: a(10)
   end type
   type(t) :: x
+!ERROR: A variable that is part of another variable cannot appear on the IN_REDUCTION clause
 !ERROR: The base expression of an array element or section in IN_REDUCTION clause must be an identifier
 !$omp target in_reduction(+: x%a(1:10))
 !$omp end target

flang/test/Semantics/OpenMP/reduction15.f90

@@ -13,6 +13,7 @@ module m
 
   subroutine f00
     type(t) :: x
+  !ERROR: A variable that is part of another variable cannot appear on the REDUCTION clause
   !ERROR: The base expression of an array element or section in REDUCTION clause must be an identifier
   !$omp do reduction (+ : x%a(2))
     do i = 1, 10
@@ -22,6 +23,7 @@ subroutine f00
 
   subroutine f01
     type(t) :: x
+  !ERROR: A variable that is part of another variable cannot appear on the REDUCTION clause
   !ERROR: The base expression of an array element or section in REDUCTION clause must be an identifier
   !$omp do reduction (+ : x%a(1:10))
     do i = 1, 10

flang/test/Semantics/OpenMP/reduction17.f90

@@ -0,0 +1,18 @@
+! Test that Structure Component Array Elements are caught by Semantics and return an error
+! RUN: %python %S/../test_errors.py %s %flang_fc1 -fopenmp -fopenmp-version=45
+
+type test_type
+    integer :: array(2)
+end type
+
+contains
+    subroutine test
+        type(test_type) :: x
+
+        !ERROR: A variable that is part of another variable cannot appear on the REDUCTION clause
+        !$omp do reduction(+: x%array(2))
+        do i=1, 2
+        end do
+        !$omp end do
+    end subroutine
+end

flang/test/Semantics/OpenMP/task-reduction.f90

@@ -47,6 +47,7 @@ subroutine f06
     integer :: a(10)
   end type
   type(t) :: x
+!ERROR: A variable that is part of another variable cannot appear on the TASK_REDUCTION clause
 !ERROR: The base expression of an array element or section in TASK_REDUCTION clause must be an identifier
 !$omp taskgroup task_reduction(+: x%a(2))
 !$omp end taskgroup
@@ -57,6 +58,7 @@ subroutine f07
     integer :: a(10)
   end type
   type(t) :: x
+!ERROR: A variable that is part of another variable cannot appear on the TASK_REDUCTION clause
 !ERROR: The base expression of an array element or section in TASK_REDUCTION clause must be an identifier
 !$omp taskgroup task_reduction(+: x%a(1:10))
 !$omp end taskgroup