diff --git a/flang/include/flang/Parser/dump-parse-tree.h b/flang/include/flang/Parser/dump-parse-tree.h --- a/flang/include/flang/Parser/dump-parse-tree.h +++ b/flang/include/flang/Parser/dump-parse-tree.h @@ -549,6 +549,8 @@ NODE(parser, OpenMPCancellationPointConstruct) NODE(parser, OpenMPConstruct) NODE(parser, OpenMPCriticalConstruct) + NODE(parser, OpenMPDeclarativeAllocate) + NODE(OpenMPDeclarativeAllocate, AllocatorClause) NODE(parser, OpenMPDeclarativeConstruct) NODE(parser, OpenMPDeclareReductionConstruct) NODE(parser, OpenMPDeclareSimdConstruct) @@ -556,6 +558,8 @@ NODE(parser, OmpFlushMemoryClause) NODE(parser, OpenMPFlushConstruct) NODE(parser, OpenMPLoopConstruct) + NODE(parser, OpenMPExecutableAllocate) + NODE(OpenMPExecutableAllocate, AllocatorClause) NODE(parser, OpenMPSimpleStandaloneConstruct) NODE(parser, OpenMPStandaloneConstruct) NODE(parser, OpenMPSectionsConstruct) diff --git a/flang/include/flang/Parser/parse-tree.h b/flang/include/flang/Parser/parse-tree.h --- a/flang/include/flang/Parser/parse-tree.h +++ b/flang/include/flang/Parser/parse-tree.h @@ -3583,11 +3583,20 @@ std::tuple t; }; +// 2.11.3 allocate -> ALLOCATE (variable-name-list) [clause] +struct OpenMPDeclarativeAllocate { + TUPLE_CLASS_BOILERPLATE(OpenMPDeclarativeAllocate); + WRAPPER_CLASS(AllocatorClause, ScalarIntExpr); + CharBlock source; + std::tuple> t; +}; + struct OpenMPDeclarativeConstruct { UNION_CLASS_BOILERPLATE(OpenMPDeclarativeConstruct); CharBlock source; - std::variant + std::variant u; }; @@ -3610,6 +3619,18 @@ std::tuple t; }; +// 2.11.3 allocate -> ALLOCATE [(variable-name-list)] [clause] +// allocate-statement +// clause -> allocator-clause +struct OpenMPExecutableAllocate { + TUPLE_CLASS_BOILERPLATE(OpenMPExecutableAllocate); + WRAPPER_CLASS(AllocatorClause, ScalarIntExpr); + CharBlock source; + std::tuple, + std::optional, Statement> + t; +}; + // 2.17.7 atomic -> ATOMIC [clause[,]] atomic-clause [[,]clause] | // ATOMIC [clause] // clause -> memory-order-clause | HINT(hint-expression) @@ -3796,7 +3817,7 @@ UNION_CLASS_BOILERPLATE(OpenMPConstruct); std::variant + OpenMPExecutableAllocate, OpenMPCriticalConstruct> u; }; diff --git a/flang/lib/Lower/OpenMP.cpp b/flang/lib/Lower/OpenMP.cpp --- a/flang/lib/Lower/OpenMP.cpp +++ b/flang/lib/Lower/OpenMP.cpp @@ -138,6 +138,8 @@ [&](const Fortran::parser::OpenMPLoopConstruct &loopConstruct) { TODO(); }, + [&](const Fortran::parser::OpenMPExecutableAllocate + &execAllocConstruct) { TODO(); }, [&](const Fortran::parser::OpenMPBlockConstruct &blockConstruct) { genOMP(converter, eval, blockConstruct); }, diff --git a/flang/lib/Parser/openmp-parsers.cpp b/flang/lib/Parser/openmp-parsers.cpp --- a/flang/lib/Parser/openmp-parsers.cpp +++ b/flang/lib/Parser/openmp-parsers.cpp @@ -473,6 +473,15 @@ TYPE_PARSER(construct( Parser{}, block, Parser{})) +// Allocator Clause +/*TYPE_PARSER(construct(ScalarIntExpr))*/ + +// 2.11.3 Executable Allocate directive +TYPE_PARSER(sourced(construct( + verbatim("ALLOCATE"_tok), maybe(parenthesized(Parser{})), + maybe("ALLOCATOR" >> parenthesized(scalarIntExpr)) / endOmpLine, + statement(allocateStmt)))) + // 2.8.2 Declare Simd construct TYPE_PARSER( sourced(construct(verbatim("DECLARE SIMD"_tok), @@ -482,6 +491,13 @@ TYPE_PARSER(sourced(construct( verbatim("THREADPRIVATE"_tok), parenthesized(Parser{})))) +// 2.11.3 Declarative Allocate directive +TYPE_PARSER( + sourced(construct(verbatim("ALLOCATE"_tok), + parenthesized(Parser{}), + maybe("ALLOCATOR" >> parenthesized(scalarIntExpr)))) / + lookAhead(endOmpLine / !statement(allocateStmt))) + // Declarative constructs TYPE_PARSER(startOmpLine >> sourced(construct( @@ -490,6 +506,8 @@ Parser{}) || construct( Parser{}) || + construct( + Parser{}) || construct(Parser{})) / endOmpLine) @@ -530,6 +548,7 @@ // OpenMPStandaloneConstruct to resolve !$OMP ORDERED construct(Parser{}), construct(Parser{}), + construct(Parser{}), construct(Parser{}))) // END OMP Block directives diff --git a/flang/lib/Parser/type-parsers.h b/flang/lib/Parser/type-parsers.h --- a/flang/lib/Parser/type-parsers.h +++ b/flang/lib/Parser/type-parsers.h @@ -91,6 +91,7 @@ constexpr Parser expr; // R1022 constexpr Parser specificationExpr; // R1028 constexpr Parser assignmentStmt; // R1032 +constexpr Parser allocateStmt; constexpr Parser pointerAssignmentStmt; // R1033 constexpr Parser whereStmt; // R1041, R1045, R1046 constexpr Parser whereConstruct; // R1042 diff --git a/flang/lib/Parser/unparse.cpp b/flang/lib/Parser/unparse.cpp --- a/flang/lib/Parser/unparse.cpp +++ b/flang/lib/Parser/unparse.cpp @@ -2313,6 +2313,17 @@ Walk(std::get>(x.t), "!$OMP END ATOMIC\n"); EndOpenMP(); } + void Unparse(const OpenMPExecutableAllocate &x) { + BeginOpenMP(); + Word("!$OMP ALLOCATE"); + Walk(" (", std::get>(x.t), ") "); + Walk(" ALLOCATOR (", + std::get>(x.t), + ") "); + Put("\n"); + EndOpenMP(); + Walk(std::get>(x.t)); + } void Unparse(const OmpCriticalDirective &x) { BeginOpenMP(); Word("!$OMP CRITICAL"); @@ -2364,28 +2375,41 @@ bool Pre(const OpenMPDeclarativeConstruct &x) { BeginOpenMP(); Word("!$OMP "); - return std::visit(common::visitors{ - [&](const OpenMPDeclareReductionConstruct &) { - Word("DECLARE REDUCTION "); - return true; - }, - [&](const OpenMPDeclareSimdConstruct &y) { - Word("DECLARE SIMD "); - Walk("(", std::get>(y.t), ")"); - Walk(std::get(y.t)); - Put("\n"); - EndOpenMP(); - return false; - }, - [&](const OpenMPDeclareTargetConstruct &) { - Word("DECLARE TARGET "); - return true; - }, - [&](const OpenMPThreadprivate &) { - Word("THREADPRIVATE ("); - return true; - }, - }, + return std::visit( + common::visitors{ + [&](const OpenMPDeclarativeAllocate &z) { + Word("ALLOCATE ("); + Walk(std::get(z.t)); + Put(")"); + Walk(" ALLOCATOR (", + std::get>(z.t), + ") "); + Put("\n"); + EndOpenMP(); + return false; + }, + [&](const OpenMPDeclareReductionConstruct &) { + Word("DECLARE REDUCTION "); + return true; + }, + [&](const OpenMPDeclareSimdConstruct &y) { + Word("DECLARE SIMD "); + Walk("(", std::get>(y.t), ")"); + Walk(std::get(y.t)); + Put("\n"); + EndOpenMP(); + return false; + }, + [&](const OpenMPDeclareTargetConstruct &) { + Word("DECLARE TARGET "); + return true; + }, + [&](const OpenMPThreadprivate &) { + Word("THREADPRIVATE ("); + return true; + }, + }, x.u); } void Post(const OpenMPDeclarativeConstruct &) { diff --git a/flang/test/Parser/omp-allocate-unparse.f90 b/flang/test/Parser/omp-allocate-unparse.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Parser/omp-allocate-unparse.f90 @@ -0,0 +1,26 @@ +! RUN: %f18 -fdebug-no-semantics -funparse -fopenmp %s | FileCheck %s +! Check Unparsing of OpenMP Allocate directive + +program allocate_unparse +use omp_lib + +real, dimension (:,:), allocatable :: darray +integer :: a, b, x, y + +! 2.11.3 declarative allocate + +!$omp allocate(x, y) +!$omp allocate(x, y) allocator(omp_default_mem_alloc) + +! 2.11.3 executable allocate + +!$omp allocate(a, b) + allocate ( darray(a, b) ) +!$omp allocate allocator(omp_default_mem_alloc) + allocate ( darray(a, b) ) +!$omp allocate(a, b) allocator(omp_default_mem_alloc) + allocate ( darray(a, b) ) + +end program allocate_unparse + +!CHECK: !$OMP ALLOCATE \ No newline at end of file diff --git a/flang/test/Semantics/omp-allocate-directive.f90 b/flang/test/Semantics/omp-allocate-directive.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/omp-allocate-directive.f90 @@ -0,0 +1,19 @@ +! RUN: %S/test_errors.sh %s %t %f18 -fopenmp +! Check OpenMP Allocate directive +use omp_lib + +! 2.11.3 declarative allocate +! 2.11.3 executable allocate + +real, dimension (:,:), allocatable :: darray +integer :: a, b, x, y +!$omp allocate(x, y) +!$omp allocate(x, y) allocator(omp_default_mem_alloc) + +!$omp allocate(a, b) + allocate ( darray(a, b) ) + +!$omp allocate(a, b) allocator(omp_default_mem_alloc) + allocate ( darray(a, b) ) + +end