diff --git a/flang/lib/Semantics/check-omp-structure.h b/flang/lib/Semantics/check-omp-structure.h --- a/flang/lib/Semantics/check-omp-structure.h +++ b/flang/lib/Semantics/check-omp-structure.h @@ -268,6 +268,7 @@ void EnterDirectiveNest(const int index) { directiveNest_[index]++; } void ExitDirectiveNest(const int index) { directiveNest_[index]--; } int GetDirectiveNest(const int index) { return directiveNest_[index]; } + template void CheckHintClause(D *, D *); enum directiveNestType { SIMDNest, @@ -275,6 +276,20 @@ TargetNest, LastType }; + + enum HintValues { + hint_none = 0x0, + hint_uncontended = 0x1, + hint_contended = 0x2, + hint_nonspeculative = 0x4, + hint_speculative = 0x8 + }; + + std::list AllowedHintValues = {hint_none, hint_uncontended, + hint_contended, hint_nonspeculative, hint_speculative, + hint_uncontended + hint_nonspeculative, + hint_uncontended + hint_speculative, hint_contended + hint_nonspeculative, + hint_contended + hint_speculative}; int directiveNest_[LastType + 1] = {0}; }; } // namespace Fortran::semantics diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp --- a/flang/lib/Semantics/check-omp-structure.cpp +++ b/flang/lib/Semantics/check-omp-structure.cpp @@ -316,6 +316,48 @@ } } +template +void OmpStructureChecker::CheckHintClause( + D *leftOmpClauseList, D *rightOmpClauseList) { + auto checkForValidHintClause = [&](const D *clauseList) { + for (const auto &clause : clauseList->v) { + const Fortran::parser::OmpClause *ompClause = nullptr; + if constexpr (std::is_same_v) { + ompClause = std::get_if(&clause.u); + } else if constexpr (std::is_same_v) { + ompClause = &clause; + } + const Fortran::parser::OmpClause::Hint *hintClause = ompClause + ? std::get_if(&ompClause->u) + : nullptr; + std::optional evaluatedValue = + hintClause ? GetIntValue(hintClause->v) : std::nullopt; + if (evaluatedValue) { + int hintValue = evaluatedValue.value(); + if (auto it{std::find( + AllowedHintValues.begin(), AllowedHintValues.end(), hintValue)}; + it == AllowedHintValues.end()) + context_.Say(clause.source, + "Hint clause value " + "is not a valid OpenMP synchronization value"_err_en_US); + } else if (hintClause) { + context_.Say(clause.source, + "Hint clause must have non-negative constant " + "integer expression"_err_en_US); + } + } + }; + + if (leftOmpClauseList) { + checkForValidHintClause(leftOmpClauseList); + } + if (rightOmpClauseList) { + checkForValidHintClause(rightOmpClauseList); + } +} + void OmpStructureChecker::Enter(const parser::OpenMPConstruct &x) { // Simd Construct with Ordered Construct Nesting check // We cannot use CurrentDirectiveIsNested() here because @@ -1279,6 +1321,7 @@ parser::MessageFormattedText{ "Hint clause other than omp_sync_hint_none cannot be specified for an unnamed CRITICAL directive"_err_en_US}); } + CheckHintClause(&ompClause, nullptr); } void OmpStructureChecker::Leave(const parser::OpenMPCriticalConstruct &) { @@ -1582,6 +1625,9 @@ CheckAtomicMemoryOrderClause( &std::get(atomicConstruct.t), nullptr); + CheckHintClause( + &std::get(atomicConstruct.t), + nullptr); }, [&](const parser::OmpAtomicUpdate &atomicUpdate) { const auto &dir{std::get(atomicUpdate.t)}; @@ -1593,6 +1639,8 @@ .statement); CheckAtomicMemoryOrderClause( &std::get<0>(atomicUpdate.t), &std::get<2>(atomicUpdate.t)); + CheckHintClause( + &std::get<0>(atomicUpdate.t), &std::get<2>(atomicUpdate.t)); }, [&](const auto &atomicConstruct) { const auto &dir{std::get(atomicConstruct.t)}; @@ -1600,6 +1648,9 @@ dir.source, llvm::omp::Directive::OMPD_atomic); CheckAtomicMemoryOrderClause(&std::get<0>(atomicConstruct.t), &std::get<2>(atomicConstruct.t)); + CheckHintClause( + &std::get<0>(atomicConstruct.t), + &std::get<2>(atomicConstruct.t)); }, }, x.u); diff --git a/flang/test/Semantics/OpenMP/omp-atomic-hint-clause.f90 b/flang/test/Semantics/OpenMP/omp-atomic-hint-clause.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/OpenMP/omp-atomic-hint-clause.f90 @@ -0,0 +1,95 @@ +! RUN: %python %S/../test_errors.py %s %flang_fc1 -fopenmp +! Semantic checks on hint clauses, as they appear on atomic constructs + +program sample + use omp_lib + integer :: x, y + logical :: z + real :: k + integer :: p(1) + !$omp atomic hint(1) write + y = 2 + + !$omp atomic read hint(2) + y = x + + !ERROR: Hint clause value is not a valid OpenMP synchronization value + !$omp atomic hint(3) + y = y + 10 + + !$omp atomic update hint(5) + y = x + + !ERROR: Hint clause value is not a valid OpenMP synchronization value + !$omp atomic hint(7) capture + y = x + x = y + !$omp end atomic + + !ERROR: Hint clause must have non-negative constant integer expression + !ERROR: Must be a constant value + !$omp atomic update hint(x) + y = y * 1 + + !$omp atomic read hint(4) + y = x + + !$omp atomic hint(8) + x = x * y + + !$omp atomic write hint(omp_sync_hint_uncontended) + x = 10 * y + + !$omp atomic hint(omp_lock_hint_speculative) + x = y + x + + !ERROR: Hint clause must have non-negative constant integer expression + !ERROR: Must be a constant value + !$omp atomic hint(omp_sync_hint_uncontended + omp_sync_hint) read + y = x + + !$omp atomic hint(omp_sync_hint_nonspeculative) + y = y * 9 + + !$omp atomic hint(omp_sync_hint_none) read + y = x + + !$omp atomic read hint(omp_sync_hint_uncontended + omp_lock_hint_speculative) + y = x + + !$omp atomic hint(omp_lock_hint_nonspeculative + omp_lock_hint_uncontended) + x = x * y + + !$omp atomic write hint(omp_lock_hint_contended + omp_sync_hint_speculative) + x = 10 * y + + !$omp atomic hint(omp_lock_hint_contended + omp_sync_hint_nonspeculative) + x = y + x + + !ERROR: Hint clause value is not a valid OpenMP synchronization value + !$omp atomic hint(omp_sync_hint_uncontended + omp_sync_hint_contended) read + y = x + + !ERROR: Hint clause value is not a valid OpenMP synchronization value + !$omp atomic hint(omp_sync_hint_nonspeculative + omp_lock_hint_speculative) + y = y * 9 + + !ERROR: Hint clause must have non-negative constant integer expression + !$omp atomic hint(1.0) read + y = x + + !ERROR: Hint clause must have non-negative constant integer expression + !ERROR: Operands of + must be numeric; have LOGICAL(4) and INTEGER(4) + !$omp atomic hint(z + omp_sync_hint_nonspeculative) read + y = x + + !ERROR: Hint clause must have non-negative constant integer expression + !ERROR: Must be a constant value + !$omp atomic hint(k + omp_sync_hint_speculative) read + y = x + + !ERROR: Hint clause must have non-negative constant integer expression + !ERROR: Must be a constant value + !$omp atomic hint(p(1) + omp_sync_hint_uncontended) write + x = 10 * y +end program diff --git a/flang/test/Semantics/OpenMP/omp-critical-hint-clause.f90 b/flang/test/Semantics/OpenMP/omp-critical-hint-clause.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/OpenMP/omp-critical-hint-clause.f90 @@ -0,0 +1,118 @@ +! RUN: %python %S/../test_errors.py %s %flang_fc1 -fopenmp +! Semantic checks on hint clauses, as they appear on critical construct + +program sample + use omp_lib + integer :: y + logical :: z + real :: k + integer :: p(1) + + !$omp critical (name) hint(1) + y = 2 + !$omp end critical (name) + + !$omp critical (name) hint(2) + y = 2 + !$omp end critical (name) + + !ERROR: Hint clause value is not a valid OpenMP synchronization value + !$omp critical (name) hint(3) + y = 2 + !$omp end critical (name) + + !$omp critical (name) hint(5) + y = 2 + !$omp end critical (name) + + !ERROR: Hint clause value is not a valid OpenMP synchronization value + !$omp critical (name) hint(7) + y = 2 + !$omp end critical (name) + + !ERROR: Hint clause must have non-negative constant integer expression + !ERROR: Must be a constant value + !$omp critical (name) hint(x) + y = 2 + !$omp end critical (name) + + !$omp critical (name) hint(4) + y = 2 + !$omp end critical (name) + + !$omp critical (name) hint(8) + y = 2 + !$omp end critical (name) + + !$omp critical (name) hint(omp_sync_hint_uncontended) + y = 2 + !$omp end critical (name) + + !$omp critical (name) hint(omp_lock_hint_speculative) + y = 2 + !$omp end critical (name) + + !ERROR: Hint clause must have non-negative constant integer expression + !ERROR: Must be a constant value + !$omp critical (name) hint(omp_sync_hint_uncontended + omp_sync_hint) + y = 2 + !$omp end critical (name) + + !$omp critical (name) hint(omp_sync_hint_nonspeculative) + y = 2 + !$omp end critical (name) + + !$omp critical (name) hint(omp_sync_hint_none) + y = 2 + !$omp end critical (name) + + !$omp critical (name) hint(omp_sync_hint_uncontended + omp_lock_hint_speculative) + y = 2 + !$omp end critical (name) + + !$omp critical (name) hint(omp_lock_hint_nonspeculative + omp_lock_hint_uncontended) + y = 2 + !$omp end critical (name) + + !$omp critical (name) hint(omp_lock_hint_contended + omp_sync_hint_speculative) + y = 2 + !$omp end critical (name) + + !$omp critical (name) hint(omp_lock_hint_contended + omp_sync_hint_nonspeculative) + y = 2 + !$omp end critical (name) + + !ERROR: Hint clause value is not a valid OpenMP synchronization value + !$omp critical (name) hint(omp_sync_hint_uncontended + omp_sync_hint_contended) + y = 2 + !$omp end critical (name) + + !ERROR: Hint clause value is not a valid OpenMP synchronization value + !$omp critical (name) hint(omp_sync_hint_nonspeculative + omp_lock_hint_speculative) + y = 2 + !$omp end critical (name) + + !ERROR: Hint clause must have non-negative constant integer expression + !$omp critical (name) hint(1.0) + y = 2 + !$omp end critical (name) + + !ERROR: Hint clause must have non-negative constant integer expression + !ERROR: Operands of + must be numeric; have LOGICAL(4) and INTEGER(4) + !$omp critical (name) hint(z + omp_sync_hint_nonspeculative) + y = 2 + !$omp end critical (name) + + !ERROR: Hint clause must have non-negative constant integer expression + !ERROR: Must be a constant value + !$omp critical (name) hint(k + omp_sync_hint_speculative) + y = 2 + !$omp end critical (name) + + !ERROR: Hint clause must have non-negative constant integer expression + !ERROR: Must be a constant value + !$omp critical (name) hint(p(1) + omp_sync_hint_uncontended) + y = 2 + !$omp end critical (name) +end program +