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 @@ -266,6 +266,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, @@ -273,6 +274,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,42 @@ } } +template +void OmpStructureChecker::CheckHintClause( + D *leftOmpClauseList, D *rightOmpClauseList) { + + auto checkForValidHintClause = [&](const D *clauseList) { + for (const auto &clause : clauseList->v) { + if (const auto ompClause = + std::get_if(&clause.u)) { + if (auto hintClause = + std::get_if(&ompClause->u)) { + if (auto evaluatedValue{GetIntValue(hintClause->v)}) { + 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 { + 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 @@ -1582,6 +1618,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 +1632,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 +1641,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