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 @@ -3805,7 +3805,7 @@ UNION_CLASS_BOILERPLATE(OpenMPConstruct); std::variant u; }; diff --git a/flang/include/flang/Semantics/symbol.h b/flang/include/flang/Semantics/symbol.h --- a/flang/include/flang/Semantics/symbol.h +++ b/flang/include/flang/Semantics/symbol.h @@ -507,9 +507,10 @@ // OpenMP data-copying attribute OmpCopyIn, OmpCopyPrivate, // OpenMP miscellaneous flags - OmpCommonBlock, OmpReduction, OmpAllocate, OmpDeclareSimd, - OmpDeclareTarget, OmpThreadprivate, OmpDeclareReduction, OmpFlushed, - OmpCriticalLock, OmpIfSpecified, OmpNone, OmpPreDetermined, OmpAligned); + OmpCommonBlock, OmpReduction, OmpAligned, OmpAllocate, + OmpAllocateDirective, OmpDeclareSimd, OmpDeclareTarget, OmpThreadprivate, + OmpDeclareReduction, OmpFlushed, OmpCriticalLock, OmpIfSpecified, OmpNone, + OmpPreDetermined); using Flags = common::EnumSet; const Scope &owner() const { return *owner_; } diff --git a/flang/lib/Semantics/check-omp-structure.h b/flang/lib/Semantics/check-omp-structure.h --- a/flang/lib/Semantics/check-omp-structure.h +++ b/flang/lib/Semantics/check-omp-structure.h @@ -178,7 +178,8 @@ void CheckDependList(const parser::DataRef &); void CheckDependArraySection( const common::Indirection &, const parser::Name &); - void CheckIsVarPartOfAnotherVar(const parser::OmpObjectList &objList); + void CheckIsVarPartOfAnotherVar( + const parser::CharBlock &source, const parser::OmpObjectList &objList); void CheckIntentInPointer( const parser::OmpObjectList &, const llvm::omp::Clause); void GetSymbolsInObjectList(const parser::OmpObjectList &, SymbolSourceMap &); diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp --- a/flang/lib/Semantics/check-omp-structure.cpp +++ b/flang/lib/Semantics/check-omp-structure.cpp @@ -462,10 +462,12 @@ void OmpStructureChecker::Enter(const parser::OpenMPDeclarativeAllocate &x) { const auto &dir{std::get(x.t)}; + const auto &objectList{std::get(x.t)}; PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_allocate); + CheckIsVarPartOfAnotherVar(dir.source, objectList); } -void OmpStructureChecker::Leave(const parser::OpenMPDeclarativeAllocate &) { +void OmpStructureChecker::Leave(const parser::OpenMPDeclarativeAllocate &x) { dirContext_.pop_back(); } @@ -484,7 +486,10 @@ void OmpStructureChecker::Enter(const parser::OpenMPExecutableAllocate &x) { const auto &dir{std::get(x.t)}; + const auto &objectList{std::get>(x.t)}; PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_allocate); + if (objectList) + CheckIsVarPartOfAnotherVar(dir.source, *objectList); } void OmpStructureChecker::Leave(const parser::OpenMPExecutableAllocate &) { @@ -954,26 +959,37 @@ void OmpStructureChecker::Enter(const parser::OmpClause::Shared &x) { CheckAllowed(llvm::omp::Clause::OMPC_shared); - CheckIsVarPartOfAnotherVar(x.v); + CheckIsVarPartOfAnotherVar(GetContext().clauseSource, x.v); } void OmpStructureChecker::Enter(const parser::OmpClause::Private &x) { CheckAllowed(llvm::omp::Clause::OMPC_private); - CheckIsVarPartOfAnotherVar(x.v); + CheckIsVarPartOfAnotherVar(GetContext().clauseSource, x.v); CheckIntentInPointer(x.v, llvm::omp::Clause::OMPC_private); } void OmpStructureChecker::CheckIsVarPartOfAnotherVar( - const parser::OmpObjectList &objList) { + const parser::CharBlock &source, const parser::OmpObjectList &objList) { + for (const auto &ompObject : objList.v) { - if ((parser::Unwrap(ompObject)) || - (parser::Unwrap(ompObject))) { - context_.Say(GetContext().clauseSource, - "A variable that is part of another variable (as an " - "array or structure element)" - " cannot appear in a PRIVATE or SHARED clause."_err_en_US); - } + std::visit( + common::visitors{ + [&](const parser::Designator &designator) { + if (std::get_if(&designator.u)) { + if ((parser::Unwrap(ompObject)) || + (parser::Unwrap(ompObject))) { + context_.Say(source, + "A variable that is part of another variable (as an " + "array or structure element)" + " cannot appear in a PRIVATE or SHARED clause or on the ALLOCATE directive."_err_en_US); + } + } + }, + [&](const parser::Name &name) {}, + }, + ompObject.u); } } + void OmpStructureChecker::Enter(const parser::OmpClause::Firstprivate &x) { CheckAllowed(llvm::omp::Clause::OMPC_firstprivate); CheckIsLoopIvPartOfClause(llvmOmpClause::OMPC_firstprivate, x.v); diff --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp --- a/flang/lib/Semantics/resolve-directives.cpp +++ b/flang/lib/Semantics/resolve-directives.cpp @@ -318,6 +318,12 @@ 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::OpenMPExecutableAllocate &); + void Post(const parser::OpenMPExecutableAllocate &); + // 2.15.3 Data-Sharing Attribute Clauses void Post(const parser::OmpDefaultClause &); bool Pre(const parser::OmpClause::Shared &x) { @@ -479,6 +485,7 @@ const parser::OpenMPLoopConstruct &); void ResolveSeqLoopIndexInParallelOrTaskConstruct(const parser::Name &); + bool IsNestedInDirective(llvm::omp::Directive directive); void ResolveOmpObjectList(const parser::OmpObjectList &, Symbol::Flag); void ResolveOmpObject(const parser::OmpObject &, Symbol::Flag); Symbol *ResolveOmp(const parser::Name &, Symbol::Flag, Scope &); @@ -487,6 +494,7 @@ void ResolveOmpNameList(const std::list &, Symbol::Flag); void ResolveOmpName(const parser::Name &, Symbol::Flag); Symbol *ResolveName(const parser::Name *); + Symbol *ResolveOmpObjectScope(const parser::Name *); Symbol *DeclareOrMarkOtherAccessEntity(const parser::Name &, Symbol::Flag); Symbol *DeclareOrMarkOtherAccessEntity(Symbol &, Symbol::Flag); void CheckMultipleAppearances( @@ -1287,6 +1295,21 @@ return true; } +bool OmpAttributeVisitor::Pre(const parser::OpenMPDeclarativeAllocate &x) { + PushContext(x.source, llvm::omp::Directive::OMPD_allocate); + const auto &list{std::get(x.t)}; + ResolveOmpObjectList(list, Symbol::Flag::OmpAllocateDirective); + return false; +} + +bool OmpAttributeVisitor::Pre(const parser::OpenMPExecutableAllocate &x) { + PushContext(x.source, llvm::omp::Directive::OMPD_allocate); + const auto &list{std::get>(x.t)}; + if (list) + ResolveOmpObjectList(*list, Symbol::Flag::OmpAllocateDirective); + return true; +} + void OmpAttributeVisitor::Post(const parser::OmpDefaultClause &x) { if (!dirContext_.empty()) { switch (x.v) { @@ -1306,6 +1329,36 @@ } } +bool OmpAttributeVisitor::IsNestedInDirective(llvm::omp::Directive directive) { + if (dirContext_.size() >= 1) { + for (std::size_t i = dirContext_.size() - 1; i > 0; --i) { + if (dirContext_[i - 1].directive == directive) + return true; + } + } + return false; +} + +void OmpAttributeVisitor::Post(const parser::OpenMPExecutableAllocate &x) { + bool hasAllocator = false; + // TODO: Investigate whether searching the clause list can be done with + // parser::Unwrap instead of the following loop + const auto &clauseList{std::get(x.t)}; + for (const auto &clause : clauseList.v) { + if (std::get_if(&clause.u)) + hasAllocator = true; + } + + if (IsNestedInDirective(llvm::omp::Directive::OMPD_target) && !hasAllocator) + // TODO: expand this check to exclude the case when a requires + // directive with the dynamic_allocators clause is present + // in the same compilation unit (OMP5.0 2.11.3). + context_.Say(x.source, + "ALLOCATE directives that appear in a TARGET region " + "must specify an allocator clause"_err_en_US); + PopContext(); +} + // For OpenMP constructs, check all the data-refs within the constructs // and adjust the symbol for each Name if necessary void OmpAttributeVisitor::Post(const parser::Name &name) { @@ -1375,6 +1428,31 @@ return nullptr; } +// Use this function over ResolveOmpName when an omp object's scope needs +// resolving, it's symbol flag isn't important and a simple check for resolution +// failure is desired. Using ResolveOmpName means needing to work with the +// context to check for failure, whereas here a pointer comparison is all that's +// needed. +Symbol *OmpAttributeVisitor::ResolveOmpObjectScope(const parser::Name *name) { + + // TODO: Investigate whether the following block can be replaced by, or + // included in, the ResolveOmpName function + if (auto *prev{name ? GetContext().scope.parent().FindSymbol(name->source) + : nullptr}) { + name->symbol = prev; + return nullptr; + } + + // TODO: Investigate whether the following block can be replaced by, or + // included in, the ResolveOmpName function + if (auto *ompSymbol{ + name ? GetContext().scope.FindSymbol(name->source) : nullptr}) { + name->symbol = ompSymbol; + return ompSymbol; + } + return nullptr; +} + void OmpAttributeVisitor::ResolveOmpObjectList( const parser::OmpObjectList &ompObjectList, Symbol::Flag ompFlag) { for (const auto &ompObject : ompObjectList.v) { @@ -1404,6 +1482,12 @@ AddAllocateName(name); } } + if (ompFlag == Symbol::Flag::OmpAllocateDirective && + ResolveOmpObjectScope(name) == nullptr) { + context_.Say(designator.source, // 2.15.3 + "List items must be declared in the same scoping unit " + "in which the ALLOCATE directive appears"_err_en_US); + } } } else { // Array sections to be changed to substrings as needed diff --git a/flang/test/Semantics/omp-allocate01.f90 b/flang/test/Semantics/omp-allocate01.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/omp-allocate01.f90 @@ -0,0 +1,24 @@ +! RUN: %S/test_errors.sh %s %t %f18 -fopenmp +! OpenMP Version 5.0 +! 2.11.3 allocate Directive +! The allocate directive must appear in the same scope as the declarations of +! each of its list items and must follow all such declarations. + +subroutine allocate() +use omp_lib + integer :: x + contains + subroutine sema() + integer :: a, b + real, dimension (:,:), allocatable :: darray + + !ERROR: List items must be declared in the same scoping unit in which the ALLOCATE directive appears + !$omp allocate(x) + print *, a + + !ERROR: List items must be declared in the same scoping unit in which the ALLOCATE directive appears + !$omp allocate(x) allocator(omp_default_mem_alloc) + allocate ( darray(a, b) ) + end subroutine sema + +end subroutine allocate diff --git a/flang/test/Semantics/omp-allocate02.f90 b/flang/test/Semantics/omp-allocate02.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/omp-allocate02.f90 @@ -0,0 +1,24 @@ +! RUN: %S/test_errors.sh %s %t %f18 -fopenmp +! OpenMP Version 5.0 +! 2.11.3 allocate Directive +! At most one allocator clause can appear on the allocate directive. + +subroutine allocate() +use omp_lib + integer :: x, y + integer :: a, b + real, dimension (:,:), allocatable :: darray + + !$omp allocate(x, y) allocator(omp_default_mem_alloc) + + !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) + + !$omp allocate(x) allocator(omp_default_mem_alloc) + allocate ( darray(a, b) ) + + !ERROR: At most one ALLOCATOR clause can appear on the ALLOCATE directive + !$omp allocate(x) allocator(omp_default_mem_alloc) allocator(omp_default_mem_alloc) + allocate ( darray(a, b) ) + +end subroutine allocate diff --git a/flang/test/Semantics/omp-allocate03.f90 b/flang/test/Semantics/omp-allocate03.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/omp-allocate03.f90 @@ -0,0 +1,24 @@ +! RUN: %S/test_errors.sh %s %t %f18 -fopenmp +! OpenMP Version 5.0 +! 2.11.3 allocate Directive +! A variable that is part of another variable (as an array or +! structure element) cannot appear in an allocate directive. +subroutine allocate() +use omp_lib + + type my_type + integer :: array(10) + end type my_type + type(my_type) :: my_var + real, dimension (:,:), allocatable :: darray + integer :: a, b + + !!ERROR: A variable that is part of another variable (as an array or structure element) cannot appear in an ALLOCATE directive + !ERROR: A variable that is part of another variable (as an array or structure element) cannot appear in a PRIVATE or SHARED clause or on the ALLOCATE directive. + !$omp allocate(my_var%array) + + !ERROR: A variable that is part of another variable (as an array or structure element) cannot appear in a PRIVATE or SHARED clause or on the ALLOCATE directive. + !$omp allocate(darray, my_var%array) allocator(omp_default_mem_alloc) + allocate ( darray(a, b) ) + +end subroutine allocate diff --git a/flang/test/Semantics/omp-allocate04.f90 b/flang/test/Semantics/omp-allocate04.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/omp-allocate04.f90 @@ -0,0 +1,14 @@ +! RUN: %S/test_errors.sh %s %t %f18 -fopenmp +! OpenMP Version 5.0 +! 2.11.3 allocate Directive +! Only the allocator clause is allowed on the allocate directive +subroutine allocate() +use omp_lib + + integer :: x, y + + !$omp allocate(x) allocator(omp_default_mem_alloc) + + !ERROR: PRIVATE clause is not allowed on the ALLOCATE directive + !$omp allocate(y) private(y) +end subroutine allocate diff --git a/flang/test/Semantics/omp-allocate05.f90 b/flang/test/Semantics/omp-allocate05.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/omp-allocate05.f90 @@ -0,0 +1,24 @@ +! RUN: %S/test_errors.sh %s %t %f18 -fopenmp +! OpenMP Version 5.0 +! 2.11.3 allocate Directive +! allocate directives that appear in a target region must specify an allocator +! clause unless a requires directive with the dynamic_allocators clause is present +! in the same compilation unit. + +subroutine allocate() +use omp_lib + integer :: a, b + real, dimension (:,:), allocatable :: darray + + !$omp target + !$omp allocate allocator(omp_default_mem_alloc) + allocate ( darray(a, b) ) + !$omp end target + + !$omp target + !ERROR: ALLOCATE directives that appear in a TARGET region must specify an allocator clause + !$omp allocate + allocate ( darray(a, b) ) + !$omp end target + +end subroutine allocate diff --git a/flang/test/Semantics/omp-parallel-private01.f90 b/flang/test/Semantics/omp-parallel-private01.f90 --- a/flang/test/Semantics/omp-parallel-private01.f90 +++ b/flang/test/Semantics/omp-parallel-private01.f90 @@ -10,7 +10,7 @@ type(my_type) :: my_var - !ERROR: A variable that is part of another variable (as an array or structure element) cannot appear in a PRIVATE or SHARED clause. + !ERROR: A variable that is part of another variable (as an array or structure element) cannot appear in a PRIVATE or SHARED clause or on the ALLOCATE directive. !$omp parallel private(my_var%array) do i = 1, 10 c(i) = a(i) + b(i) + k diff --git a/flang/test/Semantics/omp-parallel-private02.f90 b/flang/test/Semantics/omp-parallel-private02.f90 --- a/flang/test/Semantics/omp-parallel-private02.f90 +++ b/flang/test/Semantics/omp-parallel-private02.f90 @@ -10,7 +10,7 @@ array(i) = i end do - !ERROR: A variable that is part of another variable (as an array or structure element) cannot appear in a PRIVATE or SHARED clause. + !ERROR: A variable that is part of another variable (as an array or structure element) cannot appear in a PRIVATE or SHARED clause or on the ALLOCATE directive. !$omp parallel private(array(i)) do i = 1, 10 c(i) = a(i) + b(i) + k diff --git a/flang/test/Semantics/omp-parallel-private03.f90 b/flang/test/Semantics/omp-parallel-private03.f90 --- a/flang/test/Semantics/omp-parallel-private03.f90 +++ b/flang/test/Semantics/omp-parallel-private03.f90 @@ -17,7 +17,7 @@ arr(i) = 0.0 end do - !ERROR: A variable that is part of another variable (as an array or structure element) cannot appear in a PRIVATE or SHARED clause. + !ERROR: A variable that is part of another variable (as an array or structure element) cannot appear in a PRIVATE or SHARED clause or on the ALLOCATE directive. !$omp parallel private(arr(i),intx) do i = 1, 10 c(i) = a(i) + b(i) + k diff --git a/flang/test/Semantics/omp-parallel-private04.f90 b/flang/test/Semantics/omp-parallel-private04.f90 --- a/flang/test/Semantics/omp-parallel-private04.f90 +++ b/flang/test/Semantics/omp-parallel-private04.f90 @@ -17,7 +17,7 @@ arr(i) = 0.0 end do - !ERROR: A variable that is part of another variable (as an array or structure element) cannot appear in a PRIVATE or SHARED clause. + !ERROR: A variable that is part of another variable (as an array or structure element) cannot appear in a PRIVATE or SHARED clause or on the ALLOCATE directive. !$omp parallel private(arr,intx,my_var%array(1)) do i = 1, 10 c(i) = a(i) + b(i) + k diff --git a/flang/test/Semantics/omp-parallel-shared01.f90 b/flang/test/Semantics/omp-parallel-shared01.f90 --- a/flang/test/Semantics/omp-parallel-shared01.f90 +++ b/flang/test/Semantics/omp-parallel-shared01.f90 @@ -10,7 +10,7 @@ type(my_type) :: my_var - !ERROR: A variable that is part of another variable (as an array or structure element) cannot appear in a PRIVATE or SHARED clause. + !ERROR: A variable that is part of another variable (as an array or structure element) cannot appear in a PRIVATE or SHARED clause or on the ALLOCATE directive. !$omp parallel shared(my_var%array) do i = 1, 10 c(i) = a(i) + b(i) + k diff --git a/flang/test/Semantics/omp-parallel-shared02.f90 b/flang/test/Semantics/omp-parallel-shared02.f90 --- a/flang/test/Semantics/omp-parallel-shared02.f90 +++ b/flang/test/Semantics/omp-parallel-shared02.f90 @@ -10,7 +10,7 @@ array(i) = i end do - !ERROR: A variable that is part of another variable (as an array or structure element) cannot appear in a PRIVATE or SHARED clause. + !ERROR: A variable that is part of another variable (as an array or structure element) cannot appear in a PRIVATE or SHARED clause or on the ALLOCATE directive. !$omp parallel shared(array(i)) do i = 1, 10 c(i) = a(i) + b(i) + k diff --git a/flang/test/Semantics/omp-parallel-shared03.f90 b/flang/test/Semantics/omp-parallel-shared03.f90 --- a/flang/test/Semantics/omp-parallel-shared03.f90 +++ b/flang/test/Semantics/omp-parallel-shared03.f90 @@ -17,7 +17,7 @@ arr(i) = 0.0 end do - !ERROR: A variable that is part of another variable (as an array or structure element) cannot appear in a PRIVATE or SHARED clause. + !ERROR: A variable that is part of another variable (as an array or structure element) cannot appear in a PRIVATE or SHARED clause or on the ALLOCATE directive. !$omp parallel shared(arr(i),intx) do i = 1, 10 c(i) = a(i) + b(i) + k diff --git a/flang/test/Semantics/omp-parallel-shared04.f90 b/flang/test/Semantics/omp-parallel-shared04.f90 --- a/flang/test/Semantics/omp-parallel-shared04.f90 +++ b/flang/test/Semantics/omp-parallel-shared04.f90 @@ -17,7 +17,7 @@ arr(i) = 0.0 end do - !ERROR: A variable that is part of another variable (as an array or structure element) cannot appear in a PRIVATE or SHARED clause. + !ERROR: A variable that is part of another variable (as an array or structure element) cannot appear in a PRIVATE or SHARED clause or on the ALLOCATE directive. !$omp parallel shared(arr,intx,my_var%array(1)) do i = 1, 10 c(i) = a(i) + b(i) + k diff --git a/llvm/include/llvm/Frontend/OpenMP/OMP.td b/llvm/include/llvm/Frontend/OpenMP/OMP.td --- a/llvm/include/llvm/Frontend/OpenMP/OMP.td +++ b/llvm/include/llvm/Frontend/OpenMP/OMP.td @@ -1490,7 +1490,7 @@ ]; } def OMP_Allocate : Directive<"allocate"> { - let allowedClauses = [ + let allowedOnceClauses = [ VersionedClause ]; }