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 @@ -3599,17 +3599,21 @@ u; }; -// 2.13.2 CRITICAL [Name] END CRITICAL [Name] struct OmpCriticalDirective { TUPLE_CLASS_BOILERPLATE(OmpCriticalDirective); CharBlock source; - std::tuple, std::optional> t; + std::tuple, OmpClauseList> t; }; + struct OmpEndCriticalDirective { TUPLE_CLASS_BOILERPLATE(OmpEndCriticalDirective); CharBlock source; std::tuple> t; }; + +// [OMP-5.0] 2.17.1 CRITICAL [(Name) [[,] hint(hint-expression)]] +// +// END CRITICAL [Name] struct OpenMPCriticalConstruct { TUPLE_CLASS_BOILERPLATE(OpenMPCriticalConstruct); std::tuple t; 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 @@ -450,7 +450,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 @@ -2310,7 +2310,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-directive-structure.h b/flang/lib/Semantics/check-directive-structure.h --- a/flang/lib/Semantics/check-directive-structure.h +++ b/flang/lib/Semantics/check-directive-structure.h @@ -15,7 +15,6 @@ #include "flang/Common/enum-set.h" #include "flang/Semantics/semantics.h" #include "flang/Semantics/tools.h" - #include namespace Fortran::semantics { @@ -226,6 +225,12 @@ SayNotMatching(beginDir.source, endDir.source); } } + + // Checks for missing or mismatching names on OpenMP/OpenACC directives + // of two different types. + template + void CheckNameMatching(const T1 &, const T2 &); + void CheckNoBranching(const parser::Block &block, D directive, const parser::CharBlock &directiveSource); @@ -266,6 +271,44 @@ std::string ClauseSetToString(const common::EnumSet set); }; +template +template +void DirectiveStructureChecker::CheckNameMatching( + const T1 &beginDir, const T2 &endDir) { + const auto &directiveName{std::get(beginDir.t)}; + const auto &upperCaseDirName{ + parser::ToUpperCaseLetters(directiveName.source.ToString())}; + const auto &beginDirName{std::get>(beginDir.t)}; + const auto &endDirName{std::get>(endDir.t)}; + + if (beginDirName) { + if (endDirName) { + // Start and end directive names mismatch. + if (beginDirName->source != endDirName->source) { + context_ + .Say(endDirName->source, + parser::MessageFormattedText{ + "%s directive name mismatch"_err_en_US, upperCaseDirName}) + .Attach(beginDirName->source, "should be"_en_US); + } + } else { // Missing end directive name + context_ + .Say(endDir.source, + parser::MessageFormattedText{ + "%s directive name required but missing"_err_en_US, + upperCaseDirName}) + .Attach(beginDirName->source, "should be"_en_US); + } + } else if (endDirName) { // Missing start directive name + context_ + .Say(endDirName->source, + parser::MessageFormattedText{ + "%s directive name unexpected"_err_en_US, upperCaseDirName}) + .Attach( + beginDir.source, "unnamed %s directive"_en_US, upperCaseDirName); + } +} + template void DirectiveStructureChecker::CheckNoBranching( const parser::Block &block, D directive, 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 @@ -161,6 +161,7 @@ void Enter(const parser::OmpClause::Release &); void Enter(const parser::OmpClause::Acquire &); void Enter(const parser::OmpClause::Relaxed &); + void Enter(const parser::OmpClause::Hint &); void Enter(const parser::OmpAlignedClause &); void Enter(const parser::OmpAllocateClause &); 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 @@ -239,12 +239,41 @@ dirContext_.pop_back(); } -void OmpStructureChecker::Enter(const parser::OpenMPCriticalConstruct &x) { - const auto &dir{std::get(x.t)}; - PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_critical); +// TODO: Change it to a more better version without raw string comparision +// once the module files are present. +static bool IsHintExprAs( + const parser::Expr &expr, const std::string &expectedString) { + return (expr.source.ToString() != expectedString) ? false : true; } -void OmpStructureChecker::Leave(const parser::OpenMPCriticalConstruct &) { +void OmpStructureChecker::Enter(const parser::OpenMPCriticalConstruct &x) { + const auto &beginCriticalDir{std::get(x.t)}; + PushContextAndClauseSets( + beginCriticalDir.source, llvm::omp::Directive::OMPD_critical); + const auto &endCriticalDir{std::get(x.t)}; + PushContextAndClauseSets( + endCriticalDir.source, llvm::omp::Directive::OMPD_critical); + CheckNameMatching(beginCriticalDir, endCriticalDir); +} + +void OmpStructureChecker::Leave(const parser::OpenMPCriticalConstruct &x) { + // [OMP-5.0][2.17.1] Unless the effect is as if hint(omp_sync_hint_none) + // was specified, the critical construct must specify a name + if (auto *clause{FindClause(llvm::omp::Clause::OMPC_hint)}) { + const auto &hintClause{std::get(clause->u)}; + const parser::Expr &expr{hintClause.v.thing.value()}; + if (!IsHintExprAs(expr, "omp_sync_hint_none")) { + const auto &beginCriticalDir{std::get(x.t)}; + const auto &criticalName{ + std::get>(beginCriticalDir.t)}; + if (!criticalName) { + context_.Say(beginCriticalDir.source, + "CRITICAL construct must specify a name expect unless the effect" + " is equivalent to specifying a HINT(omp_sync_hint_none)"_err_en_US); + } + } + } dirContext_.pop_back(); } @@ -399,6 +428,7 @@ CHECK_SIMPLE_CLAUSE(SeqCst, OMPC_seq_cst) CHECK_SIMPLE_CLAUSE(Release, OMPC_release) CHECK_SIMPLE_CLAUSE(Relaxed, OMPC_relaxed) +CHECK_SIMPLE_CLAUSE(Hint, OMPC_hint) CHECK_REQ_SCALAR_INT_CLAUSE(Allocator, OMPC_allocator) CHECK_REQ_SCALAR_INT_CLAUSE(Grainsize, OMPC_grainsize) 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" @@ -256,6 +255,8 @@ return true; } void Post(const parser::OpenMPDeclareSimdConstruct &) { PopContext(); } + bool Pre(const parser::OpenMPCriticalConstruct &x); + void Post(const parser::OpenMPCriticalConstruct &) { PopContext(); } bool Pre(const parser::OpenMPThreadprivate &); void Post(const parser::OpenMPThreadprivate &) { PopContext(); } @@ -330,7 +331,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}; @@ -365,7 +366,6 @@ Symbol *ResolveOmpCommonBlockName(const parser::Name *); void ResolveOmpNameList(const std::list &, Symbol::Flag); void ResolveOmpName(const parser::Name &, Symbol::Flag); - Symbol *ResolveName(const parser::Name *); Symbol *DeclareOrMarkOtherAccessEntity(const parser::Name &, Symbol::Flag); Symbol *DeclareOrMarkOtherAccessEntity(Symbol &, Symbol::Flag); void CheckMultipleAppearances( @@ -993,6 +993,22 @@ return true; } +bool OmpAttributeVisitor::Pre(const parser::OpenMPCriticalConstruct &x) { + const auto &beginCriticalDir{std::get(x.t)}; + const auto &endCriticalDir{std::get(x.t)}; + PushContext(beginCriticalDir.source, llvm::omp::Directive::OMPD_critical); + PushContext(endCriticalDir.source, llvm::omp::Directive::OMPD_critical); + if (const auto &criticalName{ + std::get>(beginCriticalDir.t)}) { + ResolveOmpName(*criticalName, Symbol::Flag::OmpCriticalLock); + } + if (const auto &endCriticalName{ + std::get>(endCriticalDir.t)}) { + ResolveOmpName(*endCriticalName, Symbol::Flag::OmpCriticalLock); + } + return true; +} + bool OmpAttributeVisitor::Pre(const parser::OpenMPThreadprivate &x) { PushContext(x.source, llvm::omp::Directive::OMPD_threadprivate); const auto &list{std::get(x.t)}; @@ -1043,23 +1059,25 @@ } // within OpenMP construct } -Symbol *OmpAttributeVisitor::ResolveName(const parser::Name *name) { - if (auto *resolvedSymbol{ - name ? GetContext().scope.FindSymbol(name->source) : nullptr}) { - name->symbol = resolvedSymbol; - return resolvedSymbol; - } else { - return nullptr; - } -} - void OmpAttributeVisitor::ResolveOmpName( const parser::Name &name, Symbol::Flag ompFlag) { - if (ResolveName(&name)) { - if (auto *resolvedSymbol{ResolveOmp(name, ompFlag, currScope())}) { - if (dataSharingAttributeFlags.test(ompFlag)) { - AddToContextObjectWithDSA(*resolvedSymbol, ompFlag); - } + if (&name) { + if (auto *resolvedSymbol{GetContext().scope.FindSymbol(name.source)}) { + Resolve(name, resolvedSymbol); + } else if (ompFlagsRequireNewSymbol.test(ompFlag)) { + // Create a new symbol. + 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"); + } + } + + if (auto *resolvedSymbol{ResolveOmp(name, ompFlag, currScope())}) { + if (dataSharingAttributeFlags.test(ompFlag)) { + AddToContextObjectWithDSA(*resolvedSymbol, ompFlag); } } } diff --git a/flang/test/Semantics/omp-clause-validity01.f90 b/flang/test/Semantics/omp-clause-validity01.f90 --- a/flang/test/Semantics/omp-clause-validity01.f90 +++ b/flang/test/Semantics/omp-clause-validity01.f90 @@ -498,10 +498,8 @@ ! 2.13.2 critical Construct - !ERROR: Internal: no symbol found for 'first' !$omp critical (first) a = 3.14 - !ERROR: Internal: no symbol found for 'first' !$omp end critical (first) ! 2.9.1 task-clause -> if-clause | 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,87 @@ +! RUN: %S/test_errors.sh %s %t %f18 -fopenmp +use omp_lib + implicit none + integer :: maxival = -100, i, j + integer :: sharedarray(10000) = (/ (j, j=1, 10000) /) + !$omp parallel do num_threads(4) + do i=1, size(sharedarray), 1 + !$omp critical + ! Performance loss + if (sharedarray(i) .gt. maxival) then + maxival = sharedarray(i) + end if + !$omp end critical + end do + !$omp end parallel do + print *, "Max val in array is = ", maxival + + !$omp parallel do num_threads(4) + do i=1, size(sharedarray), 2 + !$omp critical (somename) + if (sharedarray(i) .gt. maxival) then + maxival = sharedarray(i) + end if + !ERROR: CRITICAL directive name required but missing + !$omp end critical + end do + !$omp end parallel do + print *, "Max val in array is = ", maxival + + !$omp parallel do num_threads(4) + do i=1, size(sharedarray), 3 + !$omp critical + if (sharedarray(i) .gt. maxival) then + maxival = sharedarray(i) + end if + !ERROR: CRITICAL directive name unexpected + !$omp end critical (somename) + end do + !$omp end parallel do + print *, "Max val in array is = ", maxival + + !$omp parallel do num_threads(4) + do i=1, size(sharedarray), 4 + !$omp critical(somename) + if (sharedarray(i) .gt. maxival) then + maxival = sharedarray(i) + end if + !$omp end critical(somename) + end do + !$omp end parallel do + print *, "Max val in array is = ", maxival + + !$omp parallel do num_threads(4) + do i=1, size(sharedarray), 5 + !$omp critical(somename) + if (sharedarray(i) .gt. maxival) then + maxival = sharedarray(i) + end if + !ERROR: CRITICAL directive name mismatch + !$omp end critical(othername) + end do + !$omp end parallel do + print *, "Max val in array is = ", maxival + + !Unless the effect is as if hint(omp_sync_hint_none) was specified, the + !critical construct must specify a name. + !$omp critical(foo) hint(omp_sync_hint_none) + !$omp end critical(foo) + + !ERROR: CRITICAL construct must specify a name expect unless the effect is equivalent to specifying a HINT(omp_sync_hint_none) + !$omp critical hint(omp_sync_hint_uncontended) + !$omp end critical + + !$omp critical(foo) hint(omp_sync_hint_uncontended) + !$omp end critical(foo) + + !$omp critical(foo) + !$omp end critical(foo) + + !$omp critical(foo) hint(omp_sync_hint_none) hint(omp_sync_hint_none) + !$omp end critical(foo) + + !ERROR: PRIVATE clause is not allowed on the END CRITICAL(FOO) directive + !$omp critical(foo) hint(omp_sync_hint_none) private(i) + !$omp end critical(foo) + +end program 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,15 @@ +! RUN: %S/test_errors.sh %s %t %f18 -fopenmp +! see https://bugs.llvm.org/show_bug.cgi?id=48145 + +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