From 6acfa6d01979ba07e3e4e109142549830c020692 Mon Sep 17 00:00:00 2001 From: Krzysztof Parzyszek Date: Sat, 11 Oct 2025 13:47:36 -0500 Subject: [PATCH 1/3] [flang][OpenMP] Keep track of scoping units in OmpStructureChecker Introduce a stack of scopes to OmpStructureChecker for scoping units, plus function/subroutine entries in interfaces. This will help with applying and locating properties introduced by declarative or informational directives (e.g. DECLARE_TARGET, REQUIRES), which are stored as flags on the corresponding symbols. --- flang/lib/Semantics/check-omp-structure.cpp | 118 ++++++++++++++++++++ flang/lib/Semantics/check-omp-structure.h | 35 ++++-- 2 files changed, 142 insertions(+), 11 deletions(-) diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp index be10669ac2536..b3c4d24ad496d 100644 --- a/flang/lib/Semantics/check-omp-structure.cpp +++ b/flang/lib/Semantics/check-omp-structure.cpp @@ -61,6 +61,124 @@ namespace Fortran::semantics { using namespace Fortran::semantics::omp; using namespace Fortran::parser::omp; +OmpStructureChecker::OmpStructureChecker(SemanticsContext &context) + : DirectiveStructureChecker(context, +#define GEN_FLANG_DIRECTIVE_CLAUSE_MAP +#include "llvm/Frontend/OpenMP/OMP.inc" + ) { + scopeStack_.push_back(&context.globalScope()); +} + +bool OmpStructureChecker::Enter(const parser::MainProgram &x) { + using StatementProgramStmt = parser::Statement; + if (auto &stmt{std::get>(x.t)}) { + scopeStack_.push_back(stmt->statement.v.symbol->scope()); + } else { + for (const Scope &scope : context_.globalScope().children()) { + // There can only be one main program. + if (scope.kind() == Scope::Kind::MainProgram) { + scopeStack_.push_back(&scope); + break; + } + } + } + return true; +} + +void OmpStructureChecker::Leave(const parser::MainProgram &x) { + scopeStack_.pop_back(); +} + +bool OmpStructureChecker::Enter(const parser::BlockData &x) { + // The BLOCK DATA name is optional, so we need to look for the + // corresponding scope in the global scope. + auto &stmt{std::get>(x.t)}; + if (auto &name{stmt.statement.v}) { + scopeStack_.push_back(name->symbol->scope()); + } else { + for (const Scope &scope : context_.globalScope().children()) { + if (scope.kind() == Scope::Kind::BlockData) { + if (scope.symbol()->name().empty()) { + scopeStack_.push_back(&scope); + break; + } + } + } + } + return true; +} + +void OmpStructureChecker::Leave(const parser::BlockData &x) { + scopeStack_.pop_back(); +} + +bool OmpStructureChecker::Enter(const parser::Module &x) { + auto &stmt{std::get>(x.t)}; + const Symbol *sym{stmt.statement.v.symbol}; + scopeStack_.push_back(sym->scope()); + return true; +} + +void OmpStructureChecker::Leave(const parser::Module &x) { + scopeStack_.pop_back(); +} + +bool OmpStructureChecker::Enter(const parser::Submodule &x) { + auto &stmt{std::get>(x.t)}; + const Symbol *sym{std::get(stmt.statement.t).symbol}; + scopeStack_.push_back(sym->scope()); + return true; +} + +void OmpStructureChecker::Leave(const parser::Submodule &x) { + scopeStack_.pop_back(); +} + +// Function/subroutine subprogram nodes don't appear in INTERFACEs, but +// the subprogram/end statements do. +bool OmpStructureChecker::Enter(const parser::SubroutineStmt &x) { + const Symbol *sym{std::get(x.t).symbol}; + scopeStack_.push_back(sym->scope()); + return true; +} + +bool OmpStructureChecker::Enter(const parser::EndSubroutineStmt &x) { + scopeStack_.pop_back(); + return true; +} + +bool OmpStructureChecker::Enter(const parser::FunctionStmt &x) { + const Symbol *sym{std::get(x.t).symbol}; + scopeStack_.push_back(sym->scope()); + return true; +} + +bool OmpStructureChecker::Enter(const parser::EndFunctionStmt &x) { + scopeStack_.pop_back(); + return true; +} + +bool OmpStructureChecker::Enter(const parser::BlockConstruct &x) { + auto &specPart{std::get(x.t)}; + auto &execPart{std::get(x.t)}; + if (auto &&source{parser::GetSource(specPart)}) { + scopeStack_.push_back(&context_.FindScope(*source)); + } else if (auto &&source{parser::GetSource(execPart)}) { + scopeStack_.push_back(&context_.FindScope(*source)); + } + return true; +} + +void OmpStructureChecker::Leave(const parser::BlockConstruct &x) { + auto &specPart{std::get(x.t)}; + auto &execPart{std::get(x.t)}; + if (auto &&source{parser::GetSource(specPart)}) { + scopeStack_.push_back(&context_.FindScope(*source)); + } else if (auto &&source{parser::GetSource(execPart)}) { + scopeStack_.push_back(&context_.FindScope(*source)); + } +} + // Use when clause falls under 'struct OmpClause' in 'parse-tree.h'. #define CHECK_SIMPLE_CLAUSE(X, Y) \ void OmpStructureChecker::Enter(const parser::OmpClause::X &) { \ diff --git a/flang/lib/Semantics/check-omp-structure.h b/flang/lib/Semantics/check-omp-structure.h index 4cb0b743107d2..a09d8bad6b4cd 100644 --- a/flang/lib/Semantics/check-omp-structure.h +++ b/flang/lib/Semantics/check-omp-structure.h @@ -57,21 +57,32 @@ using SymbolSourceMap = std::multimap; using DirectivesClauseTriple = std::multimap>; -class OmpStructureChecker - : public DirectiveStructureChecker { +using OmpStructureCheckerBase = DirectiveStructureChecker; + +class OmpStructureChecker : public OmpStructureCheckerBase { public: - using Base = DirectiveStructureChecker; + using Base = OmpStructureCheckerBase; + + OmpStructureChecker(SemanticsContext &context); - OmpStructureChecker(SemanticsContext &context) - : DirectiveStructureChecker(context, -#define GEN_FLANG_DIRECTIVE_CLAUSE_MAP -#include "llvm/Frontend/OpenMP/OMP.inc" - ) { - } using llvmOmpClause = const llvm::omp::Clause; + bool Enter(const parser::MainProgram &); + void Leave(const parser::MainProgram &); + bool Enter(const parser::BlockData &); + void Leave(const parser::BlockData &); + bool Enter(const parser::Module &); + void Leave(const parser::Module &); + bool Enter(const parser::Submodule &); + void Leave(const parser::Submodule &); + bool Enter(const parser::SubroutineStmt &); + bool Enter(const parser::EndSubroutineStmt &); + bool Enter(const parser::FunctionStmt &); + bool Enter(const parser::EndFunctionStmt &); + bool Enter(const parser::BlockConstruct &); + void Leave(const parser::BlockConstruct &); + void Enter(const parser::OpenMPConstruct &); void Leave(const parser::OpenMPConstruct &); void Enter(const parser::OpenMPInteropConstruct &); @@ -374,6 +385,8 @@ class OmpStructureChecker using LoopConstruct = std::variant; std::vector loopStack_; + // Scopes for scoping units. + std::vector scopeStack_; }; /// Find a duplicate entry in the range, and return an iterator to it. From fc9b35d948dcbd6bf53bfe24fc70675e01f27044 Mon Sep 17 00:00:00 2001 From: Krzysztof Parzyszek Date: Sat, 11 Oct 2025 13:47:50 -0500 Subject: [PATCH 2/3] [flang][OpenMP] Refactor/update semantic checks for ALLOCATE directive OpenMP 5.0 and 5.1 allowed the ALLOCATE directive to appear in two forms, declarative and executable. The syntax of an individual directive was the same in both cases, but the semantic restrictions were slightly different. - Update the semantic checks to reflect the different restrictions, gather them in a single function. - Improve test for the presence of a TARGET region, add a check for REQUIRES directive. - Update tests. --- flang/include/flang/Semantics/openmp-utils.h | 8 +- flang/lib/Semantics/check-omp-structure.cpp | 181 +++++++++++++----- flang/lib/Semantics/check-omp-structure.h | 6 + flang/lib/Semantics/openmp-utils.cpp | 2 +- flang/lib/Semantics/resolve-directives.cpp | 20 -- flang/test/Semantics/OpenMP/allocate01.f90 | 2 +- flang/test/Semantics/OpenMP/allocate04.f90 | 17 +- flang/test/Semantics/OpenMP/allocate05.f90 | 2 +- flang/test/Semantics/OpenMP/allocate06.f90 | 2 +- flang/test/Semantics/OpenMP/allocate08.f90 | 27 ++- flang/test/Semantics/OpenMP/allocators04.f90 | 2 - flang/test/Semantics/OpenMP/allocators06.f90 | 18 -- .../OpenMP/declarative-directive02.f90 | 6 +- 13 files changed, 173 insertions(+), 120 deletions(-) delete mode 100644 flang/test/Semantics/OpenMP/allocators06.f90 diff --git a/flang/include/flang/Semantics/openmp-utils.h b/flang/include/flang/Semantics/openmp-utils.h index 0f851830edd46..7539d12264435 100644 --- a/flang/include/flang/Semantics/openmp-utils.h +++ b/flang/include/flang/Semantics/openmp-utils.h @@ -13,9 +13,11 @@ #ifndef FORTRAN_SEMANTICS_OPENMP_UTILS_H #define FORTRAN_SEMANTICS_OPENMP_UTILS_H +#include "flang/Common/indirection.h" #include "flang/Evaluate/type.h" #include "flang/Parser/char-block.h" #include "flang/Parser/parse-tree.h" +#include "flang/Parser/tools.h" #include "flang/Semantics/tools.h" #include "llvm/ADT/ArrayRef.h" @@ -74,7 +76,11 @@ bool IsVarOrFunctionRef(const MaybeExpr &expr); bool IsMapEnteringType(parser::OmpMapType::Value type); bool IsMapExitingType(parser::OmpMapType::Value type); -std::optional GetEvaluateExpr(const parser::Expr &parserExpr); +MaybeExpr GetEvaluateExpr(const parser::Expr &parserExpr); +template MaybeExpr GetEvaluateExpr(const T &inp) { + return GetEvaluateExpr(parser::UnwrapRef(inp)); +} + std::optional GetDynamicType( const parser::Expr &parserExpr); diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp index b3c4d24ad496d..2253a44ef1189 100644 --- a/flang/lib/Semantics/check-omp-structure.cpp +++ b/flang/lib/Semantics/check-omp-structure.cpp @@ -480,6 +480,36 @@ bool OmpStructureChecker::IsNestedInDirective(llvm::omp::Directive directive) { return false; } +bool OmpStructureChecker::InTargetRegion() { + if (IsNestedInDirective(llvm::omp::Directive::OMPD_target)) { + // Return true even for device_type(host). + return true; + } + for (const Scope *scope : llvm::reverse(scopeStack_)) { + if (const auto *symbol{scope->symbol()}) { + if (symbol->test(Symbol::Flag::OmpDeclareTarget)) { + return true; + } + } + } + return false; +} + +bool OmpStructureChecker::HasRequires(llvm::omp::Clause req) { + const Scope &unit{GetProgramUnit(*scopeStack_.back())}; + return common::visit( + [&](const auto &details) { + if constexpr (std::is_convertible_v) { + if (auto *reqs{details.ompRequires()}) { + return reqs->test(req); + } + } + return false; + }, + DEREF(unit.symbol()).details()); +} + void OmpStructureChecker::CheckVariableListItem( const SymbolSourceMap &symbols) { for (auto &[symbol, source] : symbols) { @@ -1680,40 +1710,92 @@ void OmpStructureChecker::Leave(const parser::OpenMPRequiresConstruct &) { dirContext_.pop_back(); } -void OmpStructureChecker::Enter(const parser::OpenMPDeclarativeAllocate &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); - SymbolSourceMap currSymbols; - GetSymbolsInObjectList(objectList, currSymbols); - for (auto &[symbol, source] : currSymbols) { - if (IsPointer(*symbol)) { +void OmpStructureChecker::CheckAllocateDirective(parser::CharBlock source, + const parser::OmpObjectList &objects, + const parser::OmpClauseList &clauses) { + const Scope &thisScope{context_.FindScope(source)}; + SymbolSourceMap symbols; + GetSymbolsInObjectList(objects, symbols); + + auto hasPredefinedAllocator{[&](const parser::OmpClause *c) { + if (!c) { + return std::make_optional(false); + } + auto *allocator{std::get_if(&c->u)}; + if (auto val{ToInt64(GetEvaluateExpr(allocator->v))}) { + // Predefined allocators: + // omp_null_allocator = 0, + // omp_default_mem_alloc = 1, + // omp_large_cap_mem_alloc = 2, + // omp_const_mem_alloc = 3, + // omp_high_bw_mem_alloc = 4, + // omp_low_lat_mem_alloc = 5, + // omp_cgroup_mem_alloc = 6, + // omp_pteam_mem_alloc = 7, + // omp_thread_mem_alloc = 8 + return std::make_optional(*val >= 0 && *val <= 8); + } + return std::optional{}; + }}; + + const auto *allocator{FindClause(llvm::omp::Clause::OMPC_allocator)}; + if (InTargetRegion()) { + bool hasDynAllocators{ + HasRequires(llvm::omp::Clause::OMPC_dynamic_allocators)}; + if (!allocator && !hasDynAllocators) { context_.Say(source, - "List item '%s' in ALLOCATE directive must not have POINTER " - "attribute"_err_en_US, - source.ToString()); + "An ALLOCATE directive in a TARGET region must specify an ALLOCATOR clause or REQUIRES(DYNAMIC_ALLOCATORS) must be specified"_err_en_US); } - if (IsDummy(*symbol)) { - context_.Say(source, - "List item '%s' in ALLOCATE directive must not be a dummy " - "argument"_err_en_US, - source.ToString()); + } + + bool isPredefined{hasPredefinedAllocator(allocator).value_or(false)}; + + for (auto &[symbol, source] : symbols) { + if (!inExecutableAllocate_) { + if (symbol->owner() != thisScope) { + context_.Say(source, + "A list item on a declarative ALLOCATE must be declared in the same scope in which the directive appears"_err_en_US); + } + if (IsPointer(*symbol) || IsAllocatable(*symbol)) { + context_.Say(source, + "A list item in a declarative ALLOCATE cannot have the ALLOCATABLE or POINTER attribute"_err_en_US); + } } if (symbol->GetUltimate().has()) { context_.Say(source, - "List item '%s' in ALLOCATE directive must not be an associate " - "name"_err_en_US, - source.ToString()); + "A list item in a declarative ALLOCATE cannot be an associate name"_err_en_US); + } + if (symbol->attrs().test(Attr::SAVE) || IsCommonBlock(*symbol)) { + if (!allocator) { + context_.Say(source, + "If a list item is a named common block or has SAVE attribute, an ALLOCATOR clause must be present with a predefined allocator"_err_en_US); + } else if (!isPredefined) { + context_.Say(source, + "If a list item is a named common block or has SAVE attribute, only a predefined allocator may be used on the ALLOCATOR clause"_warn_en_US); + } + } + if (FindCommonBlockContaining(*symbol)) { + context_.Say(source, + "A variable that is part of a common block may not be specified as a list item in an ALLOCATE directive, except implicitly via the named common block"_err_en_US); } } - CheckVarIsNotPartOfAnotherVar(dir.source, objectList); + CheckVarIsNotPartOfAnotherVar(source, objects); } -void OmpStructureChecker::Leave(const parser::OpenMPDeclarativeAllocate &x) { +void OmpStructureChecker::Enter(const parser::OpenMPDeclarativeAllocate &x) { const auto &dir{std::get(x.t)}; - const auto &objectList{std::get(x.t)}; - CheckPredefinedAllocatorRestriction(dir.source, objectList); + PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_allocate); +} + +void OmpStructureChecker::Leave(const parser::OpenMPDeclarativeAllocate &x) { + if (!inExecutableAllocate_) { + const auto &dir{std::get(x.t)}; + const auto &clauseList{std::get(x.t)}; + const auto &objectList{std::get(x.t)}; + + isPredefinedAllocator = true; + CheckAllocateDirective(dir.source, objectList, clauseList); + } dirContext_.pop_back(); } @@ -2069,6 +2151,7 @@ void OmpStructureChecker::CheckNameInAllocateStmt( } void OmpStructureChecker::Enter(const parser::OpenMPExecutableAllocate &x) { + inExecutableAllocate_ = true; const auto &dir{std::get(x.t)}; PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_allocate); @@ -2078,24 +2161,6 @@ void OmpStructureChecker::Enter(const parser::OpenMPExecutableAllocate &x) { "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)}) { @@ -2112,18 +2177,34 @@ void OmpStructureChecker::Enter(const parser::OpenMPExecutableAllocate &x) { } isPredefinedAllocator = true; - const auto &objectList{std::get>(x.t)}; - if (objectList) { - CheckVarIsNotPartOfAnotherVar(dir.source, *objectList); - } } void OmpStructureChecker::Leave(const parser::OpenMPExecutableAllocate &x) { - const auto &dir{std::get(x.t)}; - const auto &objectList{std::get>(x.t)}; - if (objectList) - CheckPredefinedAllocatorRestriction(dir.source, *objectList); + parser::OmpObjectList empty{std::list{}}; + auto &objects{[&]() -> const parser::OmpObjectList & { + if (auto &objects{std::get>(x.t)}) { + return *objects; + } else { + return empty; + } + }()}; + auto &clauses{std::get(x.t)}; + CheckAllocateDirective( + std::get(x.t).source, objects, clauses); + + if (const auto &subDirs{ + std::get>>( + x.t)}) { + for (const auto &dalloc : *subDirs) { + const auto &dir{std::get(x.t)}; + const auto &clauses{std::get(dalloc.t)}; + const auto &objects{std::get(dalloc.t)}; + CheckAllocateDirective(dir.source, objects, clauses); + } + } + dirContext_.pop_back(); + inExecutableAllocate_ = false; } void OmpStructureChecker::Enter(const parser::OpenMPAllocatorsConstruct &x) { diff --git a/flang/lib/Semantics/check-omp-structure.h b/flang/lib/Semantics/check-omp-structure.h index a09d8bad6b4cd..70d1ad3f44514 100644 --- a/flang/lib/Semantics/check-omp-structure.h +++ b/flang/lib/Semantics/check-omp-structure.h @@ -189,10 +189,12 @@ class OmpStructureChecker : public OmpStructureCheckerBase { const parser::CharBlock &, const OmpDirectiveSet &); bool IsCloselyNestedRegion(const OmpDirectiveSet &set); bool IsNestedInDirective(llvm::omp::Directive directive); + bool InTargetRegion(); void HasInvalidTeamsNesting( const llvm::omp::Directive &dir, const parser::CharBlock &source); void HasInvalidDistributeNesting(const parser::OpenMPLoopConstruct &x); void HasInvalidLoopBinding(const parser::OpenMPLoopConstruct &x); + bool HasRequires(llvm::omp::Clause req); // specific clause related void CheckAllowedMapTypes( parser::OmpMapType::Value, llvm::ArrayRef); @@ -262,6 +264,9 @@ class OmpStructureChecker : public OmpStructureCheckerBase { bool CheckTargetBlockOnlyTeams(const parser::Block &); void CheckWorkshareBlockStmts(const parser::Block &, parser::CharBlock); void CheckWorkdistributeBlockStmts(const parser::Block &, parser::CharBlock); + void CheckAllocateDirective(parser::CharBlock source, + const parser::OmpObjectList &objects, + const parser::OmpClauseList &clauses); void CheckIteratorRange(const parser::OmpIteratorSpecifier &x); void CheckIteratorModifier(const parser::OmpIterator &x); @@ -379,6 +384,7 @@ class OmpStructureChecker : public OmpStructureCheckerBase { }; int directiveNest_[LastType + 1] = {0}; + bool inExecutableAllocate_{false}; parser::CharBlock visitedAtomicSource_; SymbolSourceMap deferredNonVariables_; diff --git a/flang/lib/Semantics/openmp-utils.cpp b/flang/lib/Semantics/openmp-utils.cpp index 292e73b4899c0..cc55bb4954cc3 100644 --- a/flang/lib/Semantics/openmp-utils.cpp +++ b/flang/lib/Semantics/openmp-utils.cpp @@ -218,7 +218,7 @@ bool IsMapExitingType(parser::OmpMapType::Value type) { } } -std::optional GetEvaluateExpr(const parser::Expr &parserExpr) { +MaybeExpr GetEvaluateExpr(const parser::Expr &parserExpr) { const parser::TypedExpr &typedExpr{parserExpr.typedExpr}; // ForwardOwningPointer typedExpr // `- GenericExprWrapper ^.get() diff --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp index 33e9ea5a89efd..cbbc8106115c8 100644 --- a/flang/lib/Semantics/resolve-directives.cpp +++ b/flang/lib/Semantics/resolve-directives.cpp @@ -3107,26 +3107,6 @@ void OmpAttributeVisitor::ResolveOmpDesignator( AddAllocateName(name); } } - if (ompFlag == Symbol::Flag::OmpDeclarativeAllocateDirective && - IsAllocatable(*symbol) && - !IsNestedInDirective(llvm::omp::Directive::OMPD_allocate)) { - context_.Say(designator.source, - "List items specified in the ALLOCATE directive must not have the ALLOCATABLE attribute unless the directive is associated with an ALLOCATE statement"_err_en_US); - } - bool checkScope{ompFlag == Symbol::Flag::OmpDeclarativeAllocateDirective}; - // In 5.1 the scope check only applies to declarative allocate. - if (version == 50 && !checkScope) { - checkScope = ompFlag == Symbol::Flag::OmpExecutableAllocateDirective; - } - if (checkScope) { - if (omp::GetScopingUnit(GetContext().scope) != - omp::GetScopingUnit(symbol->GetUltimate().owner())) { - context_.Say(designator.source, // 2.15.3 - "List items must be declared in the same scoping unit in which the %s directive appears"_err_en_US, - parser::ToUpperCaseLetters( - llvm::omp::getOpenMPDirectiveName(directive, version))); - } - } if (ompFlag == Symbol::Flag::OmpReduction) { // Using variables inside of a namelist in OpenMP reductions // is allowed by the standard, but is not allowed for diff --git a/flang/test/Semantics/OpenMP/allocate01.f90 b/flang/test/Semantics/OpenMP/allocate01.f90 index 1d99811156438..229fd4d6c3f95 100644 --- a/flang/test/Semantics/OpenMP/allocate01.f90 +++ b/flang/test/Semantics/OpenMP/allocate01.f90 @@ -15,7 +15,7 @@ subroutine sema() integer :: a, b real, dimension (:,:), allocatable :: darray - !ERROR: List items must be declared in the same scoping unit in which the ALLOCATE directive appears + !ERROR: A list item on a declarative ALLOCATE must be declared in the same scope in which the directive appears !$omp allocate(y) print *, a diff --git a/flang/test/Semantics/OpenMP/allocate04.f90 b/flang/test/Semantics/OpenMP/allocate04.f90 index bbd74eb2ca101..5fd75bad6c4ec 100644 --- a/flang/test/Semantics/OpenMP/allocate04.f90 +++ b/flang/test/Semantics/OpenMP/allocate04.f90 @@ -14,16 +14,19 @@ subroutine allocate(z) type(c_ptr), pointer :: p integer :: x, y, z - associate (a => x) - !$omp allocate(x) allocator(omp_default_mem_alloc) - !ERROR: PRIVATE clause is not allowed on the ALLOCATE directive !$omp allocate(y) private(y) - !ERROR: List item 'z' in ALLOCATE directive must not be a dummy argument - !$omp allocate(z) - !ERROR: List item 'p' in ALLOCATE directive must not have POINTER attribute + !ERROR: A list item in a declarative ALLOCATE cannot have the ALLOCATABLE or POINTER attribute !$omp allocate(p) - !ERROR: List item 'a' in ALLOCATE directive must not be an associate name + + associate (a => x) + block + !ERROR: A list item on a declarative ALLOCATE must be declared in the same scope in which the directive appears + !$omp allocate(x) allocator(omp_default_mem_alloc) + + !ERROR: A list item on a declarative ALLOCATE must be declared in the same scope in which the directive appears + !ERROR: A list item in a declarative ALLOCATE cannot be an associate name !$omp allocate(a) + end block end associate end subroutine allocate diff --git a/flang/test/Semantics/OpenMP/allocate05.f90 b/flang/test/Semantics/OpenMP/allocate05.f90 index a787e8bb32a4c..b5f7864a42b92 100644 --- a/flang/test/Semantics/OpenMP/allocate05.f90 +++ b/flang/test/Semantics/OpenMP/allocate05.f90 @@ -18,7 +18,7 @@ subroutine allocate() !$omp end target !$omp target - !ERROR: ALLOCATE directives that appear in a TARGET region must specify an allocator clause + !ERROR: An ALLOCATE directive in a TARGET region must specify an ALLOCATOR clause or REQUIRES(DYNAMIC_ALLOCATORS) must be specified !$omp allocate allocate ( darray(a, b) ) !$omp end target diff --git a/flang/test/Semantics/OpenMP/allocate06.f90 b/flang/test/Semantics/OpenMP/allocate06.f90 index e14134cd07301..9b57322bbadc6 100644 --- a/flang/test/Semantics/OpenMP/allocate06.f90 +++ b/flang/test/Semantics/OpenMP/allocate06.f90 @@ -11,7 +11,7 @@ subroutine allocate() integer :: a, b, x real, dimension (:,:), allocatable :: darray - !ERROR: List items specified in the ALLOCATE directive must not have the ALLOCATABLE attribute unless the directive is associated with an ALLOCATE statement + !ERROR: A list item in a declarative ALLOCATE cannot have the ALLOCATABLE or POINTER attribute !$omp allocate(darray) allocator(omp_default_mem_alloc) !$omp allocate(darray) allocator(omp_default_mem_alloc) diff --git a/flang/test/Semantics/OpenMP/allocate08.f90 b/flang/test/Semantics/OpenMP/allocate08.f90 index 5bfa918be4cad..e12eb4a7b7526 100644 --- a/flang/test/Semantics/OpenMP/allocate08.f90 +++ b/flang/test/Semantics/OpenMP/allocate08.f90 @@ -3,14 +3,15 @@ ! RUN: %python %S/../test_errors.py %s %flang_fc1 %openmp_flags ! OpenMP Version 5.0 ! 2.11.3 allocate Directive -! If list items within the ALLOCATE directive have the SAVE attribute, are a common block name, or are declared in the scope of a -! module, then only predefined memory allocator parameters can be used in the allocator clause +! If list items within the ALLOCATE directive have the SAVE attribute, are a +! common block name, or are declared in the scope of a module, then only +! predefined memory allocator parameters can be used in the allocator clause module AllocateModule INTEGER :: z end module -subroutine allocate() +subroutine allocate(custom_allocator) use omp_lib use AllocateModule integer, SAVE :: x @@ -18,30 +19,26 @@ subroutine allocate() COMMON /CommonName/ y integer(kind=omp_allocator_handle_kind) :: custom_allocator - integer(kind=omp_memspace_handle_kind) :: memspace - type(omp_alloctrait), dimension(1) :: trait - memspace = omp_default_mem_space - trait(1)%key = fallback - trait(1)%value = default_mem_fb - custom_allocator = omp_init_allocator(memspace, 1, trait) !$omp allocate(x) allocator(omp_default_mem_alloc) + !ERROR: A variable that is part of a common block may not be specified as a list item in an ALLOCATE directive, except implicitly via the named common block !$omp allocate(y) allocator(omp_default_mem_alloc) - !ERROR: List items must be declared in the same scoping unit in which the ALLOCATE directive appears + !ERROR: A list item on a declarative ALLOCATE must be declared in the same scope in which the directive appears !$omp allocate(z) allocator(omp_default_mem_alloc) + !ERROR: If a list item is a named common block or has SAVE attribute, an ALLOCATOR clause must be present with a predefined allocator !$omp allocate(x) + !ERROR: A variable that is part of a common block may not be specified as a list item in an ALLOCATE directive, except implicitly via the named common block !$omp allocate(y) - !ERROR: List items must be declared in the same scoping unit in which the ALLOCATE directive appears + !ERROR: A list item on a declarative ALLOCATE must be declared in the same scope in which the directive appears !$omp allocate(z) !$omp allocate(w) allocator(custom_allocator) - !ERROR: If list items within the ALLOCATE directive have the SAVE attribute, are a common block name, or are declared in the scope of a module, then only predefined memory allocator parameters can be used in the allocator clause + !ERROR: If a list item is a named common block or has SAVE attribute, only a predefined allocator may be used on the ALLOCATOR clause !$omp allocate(x) allocator(custom_allocator) - !ERROR: If list items within the ALLOCATE directive have the SAVE attribute, are a common block name, or are declared in the scope of a module, then only predefined memory allocator parameters can be used in the allocator clause + !ERROR: A variable that is part of a common block may not be specified as a list item in an ALLOCATE directive, except implicitly via the named common block !$omp allocate(y) allocator(custom_allocator) - !ERROR: If list items within the ALLOCATE directive have the SAVE attribute, are a common block name, or are declared in the scope of a module, then only predefined memory allocator parameters can be used in the allocator clause - !ERROR: List items must be declared in the same scoping unit in which the ALLOCATE directive appears + !ERROR: A list item on a declarative ALLOCATE must be declared in the same scope in which the directive appears !$omp allocate(z) allocator(custom_allocator) end subroutine allocate diff --git a/flang/test/Semantics/OpenMP/allocators04.f90 b/flang/test/Semantics/OpenMP/allocators04.f90 index c71c7ca8466ba..212e48fbd1b26 100644 --- a/flang/test/Semantics/OpenMP/allocators04.f90 +++ b/flang/test/Semantics/OpenMP/allocators04.f90 @@ -22,12 +22,10 @@ subroutine allocate() trait(1)%value = default_mem_fb custom_allocator = omp_init_allocator(omp_default_mem_space, 1, trait) - !ERROR: List items must be declared in the same scoping unit in which the ALLOCATORS directive appears !$omp allocators allocate(omp_default_mem_alloc: a) allocate(a) !ERROR: If list items within the ALLOCATORS directive have the SAVE attribute, are a common block name, or are declared in the scope of a module, then only predefined memory allocator parameters can be used in the allocator clause - !ERROR: List items must be declared in the same scoping unit in which the ALLOCATORS directive appears !$omp allocators allocate(custom_allocator: b) allocate(b) end subroutine diff --git a/flang/test/Semantics/OpenMP/allocators06.f90 b/flang/test/Semantics/OpenMP/allocators06.f90 deleted file mode 100644 index 8e63512369e38..0000000000000 --- a/flang/test/Semantics/OpenMP/allocators06.f90 +++ /dev/null @@ -1,18 +0,0 @@ -! REQUIRES: openmp_runtime - -! RUN: %python %S/../test_errors.py %s %flang_fc1 %openmp_flags -fopenmp-version=50 -! OpenMP Version 5.2 -! Inherited from 2.11.3 allocate directive -! The allocate directive must appear in the same scope as the declarations of -! each of its list items and must follow all such declarations. - -subroutine allocate() - use omp_lib - integer, allocatable :: a -contains - subroutine test() - !ERROR: List items must be declared in the same scoping unit in which the ALLOCATORS directive appears - !$omp allocators allocate(omp_default_mem_alloc: a) - allocate(a) - end subroutine -end subroutine diff --git a/flang/test/Semantics/OpenMP/declarative-directive02.f90 b/flang/test/Semantics/OpenMP/declarative-directive02.f90 index dcde963689eb0..04b8c3d43ba7a 100644 --- a/flang/test/Semantics/OpenMP/declarative-directive02.f90 +++ b/flang/test/Semantics/OpenMP/declarative-directive02.f90 @@ -9,7 +9,7 @@ subroutine test_decl implicit none save :: x1, y1 !$omp threadprivate(x1) - !$omp allocate(y1) + !$omp allocate(y1) allocator(0) integer :: x1, y1 ! OMPv5.2 7.7 declare-simd @@ -33,12 +33,12 @@ subroutine test_decl subroutine test_decl2 save x1, y1 !$omp threadprivate(x1) - !$omp allocate(y1) + !$omp allocate(y1) allocator(0) integer :: x1, y1 ! implicit decl !$omp threadprivate(x2) - !$omp allocate(y2) + !$omp allocate(y2) allocator(0) save x2, y2 end subroutine From 63b6d7dd3a96b891c62f69ccbb5af05632e8e641 Mon Sep 17 00:00:00 2001 From: Krzysztof Parzyszek Date: Wed, 22 Oct 2025 07:46:55 -0500 Subject: [PATCH 3/3] Simplify checks for predefined allocator --- flang/lib/Semantics/check-omp-structure.cpp | 25 ++++++++++++--------- flang/test/Semantics/OpenMP/allocate08.f90 | 1 - 2 files changed, 14 insertions(+), 12 deletions(-) diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp index 2253a44ef1189..41416304c1ea6 100644 --- a/flang/lib/Semantics/check-omp-structure.cpp +++ b/flang/lib/Semantics/check-omp-structure.cpp @@ -1717,13 +1717,16 @@ void OmpStructureChecker::CheckAllocateDirective(parser::CharBlock source, SymbolSourceMap symbols; GetSymbolsInObjectList(objects, symbols); - auto hasPredefinedAllocator{[&](const parser::OmpClause *c) { - if (!c) { - return std::make_optional(false); + auto maybeHasPredefinedAllocator{[&](const parser::OmpClause *calloc) { + // Return "true" if the ALLOCATOR clause was provided with an argument + // that is either a prefdefined allocator, or a run-time value. + // Otherwise return "false". + if (!calloc) { + return false; } - auto *allocator{std::get_if(&c->u)}; - if (auto val{ToInt64(GetEvaluateExpr(allocator->v))}) { - // Predefined allocators: + auto *allocator{std::get_if(&calloc->u)}; + if (auto val{ToInt64(GetEvaluateExpr(DEREF(allocator).v))}) { + // Predefined allocators (defined in OpenMP 6.0 20.8.1): // omp_null_allocator = 0, // omp_default_mem_alloc = 1, // omp_large_cap_mem_alloc = 2, @@ -1733,9 +1736,9 @@ void OmpStructureChecker::CheckAllocateDirective(parser::CharBlock source, // omp_cgroup_mem_alloc = 6, // omp_pteam_mem_alloc = 7, // omp_thread_mem_alloc = 8 - return std::make_optional(*val >= 0 && *val <= 8); + return *val >= 0 && *val <= 8; } - return std::optional{}; + return true; }}; const auto *allocator{FindClause(llvm::omp::Clause::OMPC_allocator)}; @@ -1748,7 +1751,7 @@ void OmpStructureChecker::CheckAllocateDirective(parser::CharBlock source, } } - bool isPredefined{hasPredefinedAllocator(allocator).value_or(false)}; + auto maybePredefined{maybeHasPredefinedAllocator(allocator)}; for (auto &[symbol, source] : symbols) { if (!inExecutableAllocate_) { @@ -1769,9 +1772,9 @@ void OmpStructureChecker::CheckAllocateDirective(parser::CharBlock source, if (!allocator) { context_.Say(source, "If a list item is a named common block or has SAVE attribute, an ALLOCATOR clause must be present with a predefined allocator"_err_en_US); - } else if (!isPredefined) { + } else if (!maybePredefined) { context_.Say(source, - "If a list item is a named common block or has SAVE attribute, only a predefined allocator may be used on the ALLOCATOR clause"_warn_en_US); + "If a list item is a named common block or has SAVE attribute, only a predefined allocator may be used on the ALLOCATOR clause"_err_en_US); } } if (FindCommonBlockContaining(*symbol)) { diff --git a/flang/test/Semantics/OpenMP/allocate08.f90 b/flang/test/Semantics/OpenMP/allocate08.f90 index e12eb4a7b7526..f4f11e229a28b 100644 --- a/flang/test/Semantics/OpenMP/allocate08.f90 +++ b/flang/test/Semantics/OpenMP/allocate08.f90 @@ -35,7 +35,6 @@ subroutine allocate(custom_allocator) !$omp allocate(w) allocator(custom_allocator) - !ERROR: If a list item is a named common block or has SAVE attribute, only a predefined allocator may be used on the ALLOCATOR clause !$omp allocate(x) allocator(custom_allocator) !ERROR: A variable that is part of a common block may not be specified as a list item in an ALLOCATE directive, except implicitly via the named common block !$omp allocate(y) allocator(custom_allocator)