[flang-commits] [flang] 3d3fab1 - [flang][OpenMP] Use OmpDirectiveSpecification in ALLOCATE (#165865)
via flang-commits
flang-commits at lists.llvm.org
Mon Nov 3 05:37:17 PST 2025
Author: Krzysztof Parzyszek
Date: 2025-11-03T07:37:13-06:00
New Revision: 3d3fab17f5ea8a14eb390f53075c094f5e1f19fa
URL: https://github.com/llvm/llvm-project/commit/3d3fab17f5ea8a14eb390f53075c094f5e1f19fa
DIFF: https://github.com/llvm/llvm-project/commit/3d3fab17f5ea8a14eb390f53075c094f5e1f19fa.diff
LOG: [flang][OpenMP] Use OmpDirectiveSpecification in ALLOCATE (#165865)
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 directives 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 OmpAllocateDirectives, 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.
Added:
flang/test/Semantics/OpenMP/allocate12.f90
Modified:
flang/examples/FeatureList/FeatureList.cpp
flang/include/flang/Parser/dump-parse-tree.h
flang/include/flang/Parser/openmp-utils.h
flang/include/flang/Parser/parse-tree.h
flang/lib/Lower/OpenMP/OpenMP.cpp
flang/lib/Parser/openmp-parsers.cpp
flang/lib/Parser/openmp-utils.cpp
flang/lib/Parser/unparse.cpp
flang/lib/Semantics/canonicalize-omp.cpp
flang/lib/Semantics/check-omp-structure.cpp
flang/lib/Semantics/check-omp-structure.h
flang/lib/Semantics/resolve-directives.cpp
flang/lib/Semantics/resolve-names.cpp
flang/test/Lower/OpenMP/Todo/omp-declarative-allocate-align.f90
flang/test/Lower/OpenMP/Todo/omp-declarative-allocate.f90
flang/test/Parser/OpenMP/allocate-align-tree.f90
flang/test/Parser/OpenMP/allocate-tree-spec-part.f90
flang/test/Parser/OpenMP/allocate-tree.f90
flang/test/Parser/OpenMP/allocate-unparse.f90
flang/test/Semantics/OpenMP/allocate-align01.f90
flang/test/Semantics/OpenMP/allocate-directive.f90
flang/test/Semantics/OpenMP/allocate01.f90
flang/test/Semantics/OpenMP/allocate02.f90
flang/test/Semantics/OpenMP/allocate03.f90
flang/test/Semantics/OpenMP/allocate06.f90
flang/test/Semantics/OpenMP/allocate10.f90
Removed:
################################################################################
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..ad456d89bc432 100644
--- a/flang/lib/Lower/OpenMP/OpenMP.cpp
+++ b/flang/lib/Lower/OpenMP/OpenMP.cpp
@@ -3503,12 +3503,12 @@ 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::OpenMPDeclarativeAllocate &declarativeAllocate) {
+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(), "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 9255c4e1136bc..84123030195e9 100644
--- a/flang/lib/Parser/unparse.cpp
+++ b/flang/lib/Parser/unparse.cpp
@@ -2482,30 +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");
- Walk(" (", std::get<std::optional<OmpObjectList>>(x.t), ")");
- 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..a11c5250b1ab4 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 if 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..e7e3f4d886b34 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(dirName.source, *object);
+ }
+ }
+}
+
+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};
+
+ 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 need 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));
+ }
+
+ 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);
+ }
}
- CheckVarIsNotPartOfAnotherVar(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::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};
- 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))};
+ 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);
+ }
- CheckAllocateDirective(dir.source, objects, clauses);
+ 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::OpenMPDeclarativeAllocate &x) {
+void OmpStructureChecker::Leave(const parser::OmpAllocateDirective &x) {
+ bool isExecutable{partStack_.back() == PartKind::ExecutionPart};
+ if (isExecutable && allocateDirectiveLevel == 1) {
+ CheckExecutableAllocateDirective(x);
+ }
+
+ --allocateDirectiveLevel;
dirContext_.pop_back();
}
@@ -2135,112 +2224,6 @@ 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()};
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 220f1c96b9823..a2062ef28d52c 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 63cc35cd55082..b61a97150cad2 100644
--- a/flang/test/Parser/OpenMP/allocate-unparse.f90
+++ b/flang/test/Parser/OpenMP/allocate-unparse.f90
@@ -34,19 +34,19 @@ program allocate_unparse
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)
+!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))
!CHECK:!$OMP ALLOCATE{{[ ]*$}}
!CHECK:ALLOCATE(darray(a,b))
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
More information about the flang-commits
mailing list