diff --git a/flang/include/flang/Parser/parse-tree.h b/flang/include/flang/Parser/parse-tree.h --- a/flang/include/flang/Parser/parse-tree.h +++ b/flang/include/flang/Parser/parse-tree.h @@ -3594,7 +3594,7 @@ struct OmpCriticalDirective { TUPLE_CLASS_BOILERPLATE(OmpCriticalDirective); CharBlock source; - std::tuple, std::optional> t; + std::tuple, OmpClauseList> t; }; struct OmpEndCriticalDirective { TUPLE_CLASS_BOILERPLATE(OmpEndCriticalDirective); diff --git a/flang/lib/Parser/openmp-parsers.cpp b/flang/lib/Parser/openmp-parsers.cpp --- a/flang/lib/Parser/openmp-parsers.cpp +++ b/flang/lib/Parser/openmp-parsers.cpp @@ -469,7 +469,7 @@ verbatim("END CRITICAL"_tok), maybe(parenthesized(name)))) / endOmpLine) TYPE_PARSER(sourced(construct(verbatim("CRITICAL"_tok), - maybe(parenthesized(name)), maybe(Parser{}))) / + maybe(parenthesized(name)), Parser{})) / endOmpLine) TYPE_PARSER(construct( diff --git a/flang/lib/Parser/unparse.cpp b/flang/lib/Parser/unparse.cpp --- a/flang/lib/Parser/unparse.cpp +++ b/flang/lib/Parser/unparse.cpp @@ -2287,7 +2287,7 @@ BeginOpenMP(); Word("!$OMP CRITICAL"); Walk(" (", std::get>(x.t), ")"); - Walk(std::get>(x.t)); + Walk(std::get(x.t)); Put("\n"); EndOpenMP(); } 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 @@ -1024,9 +1024,38 @@ void OmpStructureChecker::Enter(const parser::OpenMPCriticalConstruct &x) { const auto &dir{std::get(x.t)}; + const auto &endDir{std::get(x.t)}; PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_critical); const auto &block{std::get(x.t)}; CheckNoBranching(block, llvm::omp::Directive::OMPD_critical, dir.source); + const auto &dirName{std::get>(dir.t)}; + const auto &endDirName{std::get>(endDir.t)}; + const auto &ompClause{std::get(dir.t)}; + if (dirName && endDirName && + dirName->ToString().compare(endDirName->ToString())) { + context_ + .Say(endDirName->source, + parser::MessageFormattedText{ + "CRITICAL directive names do not match"_err_en_US}) + .Attach(dirName->source, "should be "_en_US); + } else if (dirName && !endDirName) { + context_ + .Say(dirName->source, + parser::MessageFormattedText{ + "CRITICAL directive names do not match"_err_en_US}) + .Attach(dirName->source, "should be NULL"_en_US); + } else if (!dirName && endDirName) { + context_ + .Say(endDirName->source, + parser::MessageFormattedText{ + "CRITICAL directive names do not match"_err_en_US}) + .Attach(endDirName->source, "should be NULL"_en_US); + } + if (!dirName && !ompClause.source.empty()) { + context_.Say(dir.source, + parser::MessageFormattedText{ + "Hint clause cannot exist on an unnamed CRITICAL directive"_err_en_US}); + } } void OmpStructureChecker::Leave(const parser::OpenMPCriticalConstruct &) { diff --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp --- a/flang/lib/Semantics/resolve-directives.cpp +++ b/flang/lib/Semantics/resolve-directives.cpp @@ -293,6 +293,8 @@ bool Pre(const parser::OpenMPBlockConstruct &); void Post(const parser::OpenMPBlockConstruct &); + bool Pre(const parser::OmpCriticalDirective &x); + bool Pre(const parser::OmpEndCriticalDirective &x); void Post(const parser::OmpBeginBlockDirective &) { GetContext().withinConstruct = true; @@ -476,7 +478,7 @@ static constexpr Symbol::Flags ompFlagsRequireNewSymbol{ Symbol::Flag::OmpPrivate, Symbol::Flag::OmpLinear, Symbol::Flag::OmpFirstPrivate, Symbol::Flag::OmpLastPrivate, - Symbol::Flag::OmpReduction}; + Symbol::Flag::OmpReduction, Symbol::Flag::OmpCriticalLock}; static constexpr Symbol::Flags ompFlagsRequireMark{ Symbol::Flag::OmpThreadprivate}; @@ -1374,6 +1376,22 @@ return true; } +bool OmpAttributeVisitor::Pre(const parser::OmpCriticalDirective &x) { + const auto &name{std::get>(x.t)}; + if (name) { + ResolveOmpName(*name, Symbol::Flag::OmpCriticalLock); + } + return true; +} + +bool OmpAttributeVisitor::Pre(const parser::OmpEndCriticalDirective &x) { + const auto &name{std::get>(x.t)}; + if (name) { + ResolveOmpName(*name, Symbol::Flag::OmpCriticalLock); + } + return true; +} + bool OmpAttributeVisitor::Pre(const parser::OpenMPCriticalConstruct &x) { const auto &criticalDir{std::get(x.t)}; PushContext(criticalDir.source, llvm::omp::Directive::OMPD_critical); @@ -1497,6 +1515,13 @@ AddToContextObjectWithDSA(*resolvedSymbol, ompFlag); } } + } else if (ompFlagsRequireNewSymbol.test(ompFlag)) { + const auto pair{GetContext().scope.try_emplace( + name.source, Attrs{}, ObjectEntityDetails{})}; + CHECK(pair.second); + name.symbol = &pair.first->second.get(); + } else { + DIE("OpenMP Name resolution failed"); } } diff --git a/flang/test/Semantics/omp-sync-critical01.f90 b/flang/test/Semantics/omp-sync-critical01.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/omp-sync-critical01.f90 @@ -0,0 +1,41 @@ +! RUN: %python %S/test_errors.py %s %flang -fopenmp + +! OpenMP Version 5.0 +! 2.17.1 critical construct +! CRITICAL start and end CRITICAL directive names mismatch +integer function timer_tick_sec() + implicit none + integer t + + !$OMP CRITICAL + t = t + 1 + !$OMP END CRITICAL + + !$OMP CRITICAL (foo) + t = t + 1 + !$OMP END CRITICAL (foo) + + !$OMP CRITICAL (foo) + t = t + 1 + !ERROR: CRITICAL directive names do not match + !$OMP END CRITICAL (bar) + + !$OMP CRITICAL (bar) + t = t + 1 + !ERROR: CRITICAL directive names do not match + !$OMP END CRITICAL (foo) + + !ERROR: CRITICAL directive names do not match + !$OMP CRITICAL (bar) + t = t + 1 + !$OMP END CRITICAL + + !$OMP CRITICAL + t = t + 1 + !ERROR: CRITICAL directive names do not match + !$OMP END CRITICAL (foo) + + timer_tick_sec = t + return + +end function timer_tick_sec diff --git a/flang/test/Semantics/omp-sync-critical02.f90 b/flang/test/Semantics/omp-sync-critical02.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/omp-sync-critical02.f90 @@ -0,0 +1,54 @@ +! RUN: %python %S/test_errors.py %s %flang -fopenmp + +! OpenMP Version 5.0 +! 2.17.1 critical construct +! If the hint clause is specified, the critical construct must have a name. +program sample + use omp_lib + integer i, j + !ERROR: Hint clause cannot exist on an unnamed CRITICAL directive + !$omp critical hint(omp_lock_hint_speculative) + j = j + 1 + !$omp end critical + + !$omp critical (foo) hint(omp_lock_hint_speculative) + i = i - 1 + !$omp end critical (foo) + + !ERROR: Hint clause cannot exist on an unnamed CRITICAL directive + !$omp critical hint(omp_lock_hint_nonspeculative) + j = j + 1 + !$omp end critical + + !$omp critical (foo) hint(omp_lock_hint_nonspeculative) + i = i - 1 + !$omp end critical (foo) + + !ERROR: Hint clause cannot exist on an unnamed CRITICAL directive + !$omp critical hint(omp_lock_hint_contended) + j = j + 1 + !$omp end critical + + !$omp critical (foo) hint(omp_lock_hint_contended) + i = i - 1 + !$omp end critical (foo) + + !ERROR: Hint clause cannot exist on an unnamed CRITICAL directive + !$omp critical hint(omp_lock_hint_uncontended) + j = j + 1 + !$omp end critical + + !$omp critical (foo) hint(omp_lock_hint_uncontended) + i = i - 1 + !$omp end critical (foo) + + !ERROR: Hint clause cannot exist on an unnamed CRITICAL directive + !$omp critical hint(omp_sync_hint_none) + j = j + 1 + !$omp end critical + + !$omp critical (foo) hint(omp_sync_hint_none) + i = i - 1 + !$omp end critical (foo) + +end program sample