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

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,20 @@ 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 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,10 +4673,12 @@ 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,
+        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