[flang-commits] [flang] [flang][OpenMP] Reorganize ALLOCATE-related semantic checks (PR #165719)
Krzysztof Parzyszek via flang-commits
flang-commits at lists.llvm.org
Thu Oct 30 08:09:22 PDT 2025
https://github.com/kparzysz updated https://github.com/llvm/llvm-project/pull/165719
>From 3829611d514c402553fe8d822f7378dca35dec82 Mon Sep 17 00:00:00 2001
From: Krzysztof Parzyszek <Krzysztof.Parzyszek at amd.com>
Date: Wed, 29 Oct 2025 13:16:24 -0500
Subject: [PATCH 1/2] [flang][OpenMP] Reorganize ALLOCATE-related semantic
checks
For ALLOCATORS and executable ALLOCATE first perform list item checks in
the context of an individual ALLOCATE clause or directive respectively,
then perform "global" checks, e.g. whether all list items are present on
the ALLOCATE statement.
These changes allowed to simplify the checks for presence on ALLOCATE
statement and the use of a predefined allocator.
Additionally, allow variable list item lists to be empty, add a test for
the related spec restriction.
This is a first step towards unifying OpenMPDeclarativeAllocate and
OpenMPExecutableAllocate into a single directive.
---
flang/include/flang/Parser/parse-tree.h | 2 +-
flang/include/flang/Semantics/openmp-utils.h | 2 +
flang/lib/Parser/openmp-parsers.cpp | 14 +-
flang/lib/Parser/unparse.cpp | 2 +-
flang/lib/Semantics/check-omp-structure.cpp | 435 ++++++++++---------
flang/lib/Semantics/check-omp-structure.h | 10 -
flang/lib/Semantics/openmp-utils.cpp | 17 +
flang/lib/Semantics/resolve-directives.cpp | 5 +-
flang/test/Semantics/OpenMP/allocate08.f90 | 8 +-
flang/test/Semantics/OpenMP/allocate09.f90 | 4 +-
flang/test/Semantics/OpenMP/allocate10.f90 | 11 +
flang/test/Semantics/OpenMP/allocate11.f90 | 27 ++
flang/test/Semantics/OpenMP/allocators01.f90 | 2 +-
flang/test/Semantics/OpenMP/allocators04.f90 | 31 --
flang/test/Semantics/OpenMP/allocators05.f90 | 2 +-
flang/test/Semantics/OpenMP/allocators07.f90 | 6 +-
16 files changed, 322 insertions(+), 256 deletions(-)
create mode 100644 flang/test/Semantics/OpenMP/allocate10.f90
create mode 100644 flang/test/Semantics/OpenMP/allocate11.f90
delete mode 100644 flang/test/Semantics/OpenMP/allocators04.f90
diff --git a/flang/include/flang/Parser/parse-tree.h b/flang/include/flang/Parser/parse-tree.h
index 375790af90b74..4dd5e84f60dfe 100644
--- a/flang/include/flang/Parser/parse-tree.h
+++ b/flang/include/flang/Parser/parse-tree.h
@@ -5155,7 +5155,7 @@ struct OpenMPThreadprivate {
struct OpenMPDeclarativeAllocate {
TUPLE_CLASS_BOILERPLATE(OpenMPDeclarativeAllocate);
CharBlock source;
- std::tuple<Verbatim, OmpObjectList, OmpClauseList> t;
+ std::tuple<Verbatim, std::optional<OmpObjectList>, OmpClauseList> t;
};
struct OpenMPDeclarativeConstruct {
diff --git a/flang/include/flang/Semantics/openmp-utils.h b/flang/include/flang/Semantics/openmp-utils.h
index 032944d8be370..14a4f0e93bda5 100644
--- a/flang/include/flang/Semantics/openmp-utils.h
+++ b/flang/include/flang/Semantics/openmp-utils.h
@@ -72,6 +72,8 @@ const parser::OmpObject *GetArgumentObject(const parser::OmpArgument &argument);
bool IsCommonBlock(const Symbol &sym);
bool IsExtendedListItem(const Symbol &sym);
bool IsVariableListItem(const Symbol &sym);
+bool IsTypeParamInquiry(const Symbol &sym);
+bool IsStructureComponent(const Symbol &sym);
bool IsVarOrFunctionRef(const MaybeExpr &expr);
bool IsMapEnteringType(parser::OmpMapType::Value type);
diff --git a/flang/lib/Parser/openmp-parsers.cpp b/flang/lib/Parser/openmp-parsers.cpp
index 4159d2e41b78c..a9de26ea09ff8 100644
--- a/flang/lib/Parser/openmp-parsers.cpp
+++ b/flang/lib/Parser/openmp-parsers.cpp
@@ -2045,11 +2045,12 @@ TYPE_PARSER(sourced(construct<OpenMPCriticalConstruct>(
OmpBlockConstructParser{llvm::omp::Directive::OMPD_critical})))
// 2.11.3 Executable Allocate directive
-TYPE_PARSER(
- sourced(construct<OpenMPExecutableAllocate>(verbatim("ALLOCATE"_tok),
- maybe(parenthesized(Parser<OmpObjectList>{})), Parser<OmpClauseList>{},
- maybe(nonemptyList(Parser<OpenMPDeclarativeAllocate>{})) / endOmpLine,
- statement(allocateStmt))))
+TYPE_PARSER(sourced(construct<OpenMPExecutableAllocate>(
+ verbatim("ALLOCATE"_tok), maybe(parenthesized(Parser<OmpObjectList>{})),
+ Parser<OmpClauseList>{},
+ maybe(nonemptyList(startOmpLine >> Parser<OpenMPDeclarativeAllocate>{})) /
+ endOmpLine,
+ statement(allocateStmt))))
// 2.8.2 Declare Simd construct
TYPE_PARSER(sourced(construct<OpenMPDeclareSimdConstruct>(
@@ -2079,7 +2080,8 @@ TYPE_PARSER(sourced( //
// 2.11.3 Declarative Allocate directive
TYPE_PARSER(
sourced(construct<OpenMPDeclarativeAllocate>(verbatim("ALLOCATE"_tok),
- parenthesized(Parser<OmpObjectList>{}), Parser<OmpClauseList>{})) /
+ maybe(parenthesized(Parser<OmpObjectList>{})),
+ Parser<OmpClauseList>{})) /
lookAhead(endOmpLine / !statement(allocateStmt)))
// Assumes Construct
diff --git a/flang/lib/Parser/unparse.cpp b/flang/lib/Parser/unparse.cpp
index 9b38cfc40c5b2..b3a395c4d72e1 100644
--- a/flang/lib/Parser/unparse.cpp
+++ b/flang/lib/Parser/unparse.cpp
@@ -2503,7 +2503,7 @@ class UnparseVisitor {
BeginOpenMP();
Word("!$OMP ALLOCATE");
Put(" (");
- Walk(std::get<OmpObjectList>(x.t));
+ Walk(std::get<std::optional<OmpObjectList>>(x.t));
Put(")");
Walk(std::get<OmpClauseList>(x.t));
Put("\n");
diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index aaaf1ec5d4626..ece179c4a66fc 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -667,49 +667,6 @@ void OmpStructureChecker::HasInvalidTeamsNesting(
}
}
-void OmpStructureChecker::CheckPredefinedAllocatorRestriction(
- const parser::CharBlock &source, const parser::Name &name) {
- if (const auto *symbol{name.symbol}) {
- const auto *commonBlock{FindCommonBlockContaining(*symbol)};
- const auto &scope{context_.FindScope(symbol->name())};
- const Scope &containingScope{GetProgramUnitContaining(scope)};
- if (!isPredefinedAllocator &&
- (IsSaved(*symbol) || commonBlock ||
- containingScope.kind() == Scope::Kind::Module)) {
- context_.Say(source,
- "If list items within the %s 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"_err_en_US,
- ContextDirectiveAsFortran());
- }
- }
-}
-
-void OmpStructureChecker::CheckPredefinedAllocatorRestriction(
- const parser::CharBlock &source,
- const parser::OmpObjectList &ompObjectList) {
- for (const auto &ompObject : ompObjectList.v) {
- common::visit(
- common::visitors{
- [&](const parser::Designator &designator) {
- if (const auto *dataRef{
- std::get_if<parser::DataRef>(&designator.u)}) {
- if (const auto *name{std::get_if<parser::Name>(&dataRef->u)}) {
- CheckPredefinedAllocatorRestriction(source, *name);
- }
- }
- },
- [&](const parser::Name &name) {
- CheckPredefinedAllocatorRestriction(source, name);
- },
- [&](const parser::OmpObject::Invalid &invalid) {},
- },
- ompObject.u);
- }
-}
-
void OmpStructureChecker::Enter(const parser::OmpClause::Hint &x) {
CheckAllowedClause(llvm::omp::Clause::OMPC_hint);
auto &dirCtx{GetContext()};
@@ -1710,12 +1667,51 @@ void OmpStructureChecker::Leave(const parser::OpenMPRequiresConstruct &) {
dirContext_.pop_back();
}
+static std::pair<const parser::AllocateStmt *, parser::CharBlock>
+getAllocateStmtAndSource(const parser::Statement<parser::AllocateStmt> &stmt) {
+ return {&stmt.statement, stmt.source};
+}
+
+static std::pair<const parser::AllocateStmt *, parser::CharBlock>
+getAllocateStmtAndSource(const parser::ExecutionPartConstruct *epc) {
+ if (SourcedActionStmt as{GetActionStmt(epc)}) {
+ using IndirectionAllocateStmt = common::Indirection<parser::AllocateStmt>;
+ if (auto *indirect{std::get_if<IndirectionAllocateStmt>(&as.stmt->u)}) {
+ return {&indirect->value(), as.source};
+ }
+ }
+ return {nullptr, ""};
+}
+
+// Collect symbols that correspond to non-component objects on the
+// ALLOCATE statement.
+static UnorderedSymbolSet GetNonComponentSymbols(
+ const parser::AllocateStmt &stmt) {
+ UnorderedSymbolSet symbols;
+ for (auto &alloc : std::get<std::list<parser::Allocation>>(stmt.t)) {
+ auto &object{std::get<parser::AllocateObject>(alloc.t)};
+ if (auto *name{std::get_if<parser::Name>(&object.u)}) {
+ if (name->symbol) {
+ symbols.insert(name->symbol->GetUltimate());
+ }
+ }
+ }
+ return symbols;
+}
+
+static const parser::OmpObjectList &GetObjectsOrEmpty(
+ const std::optional<parser::OmpObjectList> &maybeObjects) {
+ static parser::OmpObjectList empty{std::list<parser::OmpObject>{}};
+ if (maybeObjects) {
+ return *maybeObjects;
+ }
+ return empty;
+}
+
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 maybeHasPredefinedAllocator{[&](const parser::OmpClause *calloc) {
// Return "true" if the ALLOCATOR clause was provided with an argument
@@ -1741,7 +1737,17 @@ void OmpStructureChecker::CheckAllocateDirective(parser::CharBlock source,
return true;
}};
- const auto *allocator{FindClause(llvm::omp::Clause::OMPC_allocator)};
+ const auto *allocator{[&]() {
+ // Can't use FindClause in Enter (because clauses haven't been visited
+ // yet).
+ for (const parser::OmpClause &c : clauses.v) {
+ if (c.Id() == llvm::omp::Clause::OMPC_allocator) {
+ return &c;
+ }
+ }
+ return static_cast<const parser::OmpClause *>(nullptr);
+ }()};
+
if (InTargetRegion()) {
bool hasDynAllocators{
HasRequires(llvm::omp::Clause::OMPC_dynamic_allocators)};
@@ -1753,61 +1759,85 @@ void OmpStructureChecker::CheckAllocateDirective(parser::CharBlock source,
auto maybePredefined{maybeHasPredefinedAllocator(allocator)};
- for (auto &[symbol, source] : symbols) {
+ unsigned version{context_.langOptions().OpenMPVersion};
+ std::string condStr{version == 50
+ ? "a named common block, has SAVE attribute or is declared in the "
+ "scope of a module"
+ : "a named common block or has SAVE attribute"};
+
+ auto checkSymbol{[&](const Symbol &symbol, parser::CharBlock source) {
if (!inExecutableAllocate_) {
- if (symbol->owner() != thisScope) {
+ // For structure members, the scope is the derived type, which is
+ // never "this" scope. Ignore this check for members, they will be
+ // flagged anyway.
+ if (symbol.owner() != thisScope && !IsStructureComponent(symbol)) {
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)) {
+ 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<AssocEntityDetails>()) {
+ if (symbol.GetUltimate().has<AssocEntityDetails>()) {
context_.Say(source,
"A list item in a declarative ALLOCATE cannot be an associate name"_err_en_US);
}
- if (symbol->attrs().test(Attr::SAVE) || IsCommonBlock(*symbol)) {
+ bool inModule{
+ version == 50 && symbol.owner().kind() == Scope::Kind::Module};
+ if (symbol.attrs().test(Attr::SAVE) || IsCommonBlock(symbol) || inModule) {
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);
+ "If a list item is %s, an ALLOCATOR clause must be present with a predefined allocator"_err_en_US,
+ condStr);
} 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"_err_en_US);
+ "If a list item is %s, only a predefined allocator may be used on the ALLOCATOR clause"_err_en_US,
+ condStr);
}
}
- if (FindCommonBlockContaining(*symbol)) {
+ 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);
}
+ }};
+
+ for (const parser::OmpObject &object : objects.v) {
+ parser::CharBlock objSource{[&]() {
+ if (auto &&maybeSource{GetObjectSource(object)}) {
+ return *maybeSource;
+ }
+ return source;
+ }()};
+ if (const Symbol *symbol{GetObjectSymbol(object)}) {
+ if (!IsTypeParamInquiry(*symbol)) {
+ checkSymbol(*symbol, objSource);
+ }
+ CheckVarIsNotPartOfAnotherVar(source, object);
+ }
}
- CheckVarIsNotPartOfAnotherVar(source, objects);
}
void OmpStructureChecker::Enter(const parser::OpenMPDeclarativeAllocate &x) {
const auto &dir{std::get<parser::Verbatim>(x.t)};
PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_allocate);
-}
-void OmpStructureChecker::Leave(const parser::OpenMPDeclarativeAllocate &x) {
if (!inExecutableAllocate_) {
const auto &dir{std::get<parser::Verbatim>(x.t)};
- const auto &clauseList{std::get<parser::OmpClauseList>(x.t)};
- const auto &objectList{std::get<parser::OmpObjectList>(x.t)};
+ const auto &clauses{std::get<parser::OmpClauseList>(x.t)};
+ const auto &objects{
+ GetObjectsOrEmpty(std::get<std::optional<parser::OmpObjectList>>(x.t))};
- isPredefinedAllocator = true;
- CheckAllocateDirective(dir.source, objectList, clauseList);
+ CheckAllocateDirective(dir.source, objects, clauses);
}
+}
+
+void OmpStructureChecker::Leave(const parser::OpenMPDeclarativeAllocate &x) {
dirContext_.pop_back();
}
void OmpStructureChecker::Enter(const parser::OmpClause::Allocator &x) {
CheckAllowedClause(llvm::omp::Clause::OMPC_allocator);
- // Note: Predefined allocators are stored in ScalarExpr as numbers
- // whereas custom allocators are stored as strings, so if the ScalarExpr
- // actually has an int value, then it must be a predefined allocator
- isPredefinedAllocator = GetIntValue(x.v).has_value();
RequiresPositiveParameter(llvm::omp::Clause::OMPC_allocator, x.v);
}
@@ -1823,16 +1853,6 @@ void OmpStructureChecker::Enter(const parser::OmpClause::Allocate &x) {
"The alignment value should be a constant positive integer"_err_en_US);
}
}
- // The simple and complex modifiers have the same structure. They only
- // differ in their syntax.
- if (auto *alloc{OmpGetUniqueModifier<parser::OmpAllocatorComplexModifier>(
- modifiers)}) {
- isPredefinedAllocator = GetIntValue(alloc->v).has_value();
- }
- if (auto *alloc{OmpGetUniqueModifier<parser::OmpAllocatorSimpleModifier>(
- modifiers)}) {
- isPredefinedAllocator = GetIntValue(alloc->v).has_value();
- }
}
}
@@ -2115,44 +2135,6 @@ 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<parser::Designator>(&obj.u)}) {
- if (const auto *ref{std::get_if<parser::DataRef>(&d->u)}) {
- if (const auto *n{std::get_if<parser::Name>(&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<std::list<parser::Allocation>>(allocate.t)) {
- const auto &allocObj = std::get<parser::AllocateObject>(allocation.t);
- if (const auto *n{std::get_if<parser::Name>(&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) {
inExecutableAllocate_ = true;
const auto &dir{std::get<parser::Verbatim>(x.t)};
@@ -2164,34 +2146,10 @@ 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);
}
- const auto &allocateStmt =
- std::get<parser::Statement<parser::AllocateStmt>>(x.t).statement;
- if (const auto &list{std::get<std::optional<parser::OmpObjectList>>(x.t)}) {
- CheckAllNamesInAllocateStmt(
- std::get<parser::Verbatim>(x.t).source, *list, allocateStmt);
- }
- if (const auto &subDirs{
- std::get<std::optional<std::list<parser::OpenMPDeclarativeAllocate>>>(
- x.t)}) {
- for (const auto &dalloc : *subDirs) {
- CheckAllNamesInAllocateStmt(std::get<parser::Verbatim>(dalloc.t).source,
- std::get<parser::OmpObjectList>(dalloc.t), allocateStmt);
- }
- }
-
- isPredefinedAllocator = true;
-}
-
-void OmpStructureChecker::Leave(const parser::OpenMPExecutableAllocate &x) {
- parser::OmpObjectList empty{std::list<parser::OmpObject>{}};
- auto &objects{[&]() -> const parser::OmpObjectList & {
- if (auto &objects{std::get<std::optional<parser::OmpObjectList>>(x.t)}) {
- return *objects;
- } else {
- return empty;
- }
- }()};
+ auto &objects{
+ GetObjectsOrEmpty(std::get<std::optional<parser::OmpObjectList>>(x.t))};
auto &clauses{std::get<parser::OmpClauseList>(x.t)};
+
CheckAllocateDirective(
std::get<parser::Verbatim>(x.t).source, objects, clauses);
@@ -2201,82 +2159,171 @@ void OmpStructureChecker::Leave(const parser::OpenMPExecutableAllocate &x) {
for (const auto &dalloc : *subDirs) {
const auto &dir{std::get<parser::Verbatim>(x.t)};
const auto &clauses{std::get<parser::OmpClauseList>(dalloc.t)};
- const auto &objects{std::get<parser::OmpObjectList>(dalloc.t)};
+ const auto &objects{GetObjectsOrEmpty(
+ std::get<std::optional<parser::OmpObjectList>>(dalloc.t))};
CheckAllocateDirective(dir.source, objects, clauses);
}
}
+}
+
+void OmpStructureChecker::Leave(const parser::OpenMPExecutableAllocate &x) {
+ auto [allocStmt, allocSource]{getAllocateStmtAndSource(
+ std::get<parser::Statement<parser::AllocateStmt>>(x.t))};
+
+ UnorderedSymbolSet allocateSyms{GetNonComponentSymbols(*allocStmt)};
+ SymbolSourceMap directiveSyms;
+ auto &objects{
+ GetObjectsOrEmpty(std::get<std::optional<parser::OmpObjectList>>(x.t))};
+ auto emptyListCount{static_cast<size_t>(objects.v.empty())};
+ auto checkObjects{[&](const parser::OmpObjectList &objects,
+ parser::CharBlock dirSource,
+ parser::CharBlock allocSource) {
+ for (const parser::OmpObject &object : objects.v) {
+ parser::CharBlock objSource{[&]() {
+ if (auto &&maybeSource{GetObjectSource(object)}) {
+ return *maybeSource;
+ }
+ return dirSource;
+ }()};
+ if (auto *sym{GetObjectSymbol(object)}) {
+ // Ignore these checks for structure members. They are not allowed
+ // in the first place, so don't tell the users that they nened to
+ // be specified somewhere,
+ if (IsStructureComponent(*sym)) {
+ continue;
+ }
+ if (auto f{directiveSyms.find(sym)}; f != directiveSyms.end()) {
+ parser::MessageFormattedText txt(
+ "A list item on an executable ALLOCATE may only be specified once"_err_en_US);
+ parser::Message message(objSource, txt);
+ message.Attach(f->second, "The list item was specified here"_en_US);
+ context_.Say(std::move(message));
+ } else {
+ directiveSyms.insert(std::make_pair(sym, objSource));
+ }
+
+ if (auto f{allocateSyms.find(*sym)}; f == allocateSyms.end()) {
+ context_
+ .Say(objSource,
+ "A list item on an executable ALLOCATE must be specified on the associated ALLOCATE statement"_err_en_US)
+ .Attach(allocSource, "The ALLOCATE statement"_en_US);
+ }
+ }
+ }
+ }};
+
+ checkObjects(objects, std::get<parser::Verbatim>(x.t).source, allocSource);
+
+ const auto &subDirs{
+ std::get<std::optional<std::list<parser::OpenMPDeclarativeAllocate>>>(
+ x.t)};
+ if (!subDirs) {
+ inExecutableAllocate_ = false;
+ dirContext_.pop_back();
+ return;
+ }
+
+ for (const parser::OpenMPDeclarativeAllocate &ompAlloc : *subDirs) {
+ parser::CharBlock dirSource{std::get<parser::Verbatim>(ompAlloc.t).source};
+ auto &objects{GetObjectsOrEmpty(
+ std::get<std::optional<parser::OmpObjectList>>(ompAlloc.t))};
+ if (objects.v.empty()) {
+ // Only show the message once per construct.
+ if (++emptyListCount == 2 && subDirs->size() >= 1) {
+ context_.Say(dirSource,
+ "If multiple directives are present in an executable ALLOCATE directive, at most one of them may specify no list items"_err_en_US);
+ }
+ }
+ checkObjects(objects, dirSource, allocSource);
+ }
- dirContext_.pop_back();
inExecutableAllocate_ = false;
+ dirContext_.pop_back();
}
void OmpStructureChecker::Enter(const parser::OpenMPAllocatorsConstruct &x) {
- isPredefinedAllocator = true;
-
- const parser::OmpDirectiveSpecification &dirSpec{x.BeginDir()};
- auto &block{std::get<parser::Block>(x.t)};
+ const parser::OmpDirectiveSpecification &beginSpec{x.BeginDir()};
+ const parser::OmpDirectiveName &dirName{beginSpec.DirName()};
PushContextAndClauseSets(
- dirSpec.DirName().source, llvm::omp::Directive::OMPD_allocators);
+ dirName.source, llvm::omp::Directive::OMPD_allocators);
- if (block.empty()) {
- context_.Say(dirSpec.source,
- "The ALLOCATORS construct should contain a single ALLOCATE statement"_err_en_US);
+ std::vector<const parser::OmpAllocateClause *> allocs;
+ for (const auto &clause : beginSpec.Clauses().v) {
+ auto *alloc{std::get_if<parser::OmpClause::Allocate>(&clause.u)};
+ if (!alloc) {
+ continue;
+ }
+ using OmpAllocatorSimpleModifier = parser::OmpAllocatorSimpleModifier;
+ using OmpAllocatorComplexModifier = parser::OmpAllocatorComplexModifier;
+
+ if (InTargetRegion()) {
+ auto &modifiers{OmpGetModifiers(alloc->v)};
+ bool hasAllocator{
+ OmpGetUniqueModifier<OmpAllocatorSimpleModifier>(modifiers) ||
+ OmpGetUniqueModifier<OmpAllocatorComplexModifier>(modifiers)};
+ bool hasDynAllocators{
+ HasRequires(llvm::omp::Clause::OMPC_dynamic_allocators)};
+ if (!hasAllocator && !hasDynAllocators) {
+ context_.Say(clause.source,
+ "An ALLOCATE clause in a TARGET region must specify an allocator or REQUIRES(DYNAMIC_ALLOCATORS) must be specified"_err_en_US);
+ }
+ }
+ }
+
+ auto &body{std::get<parser::Block>(x.t)};
+ // The parser should put at most one statement in the body.
+ assert(body.size() <= 1 && "Malformed body in allocators");
+ if (body.empty()) {
+ context_.Say(dirName.source,
+ "The body of an ALLOCATORS construct should be an ALLOCATE statement"_err_en_US);
return;
}
- omp::SourcedActionStmt action{omp::GetActionStmt(block)};
- const auto *allocate{
- action ? parser::Unwrap<parser::AllocateStmt>(action.stmt) : nullptr};
-
- if (allocate) {
- for (const auto &clause : dirSpec.Clauses().v) {
- if (auto *alloc{std::get_if<parser::OmpClause::Allocate>(&clause.u)}) {
- CheckAllNamesInAllocateStmt(
- x.source, std::get<parser::OmpObjectList>(alloc->v.t), *allocate);
-
- using OmpAllocatorSimpleModifier = parser::OmpAllocatorSimpleModifier;
- using OmpAllocatorComplexModifier = parser::OmpAllocatorComplexModifier;
-
- auto &modifiers{OmpGetModifiers(alloc->v)};
- bool hasAllocator{
- OmpGetUniqueModifier<OmpAllocatorSimpleModifier>(modifiers) ||
- OmpGetUniqueModifier<OmpAllocatorComplexModifier>(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);
- }
+ auto [allocStmt, allocSource]{getAllocateStmtAndSource(&body.front())};
+ if (!allocStmt) {
+ parser::CharBlock source{[&]() {
+ if (auto &&maybeSource{parser::GetSource(body.front())}) {
+ return *maybeSource;
}
- }
- } else {
- const parser::CharBlock &source = action ? action.source : x.source;
+ return dirName.source;
+ }()};
context_.Say(source,
- "The body of the ALLOCATORS construct should be an ALLOCATE statement"_err_en_US);
+ "The body of an ALLOCATORS construct should be an ALLOCATE statement"_err_en_US);
+ return;
}
- for (const auto &clause : dirSpec.Clauses().v) {
- if (const auto *allocClause{
- parser::Unwrap<parser::OmpClause::Allocate>(clause)}) {
- CheckVarIsNotPartOfAnotherVar(
- dirSpec.source, std::get<parser::OmpObjectList>(allocClause->v.t));
+ UnorderedSymbolSet allocateSyms{GetNonComponentSymbols(*allocStmt)};
+ for (const auto &clause : beginSpec.Clauses().v) {
+ auto *alloc{std::get_if<parser::OmpClause::Allocate>(&clause.u)};
+ if (!alloc) {
+ continue;
+ }
+ for (auto &object : DEREF(GetOmpObjectList(clause)).v) {
+ CheckVarIsNotPartOfAnotherVar(dirName.source, object);
+ if (auto *symbol{GetObjectSymbol(object)}) {
+ if (IsStructureComponent(*symbol)) {
+ continue;
+ }
+ parser::CharBlock source{[&]() {
+ if (auto &&objectSource{GetObjectSource(object)}) {
+ return *objectSource;
+ }
+ return clause.source;
+ }()};
+ if (!IsTypeParamInquiry(*symbol)) {
+ if (auto f{allocateSyms.find(*symbol)}; f == allocateSyms.end()) {
+ context_
+ .Say(source,
+ "A list item in an ALLOCATORS construct must be specified on the associated ALLOCATE statement"_err_en_US)
+ .Attach(allocSource, "The ALLOCATE statement"_en_US);
+ }
+ }
+ }
}
}
}
void OmpStructureChecker::Leave(const parser::OpenMPAllocatorsConstruct &x) {
- const parser::OmpDirectiveSpecification &dirSpec{x.BeginDir()};
-
- for (const auto &clause : dirSpec.Clauses().v) {
- if (const auto *allocClause{
- std::get_if<parser::OmpClause::Allocate>(&clause.u)}) {
- CheckPredefinedAllocatorRestriction(
- dirSpec.source, std::get<parser::OmpObjectList>(allocClause->v.t));
- }
- }
dirContext_.pop_back();
}
diff --git a/flang/lib/Semantics/check-omp-structure.h b/flang/lib/Semantics/check-omp-structure.h
index 7426559e77ff7..6feb1d149c4fd 100644
--- a/flang/lib/Semantics/check-omp-structure.h
+++ b/flang/lib/Semantics/check-omp-structure.h
@@ -325,11 +325,6 @@ class OmpStructureChecker : public OmpStructureCheckerBase {
const std::optional<parser::OmpClauseList> &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);
@@ -353,11 +348,6 @@ class OmpStructureChecker : public OmpStructureCheckerBase {
const parser::OmpObjectList &ompObjectList);
void CheckIfContiguous(const parser::OmpObject &object);
const parser::Name *GetObjectName(const parser::OmpObject &object);
- void CheckPredefinedAllocatorRestriction(const parser::CharBlock &source,
- const parser::OmpObjectList &ompObjectList);
- void CheckPredefinedAllocatorRestriction(
- const parser::CharBlock &source, const parser::Name &name);
- bool isPredefinedAllocator{false};
void CheckAllowedRequiresClause(llvmOmpClause clause);
bool deviceConstructFound_{false};
diff --git a/flang/lib/Semantics/openmp-utils.cpp b/flang/lib/Semantics/openmp-utils.cpp
index 6b304b62ef867..4a40d6eec17bb 100644
--- a/flang/lib/Semantics/openmp-utils.cpp
+++ b/flang/lib/Semantics/openmp-utils.cpp
@@ -186,6 +186,23 @@ bool IsExtendedListItem(const Symbol &sym) {
return IsVariableListItem(sym) || sym.IsSubprogram();
}
+bool IsTypeParamInquiry(const Symbol &sym) {
+ return common::visit( //
+ common::visitors{
+ [&](const MiscDetails &d) {
+ return d.kind() == MiscDetails::Kind::KindParamInquiry ||
+ d.kind() == MiscDetails::Kind::LenParamInquiry;
+ },
+ [&](const TypeParamDetails &s) { return true; },
+ [&](auto &&) { return false; },
+ },
+ sym.details());
+}
+
+bool IsStructureComponent(const Symbol &sym) {
+ return sym.owner().kind() == Scope::Kind::DerivedType;
+}
+
bool IsVarOrFunctionRef(const MaybeExpr &expr) {
if (expr) {
return evaluate::UnwrapProcedureRef(*expr) != nullptr ||
diff --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp
index 628068f9a9f68..03c8cb0065fd8 100644
--- a/flang/lib/Semantics/resolve-directives.cpp
+++ b/flang/lib/Semantics/resolve-directives.cpp
@@ -2560,8 +2560,9 @@ bool OmpAttributeVisitor::Pre(const parser::OpenMPThreadprivate &x) {
bool OmpAttributeVisitor::Pre(const parser::OpenMPDeclarativeAllocate &x) {
PushContext(x.source, llvm::omp::Directive::OMPD_allocate);
- const auto &list{std::get<parser::OmpObjectList>(x.t)};
- ResolveOmpObjectList(list, Symbol::Flag::OmpDeclarativeAllocateDirective);
+ if (const auto &list{std::get<std::optional<parser::OmpObjectList>>(x.t)}) {
+ ResolveOmpObjectList(*list, Symbol::Flag::OmpDeclarativeAllocateDirective);
+ }
return false;
}
diff --git a/flang/test/Semantics/OpenMP/allocate08.f90 b/flang/test/Semantics/OpenMP/allocate08.f90
index f4f11e229a28b..3f59493713213 100644
--- a/flang/test/Semantics/OpenMP/allocate08.f90
+++ b/flang/test/Semantics/OpenMP/allocate08.f90
@@ -1,11 +1,11 @@
! REQUIRES: openmp_runtime
-! RUN: %python %S/../test_errors.py %s %flang_fc1 %openmp_flags
-! OpenMP Version 5.0
+! RUN: %python %S/../test_errors.py %s %flang_fc1 %openmp_flags -fopenmp-version=51
+! OpenMP Version 5.1
! 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
+! common block name, then only predefined memory allocator parameters can be
+! used in the allocator clause
module AllocateModule
INTEGER :: z
diff --git a/flang/test/Semantics/OpenMP/allocate09.f90 b/flang/test/Semantics/OpenMP/allocate09.f90
index 0f93a340fe1e4..8b8d07ccd0be8 100644
--- a/flang/test/Semantics/OpenMP/allocate09.f90
+++ b/flang/test/Semantics/OpenMP/allocate09.f90
@@ -23,11 +23,11 @@ subroutine allocate()
!$omp allocate
allocate(e(5), f(6), g(7))
- !ERROR: Object 'i' in ALLOCATE directive not found in corresponding ALLOCATE statement
+ !ERROR: A list item on an executable ALLOCATE must be specified on the associated ALLOCATE statement
!$omp allocate(h, i) allocator(omp_default_mem_alloc)
allocate(h(8))
- !ERROR: Object 'j' in ALLOCATE directive not found in corresponding ALLOCATE statement
+ !ERROR: A list item on an executable ALLOCATE must be specified on the associated ALLOCATE statement
!$omp allocate(j, k) allocator(omp_default_mem_alloc)
!$omp allocate(l) allocator(omp_default_mem_alloc)
allocate(k(9), l(10))
diff --git a/flang/test/Semantics/OpenMP/allocate10.f90 b/flang/test/Semantics/OpenMP/allocate10.f90
new file mode 100644
index 0000000000000..a9db7330296ba
--- /dev/null
+++ b/flang/test/Semantics/OpenMP/allocate10.f90
@@ -0,0 +1,11 @@
+!RUN: %python %S/../test_errors.py %s %flang_fc1 %openmp_flags -fopenmp-version=51
+
+subroutine f00
+ integer, allocatable :: x, y
+
+ continue
+ !ERROR: If multiple directives are present in an executable ALLOCATE directive, at most one of them may specify no list items
+ !$omp allocate
+ !$omp allocate
+ allocate(x, y)
+end
diff --git a/flang/test/Semantics/OpenMP/allocate11.f90 b/flang/test/Semantics/OpenMP/allocate11.f90
new file mode 100644
index 0000000000000..89beaa0450169
--- /dev/null
+++ b/flang/test/Semantics/OpenMP/allocate11.f90
@@ -0,0 +1,27 @@
+! REQUIRES: openmp_runtime
+
+! RUN: %python %S/../test_errors.py %s %flang_fc1 %openmp_flags -fopenmp-version=50
+! 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
+
+module AllocateModule
+ INTEGER :: z
+ !ERROR: If a list item is a named common block, has SAVE attribute or is declared in the scope of a module, an ALLOCATOR clause must be present with a predefined allocator
+ !$omp allocate(z)
+end module
+
+subroutine allocate(custom_allocator)
+use omp_lib
+use AllocateModule
+ integer, SAVE :: x
+ integer :: w
+ COMMON /CommonName/ y
+
+ integer(kind=omp_allocator_handle_kind) :: custom_allocator
+
+ !ERROR: If a list item is a named common block, has SAVE attribute or is declared in the scope of a module, an ALLOCATOR clause must be present with a predefined allocator
+ !$omp allocate(x)
+end subroutine allocate
diff --git a/flang/test/Semantics/OpenMP/allocators01.f90 b/flang/test/Semantics/OpenMP/allocators01.f90
index ff92fa3b23463..a3342063e25f2 100644
--- a/flang/test/Semantics/OpenMP/allocators01.f90
+++ b/flang/test/Semantics/OpenMP/allocators01.f90
@@ -16,7 +16,7 @@ subroutine allocate()
allocate(arr3(3), arr4(4, 4))
!$omp end allocators
- !ERROR: Object 'arr1' in ALLOCATORS directive not found in corresponding ALLOCATE statement
+ !ERROR: A list item in an ALLOCATORS construct must be specified on the associated ALLOCATE statement
!$omp allocators allocate(omp_default_mem_alloc: arr1, arr2)
allocate(arr2(2, 2))
diff --git a/flang/test/Semantics/OpenMP/allocators04.f90 b/flang/test/Semantics/OpenMP/allocators04.f90
deleted file mode 100644
index 212e48fbd1b26..0000000000000
--- a/flang/test/Semantics/OpenMP/allocators04.f90
+++ /dev/null
@@ -1,31 +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
-! 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
-! SAVE and common block names can't be declared as allocatable, only module scope variables are tested
-
-module AllocateModule
- integer, allocatable :: a, b
-end module
-
-subroutine allocate()
- use omp_lib
- use AllocateModule
-
- integer(kind=omp_allocator_handle_kind) :: custom_allocator
- type(omp_alloctrait) :: trait(1)
-
- trait(1)%key = fallback
- trait(1)%value = default_mem_fb
- custom_allocator = omp_init_allocator(omp_default_mem_space, 1, trait)
-
- !$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
- !$omp allocators allocate(custom_allocator: b)
- allocate(b)
-end subroutine
diff --git a/flang/test/Semantics/OpenMP/allocators05.f90 b/flang/test/Semantics/OpenMP/allocators05.f90
index efacdfaec7647..f49182f128e74 100644
--- a/flang/test/Semantics/OpenMP/allocators05.f90
+++ b/flang/test/Semantics/OpenMP/allocators05.f90
@@ -17,7 +17,7 @@ subroutine allocate()
!$omp target private(a, b)
!$omp allocators allocate(omp_default_mem_alloc: a)
allocate(a(LEN))
- !ERROR: ALLOCATORS directives that appear in a TARGET region must specify an allocator
+ !ERROR: An ALLOCATE clause in a TARGET region must specify an allocator or REQUIRES(DYNAMIC_ALLOCATORS) must be specified
!$omp allocators allocate(b)
allocate(b(LEN))
!$omp end target
diff --git a/flang/test/Semantics/OpenMP/allocators07.f90 b/flang/test/Semantics/OpenMP/allocators07.f90
index a28f706965cb1..baaacee8b691e 100644
--- a/flang/test/Semantics/OpenMP/allocators07.f90
+++ b/flang/test/Semantics/OpenMP/allocators07.f90
@@ -5,7 +5,7 @@ subroutine f00
integer, allocatable :: a(:)
!$omp allocators allocate(a)
-!ERROR: The body of the ALLOCATORS construct should be an ALLOCATE statement
+!ERROR: The body of an ALLOCATORS construct should be an ALLOCATE statement
continue
end
@@ -13,7 +13,7 @@ subroutine f01
implicit none
integer, allocatable :: a(:)
-!ERROR: The ALLOCATORS construct should contain a single ALLOCATE statement
+!ERROR: The body of an ALLOCATORS construct should be an ALLOCATE statement
!$omp allocators allocate(a)
!$omp end allocators
end
@@ -22,6 +22,6 @@ subroutine f02
implicit none
integer, allocatable :: a(:)
-!ERROR: The ALLOCATORS construct should contain a single ALLOCATE statement
+!ERROR: The body of an ALLOCATORS construct should be an ALLOCATE statement
!$omp allocators allocate(a)
end
>From ed75ae6abef64dc248ba2835f5acc19a4f6c8862 Mon Sep 17 00:00:00 2001
From: Krzysztof Parzyszek <Krzysztof.Parzyszek at amd.com>
Date: Thu, 30 Oct 2025 10:09:09 -0500
Subject: [PATCH 2/2] Remove unused variable
---
flang/lib/Semantics/check-omp-structure.cpp | 1 -
1 file changed, 1 deletion(-)
diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index ece179c4a66fc..3ea8e5b8cd2b0 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -2247,7 +2247,6 @@ void OmpStructureChecker::Enter(const parser::OpenMPAllocatorsConstruct &x) {
PushContextAndClauseSets(
dirName.source, llvm::omp::Directive::OMPD_allocators);
- std::vector<const parser::OmpAllocateClause *> allocs;
for (const auto &clause : beginSpec.Clauses().v) {
auto *alloc{std::get_if<parser::OmpClause::Allocate>(&clause.u)};
if (!alloc) {
More information about the flang-commits
mailing list