diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h index 7f64d230f7348..4248e3a5461f5 100644 --- a/flang/include/flang/Evaluate/tools.h +++ b/flang/include/flang/Evaluate/tools.h @@ -1110,6 +1110,9 @@ bool IsArraySection(const Expr &expr); // Predicate: does an expression contain constant? bool HasConstant(const Expr &); +// Predicate: Does an expression contain a component +bool HasStructureComponent(const Expr &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 &); diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp index bd06acc21e47f..117b2249a9179 100644 --- a/flang/lib/Evaluate/tools.cpp +++ b/flang/lib/Evaluate/tools.cpp @@ -1210,6 +1210,20 @@ bool HasConstant(const Expr &expr) { return HasConstantHelper{}(expr); } +// HasStructureComponent() +struct HasStructureComponentHelper + : public AnyTraverse { + using Base = AnyTraverse; + HasStructureComponentHelper() : Base(*this) {} + using Base::operator(); + + bool operator()(const Component &) const { return true; } +}; + +bool HasStructureComponent(const Expr &expr) { + return HasStructureComponentHelper{}(expr); +} + parser::Message *AttachDeclaration( parser::Message &message, const Symbol &symbol) { const Symbol *unhosted{&symbol}; diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp index d7db15dd37949..2474264564642 100644 --- a/flang/lib/Semantics/check-omp-structure.cpp +++ b/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(&designator.u)}) { + if (const parser::DataRef *dataRef{ + std::get_if(&designator.u)}) { if (!IsDataRefTypeParamInquiry(dataRef)) { - if (auto *comp{parser::Unwrap(*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())); } diff --git a/flang/test/Semantics/OpenMP/in-reduction.f90 b/flang/test/Semantics/OpenMP/in-reduction.f90 index 1b82134b7104b..3f1e735214061 100644 --- a/flang/test/Semantics/OpenMP/in-reduction.f90 +++ b/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 diff --git a/flang/test/Semantics/OpenMP/reduction15.f90 b/flang/test/Semantics/OpenMP/reduction15.f90 index 1d4de6ff702bb..61fa417f1111c 100644 --- a/flang/test/Semantics/OpenMP/reduction15.f90 +++ b/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 diff --git a/flang/test/Semantics/OpenMP/reduction17.f90 b/flang/test/Semantics/OpenMP/reduction17.f90 new file mode 100644 index 0000000000000..5b6e8e977f46c --- /dev/null +++ b/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 diff --git a/flang/test/Semantics/OpenMP/task-reduction.f90 b/flang/test/Semantics/OpenMP/task-reduction.f90 index 5a18ee48e7728..f76b07ae568f4 100644 --- a/flang/test/Semantics/OpenMP/task-reduction.f90 +++ b/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