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 @@ -10,7 +10,6 @@ #include "flang/Parser/parse-tree.h" #include "flang/Semantics/tools.h" #include - namespace Fortran::semantics { // Use when clause falls under 'struct OmpClause' in 'parse-tree.h'. @@ -1024,9 +1023,32 @@ 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)}; + 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); + } } 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 @@ -7,7 +7,6 @@ //===----------------------------------------------------------------------===// #include "resolve-directives.h" - #include "check-acc-structure.h" #include "check-omp-structure.h" #include "resolve-names-utils.h" @@ -293,6 +292,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 +477,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 +1375,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 +1514,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,17 @@ +! RUN: %python %S/test_errors.py %s %flang -fopenmp + +! OpenMP Version 5.0 +! 2.17.1 critical construct +! Test case added to ensure proper semantic checks of CRITICAL names. See https://bugs.llvm.org/show_bug.cgi?id=48145 for details +integer function timer_tick_sec() + implicit none + integer t + + !$OMP CRITICAL (foo) + t = t + 1 + !$OMP END CRITICAL (foo) + + timer_tick_sec = t + return + +end function timer_tick_sec