diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp index db030bbe1f023..e224e069abcef 100644 --- a/flang/lib/Semantics/check-omp-structure.cpp +++ b/flang/lib/Semantics/check-omp-structure.cpp @@ -351,6 +351,17 @@ bool OmpStructureChecker::IsCloselyNestedRegion(const OmpDirectiveSet &set) { return false; } +bool OmpStructureChecker::IsNestedInDirective(llvm::omp::Directive directive) { + if (dirContext_.size() >= 1) { + for (size_t i = dirContext_.size() - 1; i > 0; --i) { + if (dirContext_[i - 1].directive == directive) { + return true; + } + } + } + return false; +} + void OmpStructureChecker::CheckVariableListItem( const SymbolSourceMap &symbols) { for (auto &[symbol, source] : symbols) { @@ -1880,12 +1891,89 @@ void OmpStructureChecker::Enter(const parser::OmpClause::At &x) { } } +// Goes through the names in an OmpObjectList and checks if each name appears +// in the given allocate statement +void OmpStructureChecker::CheckAllNamesInAllocateStmt( + const parser::CharBlock &source, const parser::OmpObjectList &ompObjectList, + const parser::AllocateStmt &allocate) { + for (const auto &obj : ompObjectList.v) { + if (const auto *d{std::get_if(&obj.u)}) { + if (const auto *ref{std::get_if(&d->u)}) { + if (const auto *n{std::get_if(&ref->u)}) { + CheckNameInAllocateStmt(source, *n, allocate); + } + } + } + } +} + +void OmpStructureChecker::CheckNameInAllocateStmt( + const parser::CharBlock &source, const parser::Name &name, + const parser::AllocateStmt &allocate) { + for (const auto &allocation : + std::get>(allocate.t)) { + const auto &allocObj = std::get(allocation.t); + if (const auto *n{std::get_if(&allocObj.u)}) { + if (n->source == name.source) { + return; + } + } + } + unsigned version{context_.langOptions().OpenMPVersion}; + context_.Say(source, + "Object '%s' in %s directive not " + "found in corresponding ALLOCATE statement"_err_en_US, + name.ToString(), + parser::ToUpperCaseLetters( + llvm::omp::getOpenMPDirectiveName(GetContext().directive, version) + .str())); +} + void OmpStructureChecker::Enter(const parser::OpenMPExecutableAllocate &x) { - isPredefinedAllocator = true; const auto &dir{std::get(x.t)}; - const auto &objectList{std::get>(x.t)}; PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_allocate); + + unsigned version{context_.langOptions().OpenMPVersion}; + if (version >= 52) { + context_.Warn(common::UsageWarning::OpenMPUsage, x.source, + "The executable form of the OpenMP ALLOCATE directive has been deprecated, please use ALLOCATORS instead"_warn_en_US); + } + + bool hasAllocator = false; + // TODO: Investigate whether searching the clause list can be done with + // parser::Unwrap instead of the following loop const auto &clauseList{std::get(x.t)}; + for (const auto &clause : clauseList.v) { + if (std::get_if(&clause.u)) { + hasAllocator = true; + } + } + + if (IsNestedInDirective(llvm::omp::Directive::OMPD_target) && !hasAllocator) { + // TODO: expand this check to exclude the case when a requires + // directive with the dynamic_allocators clause is present + // in the same compilation unit (OMP5.0 2.11.3). + context_.Say(x.source, + "ALLOCATE directives that appear in a TARGET region must specify an allocator clause"_err_en_US); + } + + const auto &allocateStmt = + std::get>(x.t).statement; + if (const auto &list{std::get>(x.t)}) { + CheckAllNamesInAllocateStmt( + std::get(x.t).source, *list, allocateStmt); + } + if (const auto &subDirs{ + std::get>>( + x.t)}) { + for (const auto &dalloc : *subDirs) { + CheckAllNamesInAllocateStmt(std::get(dalloc.t).source, + std::get(dalloc.t), allocateStmt); + } + } + + isPredefinedAllocator = true; + const auto &objectList{std::get>(x.t)}; for (const auto &clause : clauseList.v) { CheckAlignValue(clause); } @@ -1920,7 +2008,31 @@ void OmpStructureChecker::Enter(const parser::OpenMPAllocatorsConstruct &x) { const auto *allocate{ action ? parser::Unwrap(action.stmt) : nullptr}; - if (!allocate) { + if (allocate) { + for (const auto &clause : dirSpec.Clauses().v) { + if (auto *alloc{std::get_if(&clause.u)}) { + CheckAllNamesInAllocateStmt( + x.source, std::get(alloc->v.t), *allocate); + + using OmpAllocatorSimpleModifier = parser::OmpAllocatorSimpleModifier; + using OmpAllocatorComplexModifier = parser::OmpAllocatorComplexModifier; + + auto &modifiers{OmpGetModifiers(alloc->v)}; + bool hasAllocator{ + OmpGetUniqueModifier(modifiers) || + OmpGetUniqueModifier(modifiers)}; + + // TODO: As with allocate directive, exclude the case when a requires + // directive with the dynamic_allocators clause is present in + // the same compilation unit (OMP5.0 2.11.3). + if (IsNestedInDirective(llvm::omp::Directive::OMPD_target) && + !hasAllocator) { + context_.Say(x.source, + "ALLOCATORS directives that appear in a TARGET region must specify an allocator"_err_en_US); + } + } + } + } else { const parser::CharBlock &source = action ? action.source : x.source; context_.Say(source, "The body of the ALLOCATORS construct should be an ALLOCATE statement"_err_en_US); diff --git a/flang/lib/Semantics/check-omp-structure.h b/flang/lib/Semantics/check-omp-structure.h index 193784555a887..f507278fba5f2 100644 --- a/flang/lib/Semantics/check-omp-structure.h +++ b/flang/lib/Semantics/check-omp-structure.h @@ -177,6 +177,7 @@ class OmpStructureChecker bool HasInvalidWorksharingNesting( const parser::CharBlock &, const OmpDirectiveSet &); bool IsCloselyNestedRegion(const OmpDirectiveSet &set); + bool IsNestedInDirective(llvm::omp::Directive directive); void HasInvalidTeamsNesting( const llvm::omp::Directive &dir, const parser::CharBlock &source); void HasInvalidDistributeNesting(const parser::OpenMPLoopConstruct &x); @@ -309,6 +310,11 @@ class OmpStructureChecker const std::optional &maybeClauses); void CheckCancellationNest( const parser::CharBlock &source, llvm::omp::Directive type); + void CheckAllNamesInAllocateStmt(const parser::CharBlock &source, + const parser::OmpObjectList &ompObjectList, + const parser::AllocateStmt &allocate); + void CheckNameInAllocateStmt(const parser::CharBlock &source, + const parser::Name &ompObject, const parser::AllocateStmt &allocate); std::int64_t GetOrdCollapseLevel(const parser::OpenMPLoopConstruct &x); void CheckReductionObjects( const parser::OmpObjectList &objects, llvm::omp::Clause clauseId); diff --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp index 270642acb3e9b..e4b7e83d0587b 100644 --- a/flang/lib/Semantics/resolve-directives.cpp +++ b/flang/lib/Semantics/resolve-directives.cpp @@ -987,11 +987,6 @@ class OmpAttributeVisitor : DirectiveAttributeVisitor { sourceLabels_.clear(); targetLabels_.clear(); }; - void CheckAllNamesInAllocateStmt(const parser::CharBlock &source, - const parser::OmpObjectList &ompObjectList, - const parser::AllocateStmt &allocate); - void CheckNameInAllocateStmt(const parser::CharBlock &source, - const parser::Name &ompObject, const parser::AllocateStmt &allocate); std::int64_t ordCollapseLevel{0}; @@ -2405,8 +2400,6 @@ bool OmpAttributeVisitor::Pre(const parser::OpenMPDispatchConstruct &x) { } bool OmpAttributeVisitor::Pre(const parser::OpenMPExecutableAllocate &x) { - IssueNonConformanceWarning(llvm::omp::Directive::OMPD_allocate, x.source, 52); - PushContext(x.source, llvm::omp::Directive::OMPD_allocate); const auto &list{std::get>(x.t)}; if (list) { @@ -2487,83 +2480,10 @@ bool OmpAttributeVisitor::IsNestedInDirective(llvm::omp::Directive directive) { } void OmpAttributeVisitor::Post(const parser::OpenMPExecutableAllocate &x) { - bool hasAllocator = false; - // TODO: Investigate whether searching the clause list can be done with - // parser::Unwrap instead of the following loop - const auto &clauseList{std::get(x.t)}; - for (const auto &clause : clauseList.v) { - if (std::get_if(&clause.u)) { - hasAllocator = true; - } - } - - if (IsNestedInDirective(llvm::omp::Directive::OMPD_target) && !hasAllocator) { - // TODO: expand this check to exclude the case when a requires - // directive with the dynamic_allocators clause is present - // in the same compilation unit (OMP5.0 2.11.3). - context_.Say(x.source, - "ALLOCATE directives that appear in a TARGET region " - "must specify an allocator clause"_err_en_US); - } - - const auto &allocateStmt = - std::get>(x.t).statement; - if (const auto &list{std::get>(x.t)}) { - CheckAllNamesInAllocateStmt( - std::get(x.t).source, *list, allocateStmt); - } - if (const auto &subDirs{ - std::get>>( - x.t)}) { - for (const auto &dalloc : *subDirs) { - CheckAllNamesInAllocateStmt(std::get(dalloc.t).source, - std::get(dalloc.t), allocateStmt); - } - } PopContext(); } void OmpAttributeVisitor::Post(const parser::OpenMPAllocatorsConstruct &x) { - const parser::OmpDirectiveSpecification &dirSpec{x.BeginDir()}; - auto &block{std::get(x.t)}; - - omp::SourcedActionStmt action{omp::GetActionStmt(block)}; - const parser::AllocateStmt *allocate{[&]() { - if (action) { - if (auto *alloc{std::get_if>( - &action.stmt->u)}) { - return &alloc->value(); - } - } - return static_cast(nullptr); - }()}; - - if (allocate) { - for (const auto &clause : dirSpec.Clauses().v) { - if (auto *alloc{std::get_if(&clause.u)}) { - CheckAllNamesInAllocateStmt( - x.source, std::get(alloc->v.t), *allocate); - - using OmpAllocatorSimpleModifier = parser::OmpAllocatorSimpleModifier; - using OmpAllocatorComplexModifier = parser::OmpAllocatorComplexModifier; - - auto &modifiers{OmpGetModifiers(alloc->v)}; - bool hasAllocator{ - OmpGetUniqueModifier(modifiers) || - OmpGetUniqueModifier(modifiers)}; - - // TODO: As with allocate directive, exclude the case when a requires - // directive with the dynamic_allocators clause is present in - // the same compilation unit (OMP5.0 2.11.3). - if (IsNestedInDirective(llvm::omp::Directive::OMPD_target) && - !hasAllocator) { - context_.Say(x.source, - "ALLOCATORS directives that appear in a TARGET region " - "must specify an allocator"_err_en_US); - } - } - } - } PopContext(); } @@ -3483,44 +3403,6 @@ void OmpAttributeVisitor::CheckLabelContext(const parser::CharBlock source, } } -// Goes through the names in an OmpObjectList and checks if each name appears -// in the given allocate statement -void OmpAttributeVisitor::CheckAllNamesInAllocateStmt( - const parser::CharBlock &source, const parser::OmpObjectList &ompObjectList, - const parser::AllocateStmt &allocate) { - for (const auto &obj : ompObjectList.v) { - if (const auto *d{std::get_if(&obj.u)}) { - if (const auto *ref{std::get_if(&d->u)}) { - if (const auto *n{std::get_if(&ref->u)}) { - CheckNameInAllocateStmt(source, *n, allocate); - } - } - } - } -} - -void OmpAttributeVisitor::CheckNameInAllocateStmt( - const parser::CharBlock &source, const parser::Name &name, - const parser::AllocateStmt &allocate) { - for (const auto &allocation : - std::get>(allocate.t)) { - const auto &allocObj = std::get(allocation.t); - if (const auto *n{std::get_if(&allocObj.u)}) { - if (n->source == name.source) { - return; - } - } - } - unsigned version{context_.langOptions().OpenMPVersion}; - context_.Say(source, - "Object '%s' in %s directive not " - "found in corresponding ALLOCATE statement"_err_en_US, - name.ToString(), - parser::ToUpperCaseLetters( - llvm::omp::getOpenMPDirectiveName(GetContext().directive, version) - .str())); -} - void OmpAttributeVisitor::AddOmpRequiresToScope(Scope &scope, WithOmpDeclarative::RequiresFlags flags, std::optional memOrder) { diff --git a/flang/test/Semantics/OpenMP/allocate-align01.f90 b/flang/test/Semantics/OpenMP/allocate-align01.f90 index 508efa82f12a0..4967330e37b48 100644 --- a/flang/test/Semantics/OpenMP/allocate-align01.f90 +++ b/flang/test/Semantics/OpenMP/allocate-align01.f90 @@ -13,7 +13,7 @@ program allocate_align_tree z = 3 !ERROR: The alignment value should be a constant positive integer !$omp allocate(j) align(xx) - !WARNING: OpenMP directive ALLOCATE has been deprecated, please use ALLOCATORS instead. [-Wopen-mp-usage] + !WARNING: The executable form of the OpenMP ALLOCATE directive has been deprecated, please use ALLOCATORS instead [-Wopen-mp-usage] !ERROR: The alignment value should be a constant positive integer !$omp allocate(xarray) align(-32) allocator(omp_large_cap_mem_alloc) allocate(j(z), xarray(t)) diff --git a/flang/test/Semantics/OpenMP/allocate01.f90 b/flang/test/Semantics/OpenMP/allocate01.f90 index 5280d1b68a731..1d99811156438 100644 --- a/flang/test/Semantics/OpenMP/allocate01.f90 +++ b/flang/test/Semantics/OpenMP/allocate01.f90 @@ -19,7 +19,7 @@ subroutine sema() !$omp allocate(y) print *, a - !WARNING: OpenMP directive ALLOCATE has been deprecated, please use ALLOCATORS instead. [-Wopen-mp-usage] + !WARNING: The executable form of the OpenMP ALLOCATE directive has been deprecated, please use ALLOCATORS instead [-Wopen-mp-usage] !$omp allocate(x) allocator(omp_default_mem_alloc) allocate ( x(a), darray(a, b) ) end subroutine sema