[flang-commits] [flang] [flang][OpenMP] Use OmpDirectiveSpecification in ALLOCATE (PR #165865)
Krzysztof Parzyszek via flang-commits
flang-commits at lists.llvm.org
Mon Nov 3 05:18:36 PST 2025
https://github.com/kparzysz updated https://github.com/llvm/llvm-project/pull/165865
>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/7] [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/7] 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) {
>From b3a69f5dabb6e8d6801b47eeb0b9de9023fcda2e Mon Sep 17 00:00:00 2001
From: Krzysztof Parzyszek <Krzysztof.Parzyszek at amd.com>
Date: Thu, 25 Sep 2025 13:34:22 -0500
Subject: [PATCH 3/7] [flang][OpenMP] Use OmpDirectiveSpecification in ALLOCATE
The ALLOCATE directive has two forms:
- A declarative form with a standalone directive:
!$OMP ALLOCATE (variable-list-item...)
- An executable form that consists of several diretives followed by an
ALLOCATE statement:
!$OMP ALLOCATE (variable-list-item...)
!$OMP ALLOCATE (variable-list-item...)
...
ALLOCATE (...)
The second form was deprecated in OpenMP 5.2 in favor of the ALLOCATORS
construct.
Since in the parse tree every type corresponding to a directive only
corresponds to a single directive, the executable form is represented by
a sequence of nested OmpAlocateDirectives, e.g.
!$OMP ALLOCATE(x)
!$OMP ALLOCATE(y)
ALLOCATE(x, y)
will become
OmpAllocateDirective
|- ALLOCATE(x) // begin directive
`- OmpAllocateDirective // block
|- ALLOCATE(y) // begin directive
`- ALLOCATE(x, y) // block
With this change all AST nodes for directives use OmpDirectiveSpecification
as the directive representation.
---
flang/examples/FeatureList/FeatureList.cpp | 3 +-
flang/include/flang/Parser/dump-parse-tree.h | 3 +-
flang/include/flang/Parser/openmp-utils.h | 31 +-
flang/include/flang/Parser/parse-tree.h | 56 ++--
flang/lib/Lower/OpenMP/OpenMP.cpp | 12 +-
flang/lib/Parser/openmp-parsers.cpp | 46 +--
flang/lib/Parser/openmp-utils.cpp | 39 +++
flang/lib/Parser/unparse.cpp | 28 +-
flang/lib/Semantics/canonicalize-omp.cpp | 156 ++++++++--
flang/lib/Semantics/check-omp-structure.cpp | 292 +++++++++---------
flang/lib/Semantics/check-omp-structure.h | 27 +-
flang/lib/Semantics/resolve-directives.cpp | 58 ++--
flang/lib/Semantics/resolve-names.cpp | 4 +-
.../Todo/omp-declarative-allocate-align.f90 | 2 +-
.../OpenMP/Todo/omp-declarative-allocate.f90 | 2 +-
.../Parser/OpenMP/allocate-align-tree.f90 | 48 +--
.../Parser/OpenMP/allocate-tree-spec-part.f90 | 63 ++--
flang/test/Parser/OpenMP/allocate-tree.f90 | 80 ++---
flang/test/Parser/OpenMP/allocate-unparse.f90 | 18 +-
.../Semantics/OpenMP/allocate-align01.f90 | 2 +-
.../Semantics/OpenMP/allocate-directive.f90 | 2 +-
flang/test/Semantics/OpenMP/allocate01.f90 | 2 +-
flang/test/Semantics/OpenMP/allocate02.f90 | 1 +
flang/test/Semantics/OpenMP/allocate03.f90 | 1 +
flang/test/Semantics/OpenMP/allocate06.f90 | 2 +-
flang/test/Semantics/OpenMP/allocate10.f90 | 2 +-
flang/test/Semantics/OpenMP/allocate12.f90 | 16 +
27 files changed, 585 insertions(+), 411 deletions(-)
create mode 100644 flang/test/Semantics/OpenMP/allocate12.f90
diff --git a/flang/examples/FeatureList/FeatureList.cpp b/flang/examples/FeatureList/FeatureList.cpp
index 225a6558ef956..ef58da61e371b 100644
--- a/flang/examples/FeatureList/FeatureList.cpp
+++ b/flang/examples/FeatureList/FeatureList.cpp
@@ -445,6 +445,7 @@ struct NodeVisitor {
READ_FEATURE(ObjectDecl)
READ_FEATURE(OldParameterStmt)
READ_FEATURE(OmpAlignedClause)
+ READ_FEATURE(OmpAllocateDirective)
READ_FEATURE(OmpBeginDirective)
READ_FEATURE(OmpBeginLoopDirective)
READ_FEATURE(OmpBeginSectionsDirective)
@@ -541,7 +542,6 @@ struct NodeVisitor {
READ_FEATURE(OpenMPCancellationPointConstruct)
READ_FEATURE(OpenMPConstruct)
READ_FEATURE(OpenMPCriticalConstruct)
- READ_FEATURE(OpenMPDeclarativeAllocate)
READ_FEATURE(OpenMPDeclarativeConstruct)
READ_FEATURE(OpenMPDeclareReductionConstruct)
READ_FEATURE(OpenMPDeclareSimdConstruct)
@@ -550,7 +550,6 @@ struct NodeVisitor {
READ_FEATURE(OmpAtomicDefaultMemOrderClause)
READ_FEATURE(OpenMPFlushConstruct)
READ_FEATURE(OpenMPLoopConstruct)
- READ_FEATURE(OpenMPExecutableAllocate)
READ_FEATURE(OpenMPAllocatorsConstruct)
READ_FEATURE(OpenMPRequiresConstruct)
READ_FEATURE(OpenMPSimpleStandaloneConstruct)
diff --git a/flang/include/flang/Parser/dump-parse-tree.h b/flang/include/flang/Parser/dump-parse-tree.h
index a7398a4ef970f..de2716410d6cd 100644
--- a/flang/include/flang/Parser/dump-parse-tree.h
+++ b/flang/include/flang/Parser/dump-parse-tree.h
@@ -512,6 +512,7 @@ class ParseTreeDumper {
NODE(parser, OmpAlignModifier)
NODE(parser, OmpAllocateClause)
NODE(OmpAllocateClause, Modifier)
+ NODE(parser, OmpAllocateDirective)
NODE(parser, OmpAllocatorComplexModifier)
NODE(parser, OmpAllocatorSimpleModifier)
NODE(parser, OmpAlwaysModifier)
@@ -739,7 +740,6 @@ class ParseTreeDumper {
NODE(parser, OpenMPCancellationPointConstruct)
NODE(parser, OpenMPConstruct)
NODE(parser, OpenMPCriticalConstruct)
- NODE(parser, OpenMPDeclarativeAllocate)
NODE(parser, OpenMPDeclarativeAssumes)
NODE(parser, OpenMPDeclarativeConstruct)
NODE(parser, OpenMPDeclareMapperConstruct)
@@ -748,7 +748,6 @@ class ParseTreeDumper {
NODE(parser, OpenMPDeclareTargetConstruct)
NODE(parser, OpenMPDepobjConstruct)
NODE(parser, OpenMPDispatchConstruct)
- NODE(parser, OpenMPExecutableAllocate)
NODE(parser, OpenMPFlushConstruct)
NODE(parser, OpenMPGroupprivate)
NODE(parser, OpenMPLoopConstruct)
diff --git a/flang/include/flang/Parser/openmp-utils.h b/flang/include/flang/Parser/openmp-utils.h
index 49db091af93a7..8fa4a84aff06d 100644
--- a/flang/include/flang/Parser/openmp-utils.h
+++ b/flang/include/flang/Parser/openmp-utils.h
@@ -22,6 +22,7 @@
#include <type_traits>
#include <utility>
#include <variant>
+#include <vector>
namespace Fortran::parser::omp {
@@ -33,23 +34,6 @@ template <typename T> constexpr auto addr_if(const std::optional<T> &x) {
}
namespace detail {
-using D = llvm::omp::Directive;
-
-template <typename Construct> //
-struct ConstructId {
- static constexpr llvm::omp::Directive id{D::OMPD_unknown};
-};
-
-#define MAKE_CONSTR_ID(Construct, Id) \
- template <> struct ConstructId<Construct> { \
- static constexpr llvm::omp::Directive id{Id}; \
- }
-
-MAKE_CONSTR_ID(OpenMPDeclarativeAllocate, D::OMPD_allocate);
-MAKE_CONSTR_ID(OpenMPExecutableAllocate, D::OMPD_allocate);
-
-#undef MAKE_CONSTR_ID
-
struct DirectiveNameScope {
static OmpDirectiveName MakeName(CharBlock source = {},
llvm::omp::Directive id = llvm::omp::Directive::OMPD_unknown) {
@@ -97,9 +81,6 @@ struct DirectiveNameScope {
} else if constexpr (TupleTrait<T>) {
if constexpr (std::is_base_of_v<OmpBlockConstruct, T>) {
return std::get<OmpBeginDirective>(x.t).DirName();
- } else if constexpr (std::is_same_v<T, OpenMPDeclarativeAllocate> ||
- std::is_same_v<T, OpenMPExecutableAllocate>) {
- return MakeName(std::get<Verbatim>(x.t).source, ConstructId<T>::id);
} else {
return GetFromTuple(
x.t, std::make_index_sequence<std::tuple_size_v<decltype(x.t)>>{});
@@ -139,6 +120,9 @@ template <typename T> OmpDirectiveName GetOmpDirectiveName(const T &x) {
return detail::DirectiveNameScope::GetOmpDirectiveName(x);
}
+const OpenMPDeclarativeConstruct *GetOmp(const DeclarationConstruct &x);
+const OpenMPConstruct *GetOmp(const ExecutionPartConstruct &x);
+
const OmpObjectList *GetOmpObjectList(const OmpClause &clause);
template <typename T>
@@ -158,6 +142,13 @@ const OmpCombinerExpression *GetCombinerExpr(
const OmpReductionSpecifier &rspec);
const OmpInitializerExpression *GetInitializerExpr(const OmpClause &init);
+struct OmpAllocateInfo {
+ std::vector<const OmpAllocateDirective *> dirs;
+ const ExecutionPartConstruct *body{nullptr};
+};
+
+OmpAllocateInfo SplitOmpAllocate(const OmpAllocateDirective &x);
+
} // namespace Fortran::parser::omp
#endif // FORTRAN_PARSER_OPENMP_UTILS_H
diff --git a/flang/include/flang/Parser/parse-tree.h b/flang/include/flang/Parser/parse-tree.h
index 4dd5e84f60dfe..8c7578f7a1941 100644
--- a/flang/include/flang/Parser/parse-tree.h
+++ b/flang/include/flang/Parser/parse-tree.h
@@ -5151,17 +5151,42 @@ struct OpenMPThreadprivate {
CharBlock source;
};
-// 2.11.3 allocate -> ALLOCATE (variable-name-list) [clause]
-struct OpenMPDeclarativeAllocate {
- TUPLE_CLASS_BOILERPLATE(OpenMPDeclarativeAllocate);
- CharBlock source;
- std::tuple<Verbatim, std::optional<OmpObjectList>, OmpClauseList> t;
+// Ref: [4.5:310-312], [5.0:156-158], [5.1:181-184], [5.2:176-177],
+// [6.0:310-312]
+//
+// allocate-directive ->
+// ALLOCATE (variable-list-item...) | // since 4.5
+// ALLOCATE (variable-list-item...) // since 5.0, until 5.1
+// ...
+// allocate-stmt
+//
+// The first form is the "declarative-allocate", and is a declarative
+// directive. The second is the "executable-allocate" and is an executable
+// directive. The executable form was deprecated in 5.2.
+//
+// The executable-allocate consists of several ALLOCATE directives. Since
+// in the parse tree every type corresponding to a directive only corresponds
+// to a single directive, the executable form is represented by a sequence
+// of nested OmpAlocateDirectives, e.g.
+// !$OMP ALLOCATE(x)
+// !$OMP ALLOCATE(y)
+// ALLOCATE(x, y)
+// will become
+// OmpAllocateDirective
+// |- ALLOCATE(x) // begin directive
+// `- OmpAllocateDirective // block
+// |- ALLOCATE(y) // begin directive
+// `- ALLOCATE(x, y) // block
+//
+// The block in the declarative-allocate will be empty.
+struct OmpAllocateDirective : public OmpBlockConstruct {
+ INHERITED_TUPLE_CLASS_BOILERPLATE(OmpAllocateDirective, OmpBlockConstruct);
};
struct OpenMPDeclarativeConstruct {
UNION_CLASS_BOILERPLATE(OpenMPDeclarativeConstruct);
CharBlock source;
- std::variant<OpenMPDeclarativeAllocate, OpenMPDeclarativeAssumes,
+ std::variant<OmpAllocateDirective, OpenMPDeclarativeAssumes,
OpenMPDeclareMapperConstruct, OpenMPDeclareReductionConstruct,
OpenMPDeclareSimdConstruct, OpenMPDeclareTargetConstruct,
OmpDeclareVariantDirective, OpenMPGroupprivate, OpenMPThreadprivate,
@@ -5174,19 +5199,6 @@ struct OpenMPCriticalConstruct : public OmpBlockConstruct {
INHERITED_TUPLE_CLASS_BOILERPLATE(OpenMPCriticalConstruct, OmpBlockConstruct);
};
-// 2.11.3 allocate -> ALLOCATE [(variable-name-list)] [clause]
-// [ALLOCATE (variable-name-list) [clause] [...]]
-// allocate-statement
-// clause -> allocator-clause
-struct OpenMPExecutableAllocate {
- TUPLE_CLASS_BOILERPLATE(OpenMPExecutableAllocate);
- CharBlock source;
- std::tuple<Verbatim, std::optional<OmpObjectList>, OmpClauseList,
- std::optional<std::list<OpenMPDeclarativeAllocate>>,
- Statement<AllocateStmt>>
- t;
-};
-
// Ref: [5.2:180-181], [6.0:315]
//
// allocators-construct ->
@@ -5342,9 +5354,9 @@ struct OpenMPConstruct {
UNION_CLASS_BOILERPLATE(OpenMPConstruct);
std::variant<OpenMPStandaloneConstruct, OpenMPSectionsConstruct,
OpenMPSectionConstruct, OpenMPLoopConstruct, OmpBlockConstruct,
- OpenMPAtomicConstruct, OpenMPDeclarativeAllocate, OpenMPDispatchConstruct,
- OpenMPUtilityConstruct, OpenMPExecutableAllocate,
- OpenMPAllocatorsConstruct, OpenMPAssumeConstruct, OpenMPCriticalConstruct>
+ OpenMPAtomicConstruct, OmpAllocateDirective, OpenMPDispatchConstruct,
+ OpenMPUtilityConstruct, OpenMPAllocatorsConstruct, OpenMPAssumeConstruct,
+ OpenMPCriticalConstruct>
u;
};
diff --git a/flang/lib/Lower/OpenMP/OpenMP.cpp b/flang/lib/Lower/OpenMP/OpenMP.cpp
index 71067283d13f7..b901f24ae366e 100644
--- a/flang/lib/Lower/OpenMP/OpenMP.cpp
+++ b/flang/lib/Lower/OpenMP/OpenMP.cpp
@@ -3506,9 +3506,9 @@ static void genOMP(lower::AbstractConverter &converter, lower::SymMap &symTable,
static void
genOMP(lower::AbstractConverter &converter, lower::SymMap &symTable,
semantics::SemanticsContext &semaCtx, lower::pft::Evaluation &eval,
- const parser::OpenMPDeclarativeAllocate &declarativeAllocate) {
+ const parser::OmpAllocateDirective &allocate) {
if (!semaCtx.langOptions().OpenMPSimd)
- TODO(converter.getCurrentLocation(), "OpenMPDeclarativeAllocate");
+ TODO(converter.getCurrentLocation(), "OmpAllocateDirective");
}
static void genOMP(lower::AbstractConverter &converter, lower::SymMap &symTable,
@@ -3899,14 +3899,6 @@ static void genOMP(lower::AbstractConverter &converter, lower::SymMap &symTable,
TODO(converter.getCurrentLocation(), "OpenMPDispatchConstruct");
}
-static void genOMP(lower::AbstractConverter &converter, lower::SymMap &symTable,
- semantics::SemanticsContext &semaCtx,
- lower::pft::Evaluation &eval,
- const parser::OpenMPExecutableAllocate &execAllocConstruct) {
- if (!semaCtx.langOptions().OpenMPSimd)
- TODO(converter.getCurrentLocation(), "OpenMPExecutableAllocate");
-}
-
static void genOMP(lower::AbstractConverter &converter, lower::SymMap &symTable,
semantics::SemanticsContext &semaCtx,
lower::pft::Evaluation &eval,
diff --git a/flang/lib/Parser/openmp-parsers.cpp b/flang/lib/Parser/openmp-parsers.cpp
index a9de26ea09ff8..4374acbbe51bf 100644
--- a/flang/lib/Parser/openmp-parsers.cpp
+++ b/flang/lib/Parser/openmp-parsers.cpp
@@ -1778,6 +1778,31 @@ struct OmpBlockConstructParser {
llvm::omp::Directive dir_;
};
+struct OmpDeclarativeAllocateParser {
+ using resultType = OmpAllocateDirective;
+
+ std::optional<resultType> Parse(ParseState &state) const {
+ constexpr llvm::omp::Directive dir{llvm::omp::Directive::OMPD_allocate};
+ if (auto &&begin{attempt(OmpBeginDirectiveParser(dir)).Parse(state)}) {
+ Block empty;
+ auto end{maybe(OmpEndDirectiveParser{dir}).Parse(state)};
+ return OmpAllocateDirective{std::move(*begin), std::move(empty),
+ llvm::transformOptional(std::move(*end),
+ [](auto &&s) { return OmpEndDirective(std::move(s)); })};
+ }
+ return std::nullopt;
+ }
+};
+
+struct OmpExecutableAllocateParser {
+ using resultType = OmpAllocateDirective;
+
+ std::optional<resultType> Parse(ParseState &state) const {
+ OmpStatementConstructParser p{llvm::omp::Directive::OMPD_allocate};
+ return construct<OmpAllocateDirective>(p).Parse(state);
+ }
+};
+
TYPE_PARSER(sourced(construct<OpenMPAllocatorsConstruct>(
OmpStatementConstructParser{llvm::omp::Directive::OMPD_allocators})))
@@ -2044,14 +2069,6 @@ TYPE_PARSER(construct<OmpInitializerExpression>(OmpStylizedExpressionParser{}))
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(startOmpLine >> Parser<OpenMPDeclarativeAllocate>{})) /
- endOmpLine,
- statement(allocateStmt))))
-
// 2.8.2 Declare Simd construct
TYPE_PARSER(sourced(construct<OpenMPDeclareSimdConstruct>(
predicated(Parser<OmpDirectiveName>{},
@@ -2077,13 +2094,6 @@ TYPE_PARSER(sourced( //
IsDirective(llvm::omp::Directive::OMPD_threadprivate)) >=
Parser<OmpDirectiveSpecification>{})))
-// 2.11.3 Declarative Allocate directive
-TYPE_PARSER(
- sourced(construct<OpenMPDeclarativeAllocate>(verbatim("ALLOCATE"_tok),
- maybe(parenthesized(Parser<OmpObjectList>{})),
- Parser<OmpClauseList>{})) /
- lookAhead(endOmpLine / !statement(allocateStmt)))
-
// Assumes Construct
TYPE_PARSER(sourced(construct<OpenMPDeclarativeAssumes>(
predicated(OmpDirectiveNameParser{},
@@ -2106,7 +2116,7 @@ TYPE_PARSER(
construct<OpenMPDeclarativeConstruct>(
Parser<OmpDeclareVariantDirective>{}) ||
construct<OpenMPDeclarativeConstruct>(
- Parser<OpenMPDeclarativeAllocate>{}) ||
+ sourced(OmpDeclarativeAllocateParser{})) ||
construct<OpenMPDeclarativeConstruct>(
Parser<OpenMPGroupprivate>{}) ||
construct<OpenMPDeclarativeConstruct>(
@@ -2194,6 +2204,8 @@ TYPE_CONTEXT_PARSER("OpenMP construct"_en_US,
withMessage("expected OpenMP construct"_err_en_US,
first(construct<OpenMPConstruct>(Parser<OpenMPSectionsConstruct>{}),
construct<OpenMPConstruct>(Parser<OpenMPLoopConstruct>{}),
+ construct<OpenMPConstruct>(
+ sourced(OmpExecutableAllocateParser{})),
construct<OpenMPConstruct>(Parser<OmpBlockConstruct>{}),
// OmpBlockConstruct is attempted before
// OpenMPStandaloneConstruct to resolve !$OMP ORDERED
@@ -2201,9 +2213,7 @@ TYPE_CONTEXT_PARSER("OpenMP construct"_en_US,
construct<OpenMPConstruct>(Parser<OpenMPAtomicConstruct>{}),
construct<OpenMPConstruct>(Parser<OpenMPUtilityConstruct>{}),
construct<OpenMPConstruct>(Parser<OpenMPDispatchConstruct>{}),
- construct<OpenMPConstruct>(Parser<OpenMPExecutableAllocate>{}),
construct<OpenMPConstruct>(Parser<OpenMPAllocatorsConstruct>{}),
- construct<OpenMPConstruct>(Parser<OpenMPDeclarativeAllocate>{}),
construct<OpenMPConstruct>(Parser<OpenMPAssumeConstruct>{}),
construct<OpenMPConstruct>(Parser<OpenMPCriticalConstruct>{}))))
diff --git a/flang/lib/Parser/openmp-utils.cpp b/flang/lib/Parser/openmp-utils.cpp
index 95ad3f60770f5..b9d3763cdd06d 100644
--- a/flang/lib/Parser/openmp-utils.cpp
+++ b/flang/lib/Parser/openmp-utils.cpp
@@ -22,6 +22,25 @@
namespace Fortran::parser::omp {
+const OpenMPDeclarativeConstruct *GetOmp(const DeclarationConstruct &x) {
+ if (auto *y = std::get_if<SpecificationConstruct>(&x.u)) {
+ if (auto *z{std::get_if<common::Indirection<OpenMPDeclarativeConstruct>>(
+ &y->u)}) {
+ return &z->value();
+ }
+ }
+ return nullptr;
+}
+
+const OpenMPConstruct *GetOmp(const ExecutionPartConstruct &x) {
+ if (auto *y{std::get_if<ExecutableConstruct>(&x.u)}) {
+ if (auto *z{std::get_if<common::Indirection<OpenMPConstruct>>(&y->u)}) {
+ return &z->value();
+ }
+ }
+ return nullptr;
+}
+
const OmpObjectList *GetOmpObjectList(const OmpClause &clause) {
// Clauses with OmpObjectList as its data member
using MemberObjectListClauses = std::tuple<OmpClause::Copyin,
@@ -86,4 +105,24 @@ const OmpInitializerExpression *GetInitializerExpr(const OmpClause &init) {
return nullptr;
}
+static void SplitOmpAllocateHelper(
+ OmpAllocateInfo &n, const OmpAllocateDirective &x) {
+ n.dirs.push_back(&x);
+ const Block &body{std::get<Block>(x.t)};
+ if (!body.empty()) {
+ if (auto *omp{GetOmp(body.front())}) {
+ if (auto *ad{std::get_if<OmpAllocateDirective>(&omp->u)}) {
+ return SplitOmpAllocateHelper(n, *ad);
+ }
+ }
+ n.body = &body.front();
+ }
+}
+
+OmpAllocateInfo SplitOmpAllocate(const OmpAllocateDirective &x) {
+ OmpAllocateInfo info;
+ SplitOmpAllocateHelper(info, x);
+ return info;
+}
+
} // namespace Fortran::parser::omp
diff --git a/flang/lib/Parser/unparse.cpp b/flang/lib/Parser/unparse.cpp
index b3a395c4d72e1..84123030195e9 100644
--- a/flang/lib/Parser/unparse.cpp
+++ b/flang/lib/Parser/unparse.cpp
@@ -2482,32 +2482,8 @@ class UnparseVisitor {
Unparse(static_cast<const OmpBlockConstruct &>(x));
}
- void Unparse(const OpenMPExecutableAllocate &x) {
- const auto &fields =
- std::get<std::optional<std::list<parser::OpenMPDeclarativeAllocate>>>(
- x.t);
- if (fields) {
- for (const auto &decl : *fields) {
- Walk(decl);
- }
- }
- BeginOpenMP();
- Word("!$OMP ALLOCATE");
- Walk(" (", std::get<std::optional<OmpObjectList>>(x.t), ")");
- Walk(std::get<OmpClauseList>(x.t));
- Put("\n");
- EndOpenMP();
- Walk(std::get<Statement<AllocateStmt>>(x.t));
- }
- void Unparse(const OpenMPDeclarativeAllocate &x) {
- BeginOpenMP();
- Word("!$OMP ALLOCATE");
- Put(" (");
- Walk(std::get<std::optional<OmpObjectList>>(x.t));
- Put(")");
- Walk(std::get<OmpClauseList>(x.t));
- Put("\n");
- EndOpenMP();
+ void Unparse(const OmpAllocateDirective &x) {
+ Unparse(static_cast<const OmpBlockConstruct &>(x));
}
void Unparse(const OpenMPAllocatorsConstruct &x) {
Unparse(static_cast<const OmpBlockConstruct &>(x));
diff --git a/flang/lib/Semantics/canonicalize-omp.cpp b/flang/lib/Semantics/canonicalize-omp.cpp
index c884658bf464a..039dd7f564758 100644
--- a/flang/lib/Semantics/canonicalize-omp.cpp
+++ b/flang/lib/Semantics/canonicalize-omp.cpp
@@ -51,8 +51,6 @@ class CanonicalizationOfOmp {
} // Block list
}
- void Post(parser::ExecutionPart &body) { RewriteOmpAllocations(body); }
-
// Pre-visit all constructs that have both a specification part and
// an execution part, and store the connection between the two.
bool Pre(parser::BlockConstruct &x) {
@@ -88,6 +86,7 @@ class CanonicalizationOfOmp {
void Post(parser::SpecificationPart &spec) {
CanonicalizeUtilityConstructs(spec);
+ CanonicalizeAllocateDirectives(spec);
}
void Post(parser::OmpMapClause &map) { CanonicalizeMapModifiers(map); }
@@ -239,33 +238,138 @@ class CanonicalizationOfOmp {
}
}
- void RewriteOmpAllocations(parser::ExecutionPart &body) {
- // Rewrite leading declarative allocations so they are nested
- // within their respective executable allocate directive
- //
- // Original:
- // ExecutionPartConstruct -> OpenMPDeclarativeAllocate
- // ExecutionPartConstruct -> OpenMPDeclarativeAllocate
- // ExecutionPartConstruct -> OpenMPExecutableAllocate
- //
- // After rewriting:
- // ExecutionPartConstruct -> OpenMPExecutableAllocate
- // ExecutionPartConstruct -> OpenMPDeclarativeAllocate
- // ExecutionPartConstruct -> OpenMPDeclarativeAllocate
- for (auto it = body.v.rbegin(); it != body.v.rend();) {
- if (auto *exec = GetOmpIf<parser::OpenMPExecutableAllocate>(*(it++))) {
- parser::OpenMPDeclarativeAllocate *decl;
- std::list<parser::OpenMPDeclarativeAllocate> subAllocates;
- while (it != body.v.rend() &&
- (decl = GetOmpIf<parser::OpenMPDeclarativeAllocate>(*it))) {
- subAllocates.push_front(std::move(*decl));
- it = decltype(it)(body.v.erase(std::next(it).base()));
+ // Canonicalization of allocate directives
+ //
+ // In OpenMP 5.0 and 5.1 the allocate directive could either be a declarative
+ // one or an executable one. As usual in such cases, this poses a problem
+ // when the directive appears at the boundary between the specification part
+ // and the execution part.
+ // The executable form can actually consist of several adjacent directives,
+ // whereas the declarative form is always standalone. Additionally, the
+ // executable form must be associated with an allocate statement.
+ //
+ // The parser tries to parse declarative statements first, so in the
+ // following case, the two directives will be declarative, even though
+ // they should be treated as a single executable form:
+ // integer, allocatable :: x, y ! Specification
+ // !$omp allocate(x)
+ // !$omp allocate(y)
+ // allocate(x, y) ! Execution
+ //
+ void CanonicalizeAllocateDirectives(parser::SpecificationPart &spec) {
+ auto found = blockForSpec_.find(&spec);
+ if (found == blockForSpec_.end()) {
+ // There is no corresponding execution part, so there is nothing to do.
+ return;
+ }
+ parser::Block &block = *found->second;
+
+ auto isAllocateStmt = [](const parser::ExecutionPartConstruct &epc) {
+ if (auto *ec = std::get_if<parser::ExecutableConstruct>(&epc.u)) {
+ if (auto *as =
+ std::get_if<parser::Statement<parser::ActionStmt>>(&ec->u)) {
+ return std::holds_alternative<
+ common::Indirection<parser::AllocateStmt>>(as->statement.u);
+ }
+ }
+ return false;
+ };
+
+ if (!block.empty() && isAllocateStmt(block.front())) {
+ // There are two places where an OpenMP declarative construct can
+ // show up in the tuple in specification part:
+ // (1) in std::list<OpenMPDeclarativeConstruct>, or
+ // (2) in std::list<DeclarationConstruct>.
+ // The case (1) is only possible is the list (2) is empty.
+
+ auto &omps =
+ std::get<std::list<parser::OpenMPDeclarativeConstruct>>(spec.t);
+ auto &decls = std::get<std::list<parser::DeclarationConstruct>>(spec.t);
+
+ if (!decls.empty()) {
+ MakeExecutableAllocateFromDecls(decls, block);
+ } else {
+ MakeExecutableAllocateFromOmps(omps, block);
+ }
+ }
+ }
+
+ parser::ExecutionPartConstruct EmbedInExec(parser::OmpAllocateDirective *alo,
+ parser::ExecutionPartConstruct &&epc) {
+ // Nest current epc inside the allocate directive.
+ std::get<parser::Block>(alo->t).push_front(std::move(epc));
+ // Set the new epc to be the ExecutionPartConstruct made from
+ // the allocate directive.
+ parser::OpenMPConstruct opc(std::move(*alo));
+ common::Indirection<parser::OpenMPConstruct> ind(std::move(opc));
+ parser::ExecutableConstruct ec(std::move(ind));
+ return parser::ExecutionPartConstruct(std::move(ec));
+ }
+
+ void MakeExecutableAllocateFromDecls(
+ std::list<parser::DeclarationConstruct> &decls, parser::Block &body) {
+ using OpenMPDeclarativeConstruct =
+ common::Indirection<parser::OpenMPDeclarativeConstruct>;
+
+ auto getAllocate = [](parser::DeclarationConstruct *dc) {
+ if (auto *sc = std::get_if<parser::SpecificationConstruct>(&dc->u)) {
+ if (auto *odc = std::get_if<OpenMPDeclarativeConstruct>(&sc->u)) {
+ if (auto *alo =
+ std::get_if<parser::OmpAllocateDirective>(&odc->value().u)) {
+ return alo;
+ }
+ }
+ }
+ return static_cast<parser::OmpAllocateDirective *>(nullptr);
+ };
+
+ std::list<parser::DeclarationConstruct>::reverse_iterator rlast = [&]() {
+ for (auto rit = decls.rbegin(), rend = decls.rend(); rit != rend; ++rit) {
+ if (getAllocate(&*rit) == nullptr) {
+ return rit;
}
- if (!subAllocates.empty()) {
- std::get<std::optional<std::list<parser::OpenMPDeclarativeAllocate>>>(
- exec->t) = {std::move(subAllocates)};
+ }
+ return decls.rend();
+ }();
+
+ if (rlast != decls.rbegin()) {
+ // We have already checked that the first statement in body is
+ // ALLOCATE.
+ parser::ExecutionPartConstruct epc(std::move(body.front()));
+ for (auto rit = decls.rbegin(); rit != rlast; ++rit) {
+ epc = EmbedInExec(getAllocate(&*rit), std::move(epc));
+ }
+
+ body.pop_front();
+ body.push_front(std::move(epc));
+ decls.erase(rlast.base(), decls.end());
+ }
+ }
+
+ void MakeExecutableAllocateFromOmps(
+ std::list<parser::OpenMPDeclarativeConstruct> &omps,
+ parser::Block &body) {
+ using OpenMPDeclarativeConstruct = parser::OpenMPDeclarativeConstruct;
+
+ std::list<OpenMPDeclarativeConstruct>::reverse_iterator rlast = [&]() {
+ for (auto rit = omps.rbegin(), rend = omps.rend(); rit != rend; ++rit) {
+ if (!std::holds_alternative<parser::OmpAllocateDirective>(rit->u)) {
+ return rit;
}
}
+ return omps.rend();
+ }();
+
+ if (rlast != omps.rbegin()) {
+ parser::ExecutionPartConstruct epc(std::move(body.front()));
+ for (auto rit = omps.rbegin(); rit != rlast; ++rit) {
+ epc = EmbedInExec(
+ &std::get<parser::OmpAllocateDirective>(rit->u), std::move(epc));
+ }
+
+ body.pop_front();
+ body.push_front(std::move(epc));
+ omps.erase(rlast.base(), omps.end());
}
}
diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index 3ea8e5b8cd2b0..40d574a481582 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -179,6 +179,22 @@ void OmpStructureChecker::Leave(const parser::BlockConstruct &x) {
}
}
+void OmpStructureChecker::Enter(const parser::SpecificationPart &) {
+ partStack_.push_back(PartKind::SpecificationPart);
+}
+
+void OmpStructureChecker::Leave(const parser::SpecificationPart &) {
+ partStack_.pop_back();
+}
+
+void OmpStructureChecker::Enter(const parser::ExecutionPart &) {
+ partStack_.push_back(PartKind::ExecutionPart);
+}
+
+void OmpStructureChecker::Leave(const parser::ExecutionPart &) {
+ partStack_.pop_back();
+}
+
// Use when clause falls under 'struct OmpClause' in 'parse-tree.h'.
#define CHECK_SIMPLE_CLAUSE(X, Y) \
void OmpStructureChecker::Enter(const parser::OmpClause::X &) { \
@@ -720,18 +736,10 @@ template <typename Checker> struct DirectiveSpellingVisitor {
return std::get<parser::OmpBeginDirective>(t).DirName();
}
- bool Pre(const parser::OpenMPDeclarativeAllocate &x) {
- checker_(std::get<parser::Verbatim>(x.t).source, Directive::OMPD_allocate);
- return false;
- }
bool Pre(const parser::OpenMPDispatchConstruct &x) {
checker_(GetDirName(x.t).source, Directive::OMPD_dispatch);
return false;
}
- bool Pre(const parser::OpenMPExecutableAllocate &x) {
- checker_(std::get<parser::Verbatim>(x.t).source, Directive::OMPD_allocate);
- return false;
- }
bool Pre(const parser::OpenMPAllocatorsConstruct &x) {
checker_(GetDirName(x.t).source, Directive::OMPD_allocators);
return false;
@@ -1667,11 +1675,6 @@ 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)}) {
@@ -1699,19 +1702,12 @@ static UnorderedSymbolSet GetNonComponentSymbols(
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::CheckIndividualAllocateDirective(
+ const parser::OmpAllocateDirective &x, bool isExecutable) {
+ const parser::OmpDirectiveSpecification &beginSpec{x.BeginDir()};
+ const parser::OmpDirectiveName &dirName{beginSpec.DirName()};
-void OmpStructureChecker::CheckAllocateDirective(parser::CharBlock source,
- const parser::OmpObjectList &objects,
- const parser::OmpClauseList &clauses) {
- const Scope &thisScope{context_.FindScope(source)};
+ const Scope &thisScope{context_.FindScope(dirName.source)};
auto maybeHasPredefinedAllocator{[&](const parser::OmpClause *calloc) {
// Return "true" if the ALLOCATOR clause was provided with an argument
@@ -1740,7 +1736,7 @@ void OmpStructureChecker::CheckAllocateDirective(parser::CharBlock source,
const auto *allocator{[&]() {
// Can't use FindClause in Enter (because clauses haven't been visited
// yet).
- for (const parser::OmpClause &c : clauses.v) {
+ for (const parser::OmpClause &c : beginSpec.Clauses().v) {
if (c.Id() == llvm::omp::Clause::OMPC_allocator) {
return &c;
}
@@ -1752,7 +1748,7 @@ void OmpStructureChecker::CheckAllocateDirective(parser::CharBlock source,
bool hasDynAllocators{
HasRequires(llvm::omp::Clause::OMPC_dynamic_allocators)};
if (!allocator && !hasDynAllocators) {
- context_.Say(source,
+ context_.Say(dirName.source,
"An ALLOCATE directive in a TARGET region must specify an ALLOCATOR clause or REQUIRES(DYNAMIC_ALLOCATORS) must be specified"_err_en_US);
}
}
@@ -1766,7 +1762,7 @@ void OmpStructureChecker::CheckAllocateDirective(parser::CharBlock source,
: "a named common block or has SAVE attribute"};
auto checkSymbol{[&](const Symbol &symbol, parser::CharBlock source) {
- if (!inExecutableAllocate_) {
+ if (!isExecutable) {
// For structure members, the scope is the derived type, which is
// never "this" scope. Ignore this check for members, they will be
// flagged anyway.
@@ -1802,37 +1798,130 @@ void OmpStructureChecker::CheckAllocateDirective(parser::CharBlock source,
}
}};
- 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)}) {
+ for (const parser::OmpArgument &arg : beginSpec.Arguments().v) {
+ const parser::OmpObject *object{GetArgumentObject(arg)};
+ if (!object) {
+ context_.Say(arg.source,
+ "An argument to ALLOCATE directive must be a variable list item"_err_en_US);
+ continue;
+ }
+
+ if (const Symbol *symbol{GetObjectSymbol(*object)}) {
if (!IsTypeParamInquiry(*symbol)) {
- checkSymbol(*symbol, objSource);
+ checkSymbol(*symbol, arg.source);
}
- CheckVarIsNotPartOfAnotherVar(source, object);
+ CheckVarIsNotPartOfAnotherVar(dirName.source, *object);
}
}
}
-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::CheckExecutableAllocateDirective(
+ const parser::OmpAllocateDirective &x) {
+ parser::omp::OmpAllocateInfo info{SplitOmpAllocate(x)};
+
+ auto [allocStmt, allocSource]{getAllocateStmtAndSource(info.body)};
+ if (!allocStmt) {
+ // This has been diagnosed already.
+ return;
+ }
+
+ UnorderedSymbolSet allocateSyms{GetNonComponentSymbols(*allocStmt)};
+ SymbolSourceMap directiveSyms;
+ bool hasEmptyList{false};
- if (!inExecutableAllocate_) {
- const auto &dir{std::get<parser::Verbatim>(x.t)};
- const auto &clauses{std::get<parser::OmpClauseList>(x.t)};
- const auto &objects{
- GetObjectsOrEmpty(std::get<std::optional<parser::OmpObjectList>>(x.t))};
+ for (const parser::OmpAllocateDirective *ompAlloc : info.dirs) {
+ const parser::OmpDirectiveSpecification &spec{DEREF(ompAlloc).BeginDir()};
+ if (spec.Arguments().v.empty()) {
+ if (hasEmptyList && info.dirs.size() > 1) {
+ context_.Say(spec.DirName().source,
+ "If multiple directives are present in an executable ALLOCATE directive, at most one of them may specify no list items"_err_en_US);
+ }
+ hasEmptyList = true;
+ }
+ for (const parser::OmpArgument &arg : spec.Arguments().v) {
+ if (auto *sym{GetArgumentSymbol(arg)}) {
+ // 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(arg.source, 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, arg.source));
+ }
- CheckAllocateDirective(dir.source, objects, clauses);
+ if (auto f{allocateSyms.find(*sym)}; f == allocateSyms.end()) {
+ context_
+ .Say(arg.source,
+ "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);
+ }
+ }
+ }
}
}
-void OmpStructureChecker::Leave(const parser::OpenMPDeclarativeAllocate &x) {
+void OmpStructureChecker::Enter(const parser::OmpAllocateDirective &x) {
+ const parser::OmpDirectiveSpecification &beginSpec{x.BeginDir()};
+ const parser::OmpDirectiveName &dirName{beginSpec.DirName()};
+ PushContextAndClauseSets(dirName.source, dirName.v);
+ ++allocateDirectiveLevel;
+
+ bool isExecutable{partStack_.back() == PartKind::ExecutionPart};
+
+ unsigned version{context_.langOptions().OpenMPVersion};
+ if (isExecutable && allocateDirectiveLevel == 1 && version >= 52) {
+ context_.Warn(common::UsageWarning::OpenMPUsage, dirName.source,
+ "The executable form of the OpenMP ALLOCATE directive has been deprecated, please use ALLOCATORS instead"_warn_en_US);
+ }
+
+ CheckIndividualAllocateDirective(x, isExecutable);
+
+ if (isExecutable) {
+ auto isOmpAllocate{[](const parser::ExecutionPartConstruct &epc) {
+ if (auto *omp{GetOmp(epc)}) {
+ auto odn{GetOmpDirectiveName(*omp)};
+ return odn.v == llvm::omp::Directive::OMPD_allocate;
+ }
+ return false;
+ }};
+
+ auto &body{std::get<parser::Block>(x.t)};
+ // The parser should put at most one statement in the body.
+ assert(body.size() <= 1 && "Multiple statements in allocate");
+ if (body.empty()) {
+ context_.Say(dirName.source,
+ "An executable ALLOCATE directive must be associated with an ALLOCATE statement"_err_en_US);
+ } else {
+ const parser::ExecutionPartConstruct &first{body.front()};
+ auto [allocStmt, _]{getAllocateStmtAndSource(&body.front())};
+ if (!isOmpAllocate(first) && !allocStmt) {
+ parser::CharBlock source{[&]() {
+ if (auto &&maybeSource{parser::GetSource(first)}) {
+ return *maybeSource;
+ }
+ return dirName.source;
+ }()};
+ context_.Say(source,
+ "The statement associated with executable ALLOCATE directive must be an ALLOCATE statement"_err_en_US);
+ }
+ }
+ }
+}
+
+void OmpStructureChecker::Leave(const parser::OmpAllocateDirective &x) {
+ bool isExecutable{partStack_.back() == PartKind::ExecutionPart};
+ if (isExecutable && allocateDirectiveLevel == 1) {
+ CheckExecutableAllocateDirective(x);
+ }
+
+ --allocateDirectiveLevel;
dirContext_.pop_back();
}
@@ -2135,113 +2224,8 @@ void OmpStructureChecker::Enter(const parser::OmpClause::At &x) {
}
}
-void OmpStructureChecker::Enter(const parser::OpenMPExecutableAllocate &x) {
- inExecutableAllocate_ = true;
- const auto &dir{std::get<parser::Verbatim>(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);
- }
-
- 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);
-
- if (const auto &subDirs{
- std::get<std::optional<std::list<parser::OpenMPDeclarativeAllocate>>>(
- x.t)}) {
- 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{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);
- }
-
- inExecutableAllocate_ = false;
- dirContext_.pop_back();
-}
-
void OmpStructureChecker::Enter(const parser::OpenMPAllocatorsConstruct &x) {
+
const parser::OmpDirectiveSpecification &beginSpec{x.BeginDir()};
const parser::OmpDirectiveName &dirName{beginSpec.DirName()};
PushContextAndClauseSets(
diff --git a/flang/lib/Semantics/check-omp-structure.h b/flang/lib/Semantics/check-omp-structure.h
index 6feb1d149c4fd..1b84bc5dda471 100644
--- a/flang/lib/Semantics/check-omp-structure.h
+++ b/flang/lib/Semantics/check-omp-structure.h
@@ -82,6 +82,11 @@ class OmpStructureChecker : public OmpStructureCheckerBase {
bool Enter(const parser::BlockConstruct &);
void Leave(const parser::BlockConstruct &);
+ void Enter(const parser::SpecificationPart &);
+ void Leave(const parser::SpecificationPart &);
+ void Enter(const parser::ExecutionPart &);
+ void Leave(const parser::ExecutionPart &);
+
void Enter(const parser::OpenMPConstruct &);
void Leave(const parser::OpenMPConstruct &);
void Enter(const parser::OpenMPInteropConstruct &);
@@ -113,8 +118,8 @@ class OmpStructureChecker : public OmpStructureCheckerBase {
void Leave(const parser::OmpDeclareVariantDirective &);
void Enter(const parser::OpenMPDeclareSimdConstruct &);
void Leave(const parser::OpenMPDeclareSimdConstruct &);
- void Enter(const parser::OpenMPDeclarativeAllocate &);
- void Leave(const parser::OpenMPDeclarativeAllocate &);
+ void Enter(const parser::OmpAllocateDirective &);
+ void Leave(const parser::OmpAllocateDirective &);
void Enter(const parser::OpenMPDeclareMapperConstruct &);
void Leave(const parser::OpenMPDeclareMapperConstruct &);
void Enter(const parser::OpenMPDeclareReductionConstruct &);
@@ -129,8 +134,6 @@ class OmpStructureChecker : public OmpStructureCheckerBase {
void Leave(const parser::OmpErrorDirective &);
void Enter(const parser::OmpNothingDirective &);
void Leave(const parser::OmpNothingDirective &);
- void Enter(const parser::OpenMPExecutableAllocate &);
- void Leave(const parser::OpenMPExecutableAllocate &);
void Enter(const parser::OpenMPAllocatorsConstruct &);
void Leave(const parser::OpenMPAllocatorsConstruct &);
void Enter(const parser::OpenMPRequiresConstruct &);
@@ -263,9 +266,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 CheckIndividualAllocateDirective(
+ const parser::OmpAllocateDirective &x, bool isExecutable);
+ void CheckExecutableAllocateDirective(const parser::OmpAllocateDirective &x);
void CheckIteratorRange(const parser::OmpIteratorSpecifier &x);
void CheckIteratorModifier(const parser::OmpIterator &x);
@@ -373,7 +376,7 @@ class OmpStructureChecker : public OmpStructureCheckerBase {
};
int directiveNest_[LastType + 1] = {0};
- bool inExecutableAllocate_{false};
+ int allocateDirectiveLevel{0};
parser::CharBlock visitedAtomicSource_;
SymbolSourceMap deferredNonVariables_;
@@ -382,6 +385,14 @@ class OmpStructureChecker : public OmpStructureCheckerBase {
std::vector<LoopConstruct> loopStack_;
// Scopes for scoping units.
std::vector<const Scope *> scopeStack_;
+
+ enum class PartKind : int {
+ // There are also other "parts", such as internal-subprogram-part, etc,
+ // but we're keeping track of these two for now.
+ SpecificationPart,
+ ExecutionPart,
+ };
+ std::vector<PartKind> partStack_;
};
/// Find a duplicate entry in the range, and return an iterator to it.
diff --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp
index 03c8cb0065fd8..deb57e005a352 100644
--- a/flang/lib/Semantics/resolve-directives.cpp
+++ b/flang/lib/Semantics/resolve-directives.cpp
@@ -415,6 +415,18 @@ class OmpAttributeVisitor : DirectiveAttributeVisitor<llvm::omp::Directive> {
return true;
}
+ bool Pre(const parser::SpecificationPart &) {
+ partStack_.push_back(PartKind::SpecificationPart);
+ return true;
+ }
+ void Post(const parser::SpecificationPart &) { partStack_.pop_back(); }
+
+ bool Pre(const parser::ExecutionPart &) {
+ partStack_.push_back(PartKind::ExecutionPart);
+ return true;
+ }
+ void Post(const parser::ExecutionPart &) { partStack_.pop_back(); }
+
bool Pre(const parser::InternalSubprogram &) {
// Clear the labels being tracked in the previous scope
ClearLabels();
@@ -639,8 +651,7 @@ class OmpAttributeVisitor : DirectiveAttributeVisitor<llvm::omp::Directive> {
bool Pre(const parser::OpenMPThreadprivate &);
void Post(const parser::OpenMPThreadprivate &) { PopContext(); }
- bool Pre(const parser::OpenMPDeclarativeAllocate &);
- void Post(const parser::OpenMPDeclarativeAllocate &) { PopContext(); }
+ bool Pre(const parser::OmpAllocateDirective &);
bool Pre(const parser::OpenMPAssumeConstruct &);
void Post(const parser::OpenMPAssumeConstruct &) { PopContext(); }
@@ -651,9 +662,6 @@ class OmpAttributeVisitor : DirectiveAttributeVisitor<llvm::omp::Directive> {
bool Pre(const parser::OpenMPDispatchConstruct &);
void Post(const parser::OpenMPDispatchConstruct &) { PopContext(); }
- bool Pre(const parser::OpenMPExecutableAllocate &);
- void Post(const parser::OpenMPExecutableAllocate &);
-
bool Pre(const parser::OpenMPAllocatorsConstruct &);
void Post(const parser::OpenMPAllocatorsConstruct &);
@@ -998,6 +1006,14 @@ class OmpAttributeVisitor : DirectiveAttributeVisitor<llvm::omp::Directive> {
targetLabels_;
parser::CharBlock currentStatementSource_;
+ enum class PartKind : int {
+ // There are also other "parts", such as internal-subprogram-part, etc,
+ // but we're keeping track of these two for now.
+ SpecificationPart,
+ ExecutionPart,
+ };
+ std::vector<PartKind> partStack_;
+
void AddAllocateName(const parser::Name *&object) {
allocateNames_.push_back(object);
}
@@ -2558,11 +2574,24 @@ bool OmpAttributeVisitor::Pre(const parser::OpenMPThreadprivate &x) {
return true;
}
-bool OmpAttributeVisitor::Pre(const parser::OpenMPDeclarativeAllocate &x) {
+bool OmpAttributeVisitor::Pre(const parser::OmpAllocateDirective &x) {
PushContext(x.source, llvm::omp::Directive::OMPD_allocate);
- if (const auto &list{std::get<std::optional<parser::OmpObjectList>>(x.t)}) {
- ResolveOmpObjectList(*list, Symbol::Flag::OmpDeclarativeAllocateDirective);
+ assert(!partStack_.empty() && "Misplaced directive");
+
+ auto ompFlag{partStack_.back() == PartKind::SpecificationPart
+ ? Symbol::Flag::OmpDeclarativeAllocateDirective
+ : Symbol::Flag::OmpExecutableAllocateDirective};
+
+ parser::omp::OmpAllocateInfo info{parser::omp::SplitOmpAllocate(x)};
+ for (const parser::OmpAllocateDirective *ad : info.dirs) {
+ for (const parser::OmpArgument &arg : ad->BeginDir().Arguments().v) {
+ if (auto *object{omp::GetArgumentObject(arg)}) {
+ ResolveOmpObject(*object, ompFlag);
+ }
+ }
}
+
+ PopContext();
return false;
}
@@ -2581,15 +2610,6 @@ bool OmpAttributeVisitor::Pre(const parser::OpenMPDispatchConstruct &x) {
return true;
}
-bool OmpAttributeVisitor::Pre(const parser::OpenMPExecutableAllocate &x) {
- PushContext(x.source, llvm::omp::Directive::OMPD_allocate);
- const auto &list{std::get<std::optional<parser::OmpObjectList>>(x.t)};
- if (list) {
- ResolveOmpObjectList(*list, Symbol::Flag::OmpExecutableAllocateDirective);
- }
- return true;
-}
-
bool OmpAttributeVisitor::Pre(const parser::OpenMPAllocatorsConstruct &x) {
const parser::OmpDirectiveSpecification &dirSpec{x.BeginDir()};
PushContext(x.source, dirSpec.DirId());
@@ -2661,10 +2681,6 @@ bool OmpAttributeVisitor::IsNestedInDirective(llvm::omp::Directive directive) {
return false;
}
-void OmpAttributeVisitor::Post(const parser::OpenMPExecutableAllocate &x) {
- PopContext();
-}
-
void OmpAttributeVisitor::Post(const parser::OpenMPAllocatorsConstruct &x) {
PopContext();
}
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index f88af5fac0bbd..b53bfa5649d44 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -1700,12 +1700,12 @@ class OmpVisitor : public virtual DeclarationVisitor {
void Post(const parser::OpenMPDeclareTargetConstruct &) {
SkipImplicitTyping(false);
}
- bool Pre(const parser::OpenMPDeclarativeAllocate &x) {
+ bool Pre(const parser::OmpAllocateDirective &x) {
AddOmpSourceRange(x.source);
SkipImplicitTyping(true);
return true;
}
- void Post(const parser::OpenMPDeclarativeAllocate &) {
+ void Post(const parser::OmpAllocateDirective &) {
SkipImplicitTyping(false);
messageHandler().set_currStmtSource(std::nullopt);
}
diff --git a/flang/test/Lower/OpenMP/Todo/omp-declarative-allocate-align.f90 b/flang/test/Lower/OpenMP/Todo/omp-declarative-allocate-align.f90
index 8daf20e1ae400..fec146ac70313 100644
--- a/flang/test/Lower/OpenMP/Todo/omp-declarative-allocate-align.f90
+++ b/flang/test/Lower/OpenMP/Todo/omp-declarative-allocate-align.f90
@@ -5,6 +5,6 @@
program main
integer :: x
- ! CHECK: not yet implemented: OpenMPDeclarativeAllocate
+ ! CHECK: not yet implemented: OmpAllocateDirective
!$omp allocate(x) align(32)
end
diff --git a/flang/test/Lower/OpenMP/Todo/omp-declarative-allocate.f90 b/flang/test/Lower/OpenMP/Todo/omp-declarative-allocate.f90
index e83b433d0fda0..3307eb2505b71 100644
--- a/flang/test/Lower/OpenMP/Todo/omp-declarative-allocate.f90
+++ b/flang/test/Lower/OpenMP/Todo/omp-declarative-allocate.f90
@@ -5,6 +5,6 @@
program main
integer :: x, y
- ! CHECK: not yet implemented: OpenMPDeclarativeAllocate
+ ! CHECK: not yet implemented: OmpAllocateDirective
!$omp allocate(x, y)
end
diff --git a/flang/test/Parser/OpenMP/allocate-align-tree.f90 b/flang/test/Parser/OpenMP/allocate-align-tree.f90
index 0d247cd1ed945..d799aa10a82ff 100644
--- a/flang/test/Parser/OpenMP/allocate-align-tree.f90
+++ b/flang/test/Parser/OpenMP/allocate-align-tree.f90
@@ -16,27 +16,33 @@ program allocate_align_tree
allocate(j(z), xarray(t))
end program allocate_align_tree
-!CHECK: | | DeclarationConstruct -> SpecificationConstruct -> TypeDeclarationStmt
-!CHECK-NEXT: | | | DeclarationTypeSpec -> IntrinsicTypeSpec -> IntegerTypeSpec ->
-!CHECK-NEXT: | | | AttrSpec -> Allocatable
-!CHECK-NEXT: | | | EntityDecl
-!CHECK-NEXT: | | | | Name = 'j'
+!CHECK: DeclarationConstruct -> SpecificationConstruct -> TypeDeclarationStmt
+!CHECK-NEXT: | DeclarationTypeSpec -> IntrinsicTypeSpec -> IntegerTypeSpec ->
+!CHECK-NEXT: | AttrSpec -> Allocatable
+!CHECK-NEXT: | EntityDecl
+!CHECK-NEXT: | | Name = 'j'
+!CHECK: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OmpAllocateDirective
+!CHECK-NEXT: | OmpBeginDirective
+!CHECK-NEXT: | | OmpDirectiveName -> llvm::omp::Directive = allocate
+!CHECK-NEXT: | | OmpArgumentList -> OmpArgument -> OmpLocator -> OmpObject -> Designator -> DataRef -> Name = 'j'
+!CHECK-NEXT: | | OmpClauseList -> OmpClause -> Align -> OmpAlignClause -> Scalar -> Integer -> Constant -> Expr = '16_4'
+!CHECK-NEXT: | | | LiteralConstant -> IntLiteralConstant = '16'
+!CHECK-NEXT: | | Flags = None
+!CHECK-NEXT: | Block
+!CHECK-NEXT: | | ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OmpAllocateDirective
+!CHECK-NEXT: | | | OmpBeginDirective
+!CHECK-NEXT: | | | | OmpDirectiveName -> llvm::omp::Directive = allocate
+!CHECK-NEXT: | | | | OmpArgumentList -> OmpArgument -> OmpLocator -> OmpObject -> Designator -> DataRef -> Name = 'xarray'
+!CHECK-NEXT: | | | | OmpClauseList -> OmpClause -> Align -> OmpAlignClause -> Scalar -> Integer -> Constant -> Expr = '32_4'
+!CHECK-NEXT: | | | | | LiteralConstant -> IntLiteralConstant = '32'
+!CHECK-NEXT: | | | | OmpClause -> Allocator -> Scalar -> Integer -> Expr = '2_8'
+!CHECK-NEXT: | | | | | Designator -> DataRef -> Name = 'omp_large_cap_mem_alloc'
+!CHECK-NEXT: | | | | Flags = None
+!CHECK-NEXT: | | | Block
+!CHECK-NEXT: | | | | ExecutionPartConstruct -> ExecutableConstruct -> ActionStmt -> AllocateStmt
-!CHECK: | | ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OpenMPExecutableAllocate
-!CHECK-NEXT: | | | Verbatim
-!CHECK-NEXT: | | | OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'xarray'
-!CHECK-NEXT: | | | OmpClauseList -> OmpClause -> Align -> OmpAlignClause -> Scalar -> Integer -> Constant -> Expr = '32_4'
-!CHECK-NEXT: | | | | LiteralConstant -> IntLiteralConstant = '32'
-!CHECK-NEXT: | | | OmpClause -> Allocator -> Scalar -> Integer -> Expr = '2_8'
-!CHECK-NEXT: | | | | Designator -> DataRef -> Name = 'omp_large_cap_mem_alloc'
-!CHECK-NEXT: | | | OpenMPDeclarativeAllocate
-!CHECK-NEXT: | | | | Verbatim
-!CHECK-NEXT: | | | | OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'j'
-!CHECK-NEXT: | | | | OmpClauseList -> OmpClause -> Align -> OmpAlignClause -> Scalar -> Integer -> Constant -> Expr = '16_4'
-!CHECK-NEXT: | | | | | LiteralConstant -> IntLiteralConstant = '16'
-!CHECK-NEXT: | | | AllocateStmt
+!UNPARSE: !$OMP ALLOCATE(j) ALIGN(16_4)
+!UNPARSE-NEXT: !$OMP ALLOCATE(xarray) ALIGN(32_4) ALLOCATOR(2_8)
+!UNPARSE-NEXT: ALLOCATE(j(z), xarray(t))
-!UNPARSE: !$OMP ALLOCATE (j) ALIGN(16_4)
-!UNPARSE: !$OMP ALLOCATE (xarray) ALIGN(32_4) ALLOCATOR(2_8)
-!UNPARSE-NEXT: ALLOCATE(j(z), xarray(t))
diff --git a/flang/test/Parser/OpenMP/allocate-tree-spec-part.f90 b/flang/test/Parser/OpenMP/allocate-tree-spec-part.f90
index afcaf44b09f03..800e4a57d5f0e 100644
--- a/flang/test/Parser/OpenMP/allocate-tree-spec-part.f90
+++ b/flang/test/Parser/OpenMP/allocate-tree-spec-part.f90
@@ -17,33 +17,48 @@ program allocate_tree
allocate (w, xarray(4), zarray(5, f))
end program allocate_tree
-!CHECK: | | DeclarationConstruct -> SpecificationConstruct -> OpenMPDeclarativeConstruct -> OpenMPDeclarativeAllocate
-!CHECK-NEXT: | | | Verbatim
-!CHECK-NEXT: | | | OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'f'
-!CHECK-NEXT: | | | OmpClauseList -> OmpClause -> Allocator -> Scalar -> Integer -> Expr =
-!CHECK-NEXT: | | | | Designator -> DataRef -> Name =
+!CHECK: | | DeclarationConstruct -> SpecificationConstruct -> OpenMPDeclarativeConstruct -> OmpAllocateDirective
+!CHECK-NEXT: | | | OmpBeginDirective
+!CHECK-NEXT: | | | | OmpDirectiveName -> llvm::omp::Directive = allocate
+!CHECK-NEXT: | | | | OmpArgumentList -> OmpArgument -> OmpLocator -> OmpObject -> Designator -> DataRef -> Name = 'f'
+!CHECK-NEXT: | | | | OmpClauseList -> OmpClause -> Allocator -> Scalar -> Integer -> Expr = '1_8'
+!CHECK-NEXT: | | | | | Designator -> DataRef -> Name = 'omp_default_mem_alloc'
+!CHECK-NEXT: | | | | Flags = None
+!CHECK-NEXT: | | | Block
!CHECK-NEXT: | ExecutionPart -> Block
!CHECK-NEXT: | | ExecutionPartConstruct -> ExecutableConstruct -> ActionStmt -> AssignmentStmt = 'f=2_4'
!CHECK-NEXT: | | | Variable = 'f'
!CHECK-NEXT: | | | | Designator -> DataRef -> Name = 'f'
!CHECK-NEXT: | | | Expr = '2_4'
!CHECK-NEXT: | | | | LiteralConstant -> IntLiteralConstant = '2'
-!CHECK-NEXT: | | ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OpenMPExecutableAllocate
-!CHECK-NEXT: | | | Verbatim
-!CHECK-NEXT: | | | OmpClauseList ->
-!CHECK-NEXT: | | | OpenMPDeclarativeAllocate
-!CHECK-NEXT: | | | | Verbatim
-!CHECK-NEXT: | | | | OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'w'
-!CHECK-NEXT: | | | | OmpClauseList -> OmpClause -> Allocator -> Scalar -> Integer -> Expr =
-!CHECK-NEXT: | | | | | Designator -> DataRef -> Name =
-!CHECK-NEXT: | | | OpenMPDeclarativeAllocate
-!CHECK-NEXT: | | | | Verbatim
-!CHECK-NEXT: | | | | OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'xarray'
-!CHECK-NEXT: | | | | OmpClauseList -> OmpClause -> Allocator -> Scalar -> Integer -> Expr =
-!CHECK-NEXT: | | | | | Designator -> DataRef -> Name =
-!CHECK-NEXT: | | | OpenMPDeclarativeAllocate
-!CHECK-NEXT: | | | | Verbatim
-!CHECK-NEXT: | | | | OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'zarray'
-!CHECK-NEXT: | | | | OmpClauseList -> OmpClause -> Allocator -> Scalar -> Integer -> Expr =
-!CHECK-NEXT: | | | | | Designator -> DataRef -> Name =
-!CHECK-NEXT: | | | AllocateStmt
+!CHECK-NEXT: | | ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OmpAllocateDirective
+!CHECK-NEXT: | | | OmpBeginDirective
+!CHECK-NEXT: | | | | OmpDirectiveName -> llvm::omp::Directive = allocate
+!CHECK-NEXT: | | | | OmpArgumentList -> OmpArgument -> OmpLocator -> OmpObject -> Designator -> DataRef -> Name = 'w'
+!CHECK-NEXT: | | | | OmpClauseList -> OmpClause -> Allocator -> Scalar -> Integer -> Expr = '3_8'
+!CHECK-NEXT: | | | | | Designator -> DataRef -> Name = 'omp_const_mem_alloc'
+!CHECK-NEXT: | | | | Flags = None
+!CHECK-NEXT: | | | Block
+!CHECK-NEXT: | | | | ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OmpAllocateDirective
+!CHECK-NEXT: | | | | | OmpBeginDirective
+!CHECK-NEXT: | | | | | | OmpDirectiveName -> llvm::omp::Directive = allocate
+!CHECK-NEXT: | | | | | | OmpArgumentList -> OmpArgument -> OmpLocator -> OmpObject -> Designator -> DataRef -> Name = 'xarray'
+!CHECK-NEXT: | | | | | | OmpClauseList -> OmpClause -> Allocator -> Scalar -> Integer -> Expr = '2_8'
+!CHECK-NEXT: | | | | | | | Designator -> DataRef -> Name = 'omp_large_cap_mem_alloc'
+!CHECK-NEXT: | | | | | | Flags = None
+!CHECK-NEXT: | | | | | Block
+!CHECK-NEXT: | | | | | | ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OmpAllocateDirective
+!CHECK-NEXT: | | | | | | | OmpBeginDirective
+!CHECK-NEXT: | | | | | | | | OmpDirectiveName -> llvm::omp::Directive = allocate
+!CHECK-NEXT: | | | | | | | | OmpArgumentList -> OmpArgument -> OmpLocator -> OmpObject -> Designator -> DataRef -> Name = 'zarray'
+!CHECK-NEXT: | | | | | | | | OmpClauseList -> OmpClause -> Allocator -> Scalar -> Integer -> Expr = '1_8'
+!CHECK-NEXT: | | | | | | | | | Designator -> DataRef -> Name = 'omp_default_mem_alloc'
+!CHECK-NEXT: | | | | | | | | Flags = None
+!CHECK-NEXT: | | | | | | | Block
+!CHECK-NEXT: | | | | | | | | ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OmpAllocateDirective
+!CHECK-NEXT: | | | | | | | | | OmpBeginDirective
+!CHECK-NEXT: | | | | | | | | | | OmpDirectiveName -> llvm::omp::Directive = allocate
+!CHECK-NEXT: | | | | | | | | | | OmpClauseList ->
+!CHECK-NEXT: | | | | | | | | | | Flags = None
+!CHECK-NEXT: | | | | | | | | | Block
+!CHECK-NEXT: | | | | | | | | | | ExecutionPartConstruct -> ExecutableConstruct -> ActionStmt -> AllocateStmt
diff --git a/flang/test/Parser/OpenMP/allocate-tree.f90 b/flang/test/Parser/OpenMP/allocate-tree.f90
index bf413d591baf2..021d8104a7e62 100644
--- a/flang/test/Parser/OpenMP/allocate-tree.f90
+++ b/flang/test/Parser/OpenMP/allocate-tree.f90
@@ -7,52 +7,54 @@
program allocate_tree
use omp_lib
- integer, allocatable :: w, xarray(:), zarray(:, :)
- integer :: z, t
+ integer, allocatable :: xarray(:), zarray(:, :)
+ integer :: z, t, w
+!$omp allocate(w) allocator(omp_const_mem_alloc)
t = 2
z = 3
-!$omp allocate(w) allocator(omp_const_mem_alloc)
!$omp allocate(xarray) allocator(omp_large_cap_mem_alloc)
!$omp allocate(zarray) allocator(omp_default_mem_alloc)
!$omp allocate
- allocate(w, xarray(4), zarray(t, z))
+ allocate(xarray(4), zarray(t, z))
end program allocate_tree
-!CHECK: | | DeclarationConstruct -> SpecificationConstruct -> TypeDeclarationStmt
-!CHECK-NEXT: | | | DeclarationTypeSpec -> IntrinsicTypeSpec -> IntegerTypeSpec ->
-!CHECK-NEXT: | | | AttrSpec -> Allocatable
-!CHECK-NEXT: | | | EntityDecl
-!CHECK-NEXT: | | | | Name = 'w'
-!CHECK-NEXT: | | | EntityDecl
-!CHECK-NEXT: | | | | Name = 'xarray'
-!CHECK-NEXT: | | | | ArraySpec -> DeferredShapeSpecList -> int = '1'
-!CHECK-NEXT: | | | EntityDecl
-!CHECK-NEXT: | | | | Name = 'zarray'
-!CHECK-NEXT: | | | | ArraySpec -> DeferredShapeSpecList -> int = '2'
-
+!CHECK: DeclarationConstruct -> SpecificationConstruct -> OpenMPDeclarativeConstruct -> OmpAllocateDirective
+!CHECK-NEXT: | OmpBeginDirective
+!CHECK-NEXT: | | OmpDirectiveName -> llvm::omp::Directive = allocate
+!CHECK-NEXT: | | OmpArgumentList -> OmpArgument -> OmpLocator -> OmpObject -> Designator -> DataRef -> Name = 'w'
+!CHECK-NEXT: | | OmpClauseList -> OmpClause -> Allocator -> Scalar -> Integer -> Expr = '3_8'
+!CHECK-NEXT: | | | Designator -> DataRef -> Name = 'omp_const_mem_alloc'
+!CHECK-NEXT: | | Flags = None
+!CHECK-NEXT: | Block
-!CHECK: | | ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OpenMPExecutableAllocate
-!CHECK-NEXT: | | | Verbatim
-!CHECK-NEXT: | | | OmpClauseList ->
-!CHECK-NEXT: | | | OpenMPDeclarativeAllocate
-!CHECK-NEXT: | | | | Verbatim
-!CHECK-NEXT: | | | | OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'w'
-!CHECK-NEXT: | | | | OmpClauseList -> OmpClause -> Allocator -> Scalar -> Integer -> Expr =
-!CHECK-NEXT: | | | | | Designator -> DataRef -> Name =
-!CHECK-NEXT: | | | OpenMPDeclarativeAllocate
-!CHECK-NEXT: | | | | Verbatim
-!CHECK-NEXT: | | | | OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'xarray'
-!CHECK-NEXT: | | | | OmpClauseList -> OmpClause -> Allocator -> Scalar -> Integer -> Expr =
-!CHECK-NEXT: | | | | | Designator -> DataRef -> Name =
-!CHECK-NEXT: | | | OpenMPDeclarativeAllocate
-!CHECK-NEXT: | | | | Verbatim
-!CHECK-NEXT: | | | | OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'zarray'
-!CHECK-NEXT: | | | | OmpClauseList -> OmpClause -> Allocator -> Scalar -> Integer -> Expr =
-!CHECK-NEXT: | | | | | Designator -> DataRef -> Name =
-!CHECK-NEXT: | | | AllocateStmt
+!CHECK: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OmpAllocateDirective
+!CHECK-NEXT: | OmpBeginDirective
+!CHECK-NEXT: | | OmpDirectiveName -> llvm::omp::Directive = allocate
+!CHECK-NEXT: | | OmpArgumentList -> OmpArgument -> OmpLocator -> OmpObject -> Designator -> DataRef -> Name = 'xarray'
+!CHECK-NEXT: | | OmpClauseList -> OmpClause -> Allocator -> Scalar -> Integer -> Expr = '2_8'
+!CHECK-NEXT: | | | Designator -> DataRef -> Name = 'omp_large_cap_mem_alloc'
+!CHECK-NEXT: | | Flags = None
+!CHECK-NEXT: | Block
+!CHECK-NEXT: | | ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OmpAllocateDirective
+!CHECK-NEXT: | | | OmpBeginDirective
+!CHECK-NEXT: | | | | OmpDirectiveName -> llvm::omp::Directive = allocate
+!CHECK-NEXT: | | | | OmpArgumentList -> OmpArgument -> OmpLocator -> OmpObject -> Designator -> DataRef -> Name = 'zarray'
+!CHECK-NEXT: | | | | OmpClauseList -> OmpClause -> Allocator -> Scalar -> Integer -> Expr = '1_8'
+!CHECK-NEXT: | | | | | Designator -> DataRef -> Name = 'omp_default_mem_alloc'
+!CHECK-NEXT: | | | | Flags = None
+!CHECK-NEXT: | | | Block
+!CHECK-NEXT: | | | | ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OmpAllocateDirective
+!CHECK-NEXT: | | | | | OmpBeginDirective
+!CHECK-NEXT: | | | | | | OmpDirectiveName -> llvm::omp::Directive = allocate
+!CHECK-NEXT: | | | | | | OmpClauseList ->
+!CHECK-NEXT: | | | | | | Flags = None
+!CHECK-NEXT: | | | | | Block
+!CHECK-NEXT: | | | | | | ExecutionPartConstruct -> ExecutableConstruct -> ActionStmt -> AllocateStmt
-!UNPARSE: !$OMP ALLOCATE (w) ALLOCATOR(3_8)
-!UNPARSE-NEXT: !$OMP ALLOCATE (xarray) ALLOCATOR(2_8)
-!UNPARSE-NEXT: !$OMP ALLOCATE (zarray) ALLOCATOR(1_8)
+!UNPARSE: !$OMP ALLOCATE(w) ALLOCATOR(3_8)
+!UNPARSE-NEXT: t=2_4
+!UNPARSE-NEXT: z=3_4
+!UNPARSE-NEXT: !$OMP ALLOCATE(xarray) ALLOCATOR(2_8)
+!UNPARSE-NEXT: !$OMP ALLOCATE(zarray) ALLOCATOR(1_8)
!UNPARSE-NEXT: !$OMP ALLOCATE
-!UNPARSE-NEXT: ALLOCATE(w, xarray(4_4), zarray(t,z))
+!UNPARSE-NEXT: ALLOCATE(xarray(4_4), zarray(t,z))
diff --git a/flang/test/Parser/OpenMP/allocate-unparse.f90 b/flang/test/Parser/OpenMP/allocate-unparse.f90
index 94bc2adf35ea9..2935613e84e47 100644
--- a/flang/test/Parser/OpenMP/allocate-unparse.f90
+++ b/flang/test/Parser/OpenMP/allocate-unparse.f90
@@ -30,17 +30,17 @@ program allocate_unparse
end program allocate_unparse
-!CHECK:!$OMP ALLOCATE (x,y)
-!CHECK:!$OMP ALLOCATE (x,y) ALLOCATOR(omp_default_mem_alloc)
-!CHECK:!$OMP ALLOCATE (a,b)
+!CHECK:!$OMP ALLOCATE(x, y)
+!CHECK:!$OMP ALLOCATE(x, y) ALLOCATOR(omp_default_mem_alloc)
+!CHECK:!$OMP ALLOCATE(a, b)
!CHECK:ALLOCATE(darray(a,b))
!CHECK:!$OMP ALLOCATE ALLOCATOR(omp_default_mem_alloc)
!CHECK:ALLOCATE(darray(a,b))
-!CHECK:!$OMP ALLOCATE (a,b) ALLOCATOR(omp_default_mem_alloc)
+!CHECK:!$OMP ALLOCATE(a, b) ALLOCATOR(omp_default_mem_alloc)
!CHECK:ALLOCATE(darray(a,b))
-!CHECK:!$OMP ALLOCATE (t) ALLOCATOR(omp_const_mem_alloc)
-!CHECK:!$OMP ALLOCATE (z) ALLOCATOR(omp_default_mem_alloc)
-!CHECK:!$OMP ALLOCATE (m) ALLOCATOR(omp_default_mem_alloc)
-!CHECK:!$OMP ALLOCATE (n)
-!CHECK:!$OMP ALLOCATE (j) ALIGN(16)
+!CHECK:!$OMP ALLOCATE(t) ALLOCATOR(omp_const_mem_alloc)
+!CHECK:!$OMP ALLOCATE(z) ALLOCATOR(omp_default_mem_alloc)
+!CHECK:!$OMP ALLOCATE(m) ALLOCATOR(omp_default_mem_alloc)
+!CHECK:!$OMP ALLOCATE(n)
+!CHECK:!$OMP ALLOCATE(j) ALIGN(16)
!CHECK:ALLOCATE(darray(z,t))
diff --git a/flang/test/Semantics/OpenMP/allocate-align01.f90 b/flang/test/Semantics/OpenMP/allocate-align01.f90
index 88bcd6d2f1008..4a1e60cf73fff 100644
--- a/flang/test/Semantics/OpenMP/allocate-align01.f90
+++ b/flang/test/Semantics/OpenMP/allocate-align01.f90
@@ -11,9 +11,9 @@ program allocate_align_tree
integer :: z, t, xx
t = 2
z = 3
+ !WARNING: The executable form of the OpenMP ALLOCATE directive has been deprecated, please use ALLOCATORS instead [-Wopen-mp-usage]
!ERROR: Must be a constant value
!$omp allocate(j) align(xx)
- !WARNING: The executable form of the OpenMP ALLOCATE directive has been deprecated, please use ALLOCATORS instead [-Wopen-mp-usage]
!ERROR: The alignment should be positive
!$omp allocate(xarray) align(-32) allocator(omp_large_cap_mem_alloc)
allocate(j(z), xarray(t))
diff --git a/flang/test/Semantics/OpenMP/allocate-directive.f90 b/flang/test/Semantics/OpenMP/allocate-directive.f90
index 18a14b825f00d..e34125b392bda 100644
--- a/flang/test/Semantics/OpenMP/allocate-directive.f90
+++ b/flang/test/Semantics/OpenMP/allocate-directive.f90
@@ -11,7 +11,7 @@
integer, allocatable :: a, b, m, n, t, z
!$omp allocate(x, y)
!$omp allocate(x, y) allocator(omp_default_mem_alloc)
-
+ continue
!$omp allocate(a, b)
allocate ( a, b )
diff --git a/flang/test/Semantics/OpenMP/allocate01.f90 b/flang/test/Semantics/OpenMP/allocate01.f90
index 229fd4d6c3f95..5fe4efdd106d9 100644
--- a/flang/test/Semantics/OpenMP/allocate01.f90
+++ b/flang/test/Semantics/OpenMP/allocate01.f90
@@ -17,7 +17,7 @@ subroutine sema()
!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
+ print *, a
!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)
diff --git a/flang/test/Semantics/OpenMP/allocate02.f90 b/flang/test/Semantics/OpenMP/allocate02.f90
index 8f0579e810bb9..a1e684796edb2 100644
--- a/flang/test/Semantics/OpenMP/allocate02.f90
+++ b/flang/test/Semantics/OpenMP/allocate02.f90
@@ -16,6 +16,7 @@ subroutine allocate()
!ERROR: At most one ALLOCATOR clause can appear on the ALLOCATE directive
!$omp allocate(x, y) allocator(omp_default_mem_alloc) allocator(omp_default_mem_alloc)
+ continue
!$omp allocate(darray) allocator(omp_default_mem_alloc)
allocate ( darray(a, b) )
diff --git a/flang/test/Semantics/OpenMP/allocate03.f90 b/flang/test/Semantics/OpenMP/allocate03.f90
index e35115f3897cc..3609f38eb6ee7 100644
--- a/flang/test/Semantics/OpenMP/allocate03.f90
+++ b/flang/test/Semantics/OpenMP/allocate03.f90
@@ -17,6 +17,7 @@ subroutine allocate()
!ERROR: A variable that is part of another variable (as an array or structure element) cannot appear on the ALLOCATE directive
!$omp allocate(my_var%array)
+ continue
!ERROR: A variable that is part of another variable (as an array or structure element) cannot appear on the ALLOCATE directive
!$omp allocate(darray, my_var%array) allocator(omp_default_mem_alloc)
diff --git a/flang/test/Semantics/OpenMP/allocate06.f90 b/flang/test/Semantics/OpenMP/allocate06.f90
index 9b57322bbadc6..272094aaaeec2 100644
--- a/flang/test/Semantics/OpenMP/allocate06.f90
+++ b/flang/test/Semantics/OpenMP/allocate06.f90
@@ -13,7 +13,7 @@ subroutine allocate()
!ERROR: A list item in a declarative ALLOCATE cannot have the ALLOCATABLE or POINTER attribute
!$omp allocate(darray) allocator(omp_default_mem_alloc)
-
+ continue
!$omp allocate(darray) allocator(omp_default_mem_alloc)
allocate(darray(a, b))
diff --git a/flang/test/Semantics/OpenMP/allocate10.f90 b/flang/test/Semantics/OpenMP/allocate10.f90
index a9db7330296ba..0a9e85b8ae2fe 100644
--- a/flang/test/Semantics/OpenMP/allocate10.f90
+++ b/flang/test/Semantics/OpenMP/allocate10.f90
@@ -4,8 +4,8 @@ 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
+ !ERROR: If multiple directives are present in an executable ALLOCATE directive, at most one of them may specify no list items
!$omp allocate
allocate(x, y)
end
diff --git a/flang/test/Semantics/OpenMP/allocate12.f90 b/flang/test/Semantics/OpenMP/allocate12.f90
new file mode 100644
index 0000000000000..2b3b510fbf40c
--- /dev/null
+++ b/flang/test/Semantics/OpenMP/allocate12.f90
@@ -0,0 +1,16 @@
+!RUN: %python %S/../test_errors.py %s %flang_fc1 %openmp_flags -fopenmp-version=51
+
+subroutine f00
+ integer, allocatable :: x
+ continue
+ !ERROR: An executable ALLOCATE directive must be associated with an ALLOCATE statement
+ !$omp allocate(x)
+end
+
+subroutine f01
+ integer, allocatable :: x
+ continue
+ !$omp allocate(x)
+ !ERROR: The statement associated with executable ALLOCATE directive must be an ALLOCATE statement
+ continue
+end
>From beb297ded9c38631b1f0b9461e90081967f87a6f Mon Sep 17 00:00:00 2001
From: Krzysztof Parzyszek <Krzysztof.Parzyszek at amd.com>
Date: Fri, 31 Oct 2025 09:04:11 -0500
Subject: [PATCH 4/7] format
---
flang/lib/Lower/OpenMP/OpenMP.cpp | 8 ++++----
flang/lib/Semantics/canonicalize-omp.cpp | 4 ++--
2 files changed, 6 insertions(+), 6 deletions(-)
diff --git a/flang/lib/Lower/OpenMP/OpenMP.cpp b/flang/lib/Lower/OpenMP/OpenMP.cpp
index b901f24ae366e..ad456d89bc432 100644
--- a/flang/lib/Lower/OpenMP/OpenMP.cpp
+++ b/flang/lib/Lower/OpenMP/OpenMP.cpp
@@ -3503,10 +3503,10 @@ static void genOMP(lower::AbstractConverter &converter, lower::SymMap &symTable,
lower::pft::Evaluation &eval,
const parser::OpenMPUtilityConstruct &);
-static void
-genOMP(lower::AbstractConverter &converter, lower::SymMap &symTable,
- semantics::SemanticsContext &semaCtx, lower::pft::Evaluation &eval,
- const parser::OmpAllocateDirective &allocate) {
+static void genOMP(lower::AbstractConverter &converter, lower::SymMap &symTable,
+ semantics::SemanticsContext &semaCtx,
+ lower::pft::Evaluation &eval,
+ const parser::OmpAllocateDirective &allocate) {
if (!semaCtx.langOptions().OpenMPSimd)
TODO(converter.getCurrentLocation(), "OmpAllocateDirective");
}
diff --git a/flang/lib/Semantics/canonicalize-omp.cpp b/flang/lib/Semantics/canonicalize-omp.cpp
index 039dd7f564758..77ca872ba5f49 100644
--- a/flang/lib/Semantics/canonicalize-omp.cpp
+++ b/flang/lib/Semantics/canonicalize-omp.cpp
@@ -294,8 +294,8 @@ class CanonicalizationOfOmp {
}
}
- parser::ExecutionPartConstruct EmbedInExec(parser::OmpAllocateDirective *alo,
- parser::ExecutionPartConstruct &&epc) {
+ parser::ExecutionPartConstruct EmbedInExec(
+ parser::OmpAllocateDirective *alo, parser::ExecutionPartConstruct &&epc) {
// Nest current epc inside the allocate directive.
std::get<parser::Block>(alo->t).push_front(std::move(epc));
// Set the new epc to be the ExecutionPartConstruct made from
>From 3a1d252128817fe120be457d3363526844692bbe Mon Sep 17 00:00:00 2001
From: Krzysztof Parzyszek <Krzysztof.Parzyszek at amd.com>
Date: Fri, 31 Oct 2025 10:55:30 -0500
Subject: [PATCH 5/7] Fix unparsing empty object list
---
flang/lib/Parser/unparse.cpp | 4 +---
flang/test/Parser/OpenMP/allocate-unparse.f90 | 6 ++++++
2 files changed, 7 insertions(+), 3 deletions(-)
diff --git a/flang/lib/Parser/unparse.cpp b/flang/lib/Parser/unparse.cpp
index b3a395c4d72e1..9255c4e1136bc 100644
--- a/flang/lib/Parser/unparse.cpp
+++ b/flang/lib/Parser/unparse.cpp
@@ -2502,9 +2502,7 @@ class UnparseVisitor {
void Unparse(const OpenMPDeclarativeAllocate &x) {
BeginOpenMP();
Word("!$OMP ALLOCATE");
- Put(" (");
- Walk(std::get<std::optional<OmpObjectList>>(x.t));
- Put(")");
+ Walk(" (", std::get<std::optional<OmpObjectList>>(x.t), ")");
Walk(std::get<OmpClauseList>(x.t));
Put("\n");
EndOpenMP();
diff --git a/flang/test/Parser/OpenMP/allocate-unparse.f90 b/flang/test/Parser/OpenMP/allocate-unparse.f90
index 94bc2adf35ea9..63cc35cd55082 100644
--- a/flang/test/Parser/OpenMP/allocate-unparse.f90
+++ b/flang/test/Parser/OpenMP/allocate-unparse.f90
@@ -9,6 +9,7 @@ program allocate_unparse
! 2.11.3 declarative allocate
+!$omp allocate
!$omp allocate(x, y)
!$omp allocate(x, y) allocator(omp_default_mem_alloc)
@@ -28,8 +29,11 @@ program allocate_unparse
!$omp allocate(j) align(16)
allocate ( darray(z, t) )
+!$omp allocate
+ allocate ( darray(a, b) )
end program allocate_unparse
+!CHECK:!$OMP ALLOCATE{{[ ]*$}}
!CHECK:!$OMP ALLOCATE (x,y)
!CHECK:!$OMP ALLOCATE (x,y) ALLOCATOR(omp_default_mem_alloc)
!CHECK:!$OMP ALLOCATE (a,b)
@@ -44,3 +48,5 @@ end program allocate_unparse
!CHECK:!$OMP ALLOCATE (n)
!CHECK:!$OMP ALLOCATE (j) ALIGN(16)
!CHECK:ALLOCATE(darray(z,t))
+!CHECK:!$OMP ALLOCATE{{[ ]*$}}
+!CHECK:ALLOCATE(darray(a,b))
>From fc66fb6325e1b15fdea16ab1add5b96af852d425 Mon Sep 17 00:00:00 2001
From: Krzysztof Parzyszek <Krzysztof.Parzyszek at amd.com>
Date: Fri, 31 Oct 2025 12:00:14 -0500
Subject: [PATCH 6/7] review feedback
---
flang/lib/Semantics/canonicalize-omp.cpp | 2 +-
flang/lib/Semantics/check-omp-structure.cpp | 3 +--
2 files changed, 2 insertions(+), 3 deletions(-)
diff --git a/flang/lib/Semantics/canonicalize-omp.cpp b/flang/lib/Semantics/canonicalize-omp.cpp
index 77ca872ba5f49..a11c5250b1ab4 100644
--- a/flang/lib/Semantics/canonicalize-omp.cpp
+++ b/flang/lib/Semantics/canonicalize-omp.cpp
@@ -280,7 +280,7 @@ class CanonicalizationOfOmp {
// show up in the tuple in specification part:
// (1) in std::list<OpenMPDeclarativeConstruct>, or
// (2) in std::list<DeclarationConstruct>.
- // The case (1) is only possible is the list (2) is empty.
+ // The case (1) is only possible if the list (2) is empty.
auto &omps =
std::get<std::list<parser::OpenMPDeclarativeConstruct>>(spec.t);
diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index 40d574a481582..e7e3f4d886b34 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -1841,7 +1841,7 @@ void OmpStructureChecker::CheckExecutableAllocateDirective(
for (const parser::OmpArgument &arg : spec.Arguments().v) {
if (auto *sym{GetArgumentSymbol(arg)}) {
// Ignore these checks for structure members. They are not allowed
- // in the first place, so don't tell the users that they nened to
+ // in the first place, so don't tell the users that they need to
// be specified somewhere,
if (IsStructureComponent(*sym)) {
continue;
@@ -2225,7 +2225,6 @@ void OmpStructureChecker::Enter(const parser::OmpClause::At &x) {
}
void OmpStructureChecker::Enter(const parser::OpenMPAllocatorsConstruct &x) {
-
const parser::OmpDirectiveSpecification &beginSpec{x.BeginDir()};
const parser::OmpDirectiveName &dirName{beginSpec.DirName()};
PushContextAndClauseSets(
>From c6b9d1b887933c5fa2830678242fdd43d560147c Mon Sep 17 00:00:00 2001
From: Krzysztof Parzyszek <Krzysztof.Parzyszek at amd.com>
Date: Mon, 3 Nov 2025 07:18:05 -0600
Subject: [PATCH 7/7] fix merge error
---
flang/lib/Semantics/check-omp-structure.cpp | 72 ---------------------
1 file changed, 72 deletions(-)
diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index 661eb69170dc4..e7e3f4d886b34 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -2251,78 +2251,6 @@ void OmpStructureChecker::Enter(const parser::OpenMPAllocatorsConstruct &x) {
}
}
}
-}
-
-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);
- }
auto &body{std::get<parser::Block>(x.t)};
// The parser should put at most one statement in the body.
More information about the flang-commits
mailing list