diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp index f09542e5b5df1..dd0da95d319bd 100644 --- a/flang/lib/Semantics/check-omp-structure.cpp +++ b/flang/lib/Semantics/check-omp-structure.cpp @@ -383,6 +383,19 @@ void OmpStructureChecker::CheckMultListItems() { CheckMultipleOccurrence( listVars, nontempNameList, clause->source, "NONTEMPORAL"); } + + // Linear clause + for (auto [_, clause] : FindClauses(llvm::omp::Clause::OMPC_linear)) { + const auto &linearClause{std::get(clause->u)}; + std::list nameList; + common::visit( + [&](const auto &u) { + std::copy( + u.names.begin(), u.names.end(), std::back_inserter(nameList)); + }, + linearClause.v.u); + CheckMultipleOccurrence(listVars, nameList, clause->source, "LINEAR"); + } } bool OmpStructureChecker::HasInvalidWorksharingNesting( @@ -2686,12 +2699,12 @@ void OmpStructureChecker::Leave(const parser::OmpClauseList &) { } } } - - // Sema checks related to presence of multiple list items within the same - // clause - CheckMultListItems(); } // SIMD + // Semantic checks related to presence of multiple list items within the same + // clause + CheckMultListItems(); + // 2.7.3 Single Construct Restriction if (GetContext().directive == llvm::omp::Directive::OMPD_end_single) { CheckNotAllowedIfClause( @@ -3542,16 +3555,95 @@ void OmpStructureChecker::Enter(const parser::OmpClause::If &x) { void OmpStructureChecker::Enter(const parser::OmpClause::Linear &x) { CheckAllowedClause(llvm::omp::Clause::OMPC_linear); + parser::CharBlock source{GetContext().clauseSource}; // 2.7 Loop Construct Restriction if ((llvm::omp::allDoSet | llvm::omp::allSimdSet) .test(GetContext().directive)) { if (std::holds_alternative(x.v.u)) { - context_.Say(GetContext().clauseSource, + context_.Say(source, "A modifier may not be specified in a LINEAR clause " "on the %s directive"_err_en_US, ContextDirectiveAsFortran()); + return; + } + } + + // OpenMP 5.2: Ordered clause restriction + if (const auto *clause{ + FindClause(GetContext(), llvm::omp::Clause::OMPC_ordered)}) { + const auto &orderedClause{std::get(clause->u)}; + if (orderedClause.v) { + return; } } + + auto checkForValidLinearClause_01 = [&](const parser::Name &name, + bool is_ref) { + std::string listItemName{name.ToString()}; + if (!is_ref && !name.symbol->GetType()->IsNumeric(TypeCategory::Integer)) { + context_.Say(source, + "The list item `%s` specified with other than linear-modifier `REF` must be of type INTEGER"_err_en_US, + listItemName); + } + if (GetContext().directive == llvm::omp::Directive::OMPD_declare_simd && + !IsDummy(*name.symbol)) { + context_.Say(source, + "The list item `%s` must be a dummy argument"_err_en_US, + listItemName); + } + if (IsPointer(*name.symbol) || + name.symbol->test(Symbol::Flag::CrayPointer)) { + context_.Say(source, + "The list item `%s` in a LINEAR clause must not be Cray Pointer or a variable with POINTER attribute"_err_en_US, + listItemName); + } + if (FindCommonBlockContaining(*name.symbol)) { + context_.Say(source, + "'%s' is a common block name and must not appear in an LINEAR clause"_err_en_US, + listItemName); + } + }; + + auto checkForValidLinearClause_02 = [&](const parser::Name &name, + const parser::OmpLinearModifier::Value + &modifierValue) { + std::string listItemName{name.ToString()}; + checkForValidLinearClause_01( + name, (modifierValue == parser::OmpLinearModifier::Value::Ref)); + if (modifierValue != parser::OmpLinearModifier::Value::Val && + IsDummy(*name.symbol) && IsValue(*name.symbol)) { + context_.Say(source, + "The list item `%s` specified with the linear-modifier `REF` or `UVAL` must be a dummy argument without `VALUE` attribute"_err_en_US, + listItemName); + } + if (modifierValue == parser::OmpLinearModifier::Value::Ref && + !(IsAllocatable(*name.symbol) || IsAssumedShape(*name.symbol) || + IsPolymorphic(*name.symbol))) { + context_.Say(source, + "The list item `%s` specified with the linear-modifier `REF` must be polymorphic variable, assumed-shape array, or a variable with the `ALLOCATABLE` attribute"_err_en_US, + listItemName); + } + }; + + // OpenMP 5.2: Linear clause Restrictions + common::visit( + common::visitors{ + [&](const parser::OmpLinearClause::WithoutModifier &withoutModifier) { + for (const auto &name : withoutModifier.names) { + if (name.symbol) { + checkForValidLinearClause_01(name, false); + } + } + }, + [&](const parser::OmpLinearClause::WithModifier &withModifier) { + for (const auto &name : withModifier.names) { + if (name.symbol) { + checkForValidLinearClause_02(name, withModifier.modifier.v); + } + } + }, + }, + x.v.u); } void OmpStructureChecker::CheckAllowedMapTypes( diff --git a/flang/test/Examples/omp-declarative-directive.f90 b/flang/test/Examples/omp-declarative-directive.f90 index 632ebcec17885..4a9ad9142bb18 100644 --- a/flang/test/Examples/omp-declarative-directive.f90 +++ b/flang/test/Examples/omp-declarative-directive.f90 @@ -7,7 +7,7 @@ ! 2.8.2 declare-simd subroutine declare_simd_1(a, b) - real(8), intent(inout) :: a, b + real(8), intent(inout), allocatable :: a, b !$omp declare simd(declare_simd_1) aligned(a) a = 3.14 + b end subroutine declare_simd_1 diff --git a/flang/test/Semantics/OpenMP/declarative-directive01.f90 b/flang/test/Semantics/OpenMP/declarative-directive01.f90 index 8d6762b87adb9..17dc50b70e542 100644 --- a/flang/test/Semantics/OpenMP/declarative-directive01.f90 +++ b/flang/test/Semantics/OpenMP/declarative-directive01.f90 @@ -23,6 +23,7 @@ end subroutine requires_2 subroutine declare_simd_1(a, b) real(8), intent(inout) :: a, b + !ERROR: 'a' in ALIGNED clause must be of type C_PTR, POINTER or ALLOCATABLE !$omp declare simd(declare_simd_1) aligned(a) a = 3.14 + b end subroutine declare_simd_1 diff --git a/flang/test/Semantics/OpenMP/linear-clause01.f90 b/flang/test/Semantics/OpenMP/linear-clause01.f90 new file mode 100644 index 0000000000000..654aa07f5bd40 --- /dev/null +++ b/flang/test/Semantics/OpenMP/linear-clause01.f90 @@ -0,0 +1,45 @@ +! REQUIRES: openmp_runtime +! RUN: %python %S/../test_errors.py %s %flang_fc1 %openmp_flags +! OpenMP Version 5.2 +! Various checks for the linear clause +! 5.4.6 `linear` Clause + +! Case 1 +subroutine linear_clause_01(arg) + integer, intent(in) :: arg(:) + !ERROR: A modifier may not be specified in a LINEAR clause on the DO directive + !$omp do linear(uval(arg)) + do i = 1, 5 + print *, arg(i) + end do +end subroutine linear_clause_01 + +! Case 2 +subroutine linear_clause_02(arg_01, arg_02) + !ERROR: The list item `arg_01` specified with other than linear-modifier `REF` must be of type INTEGER + !$omp declare simd linear(val(arg_01)) + real, intent(in) :: arg_01(:) + + !ERROR: The list item `arg_02` specified with the linear-modifier `REF` or `UVAL` must be a dummy argument without `VALUE` attribute + !$omp declare simd linear(uval(arg_02)) + integer, value, intent(in) :: arg_02 + + !ERROR: The list item `var` must be a dummy argument + !ERROR: The list item `var` in a LINEAR clause must not be Cray Pointer or a variable with POINTER attribute + !$omp declare simd linear(uval(var)) + integer, pointer :: var +end subroutine linear_clause_02 + +! Case 3 +subroutine linear_clause_03(arg) + integer, intent(in) :: arg + !ERROR: The list item `arg` specified with the linear-modifier `REF` must be polymorphic variable, assumed-shape array, or a variable with the `ALLOCATABLE` attribute + !ERROR: List item 'arg' present at multiple LINEAR clauses + !$omp declare simd linear(ref(arg)) linear(arg) + + integer :: i + common /cc/ i + !ERROR: The list item `i` must be a dummy argument + !ERROR: 'i' is a common block name and must not appear in an LINEAR clause + !$omp declare simd linear(i) +end subroutine linear_clause_03