diff --git a/flang/include/flang/Semantics/tools.h b/flang/include/flang/Semantics/tools.h --- a/flang/include/flang/Semantics/tools.h +++ b/flang/include/flang/Semantics/tools.h @@ -140,6 +140,9 @@ inline bool IsAllocatableOrPointer(const Symbol &symbol) { return IsPointer(symbol) || IsAllocatable(symbol); } +inline bool IsSave(const Symbol &symbol) { + return symbol.attrs().test(Attr::SAVE); +} inline bool IsNamedConstant(const Symbol &symbol) { return symbol.attrs().test(Attr::PARAMETER); } 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 @@ -230,6 +230,9 @@ void CheckMultipleAppearanceAcrossContext( const parser::OmpObjectList &ompObjectList); const parser::OmpObjectList *GetOmpObjectList(const parser::OmpClause &); + void CheckPredefinedAllocatorRestriction(const parser::CharBlock &source, + const parser::OmpObjectList &ompObjectList); + bool isPredefinedAllocator; }; } // namespace Fortran::semantics #endif // FORTRAN_SEMANTICS_CHECK_OMP_STRUCTURE_H_ 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 @@ -237,6 +237,37 @@ } } +void OmpStructureChecker::CheckPredefinedAllocatorRestriction( + const parser::CharBlock &source, + const parser::OmpObjectList &ompObjectList) { + for (const auto &ompObject : ompObjectList.v) { + std::visit( + common::visitors{ + [&](const parser::Designator &designator) { + if (const auto *dataRef{ + std::get_if(&designator.u)}) { + if (const auto *name{std::get_if(&dataRef->u)}) { + if (const auto *symbol{name->symbol}) { + const auto *commonBlock{FindCommonBlockContaining(*symbol)}; + const auto &scope{context_.FindScope(symbol->name())}; + const Scope &containingScope{ + GetProgramUnitContaining(scope)}; + if (!isPredefinedAllocator && + (IsSave(*symbol) || commonBlock || + containingScope.kind() == Scope::Kind::Module)) { + context_.Say(source, + "If list items within the ALLOCATE directive have the SAVE attribute, are a common block name, or are declared in the scope of a module, then only predefined memory allocator parameters can be used in the allocator clause"_err_en_US); + } + } + } + } + }, + [&](const parser::Name &name) {}, + }, + ompObject.u); + } +} + void OmpStructureChecker::Enter(const parser::OpenMPConstruct &x) { // Simd Construct with Ordered Construct Nesting check // We cannot use CurrentDirectiveIsNested() here because @@ -608,6 +639,7 @@ } void OmpStructureChecker::Enter(const parser::OpenMPDeclarativeAllocate &x) { + isPredefinedAllocator = true; const auto &dir{std::get(x.t)}; const auto &objectList{std::get(x.t)}; PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_allocate); @@ -615,9 +647,20 @@ } void OmpStructureChecker::Leave(const parser::OpenMPDeclarativeAllocate &x) { + const auto &dir{std::get(x.t)}; + const auto &objectList{std::get(x.t)}; + CheckPredefinedAllocatorRestriction(dir.source, objectList); dirContext_.pop_back(); } +void OmpStructureChecker::Enter(const parser::OmpClause::Allocator &x) { + CheckAllowed(llvm::omp::Clause::OMPC_allocator); + const auto &allocatorValue{GetIntValue(x.v)}; + if (*allocatorValue > 8) + isPredefinedAllocator = false; + RequiresPositiveParameter(llvm::omp::Clause::OMPC_allocator, x.v); +} + void OmpStructureChecker::Enter(const parser::OpenMPDeclareTargetConstruct &x) { const auto &dir{std::get(x.t)}; PushContext(dir.source, llvm::omp::Directive::OMPD_declare_target); @@ -632,6 +675,7 @@ } void OmpStructureChecker::Enter(const parser::OpenMPExecutableAllocate &x) { + isPredefinedAllocator = true; const auto &dir{std::get(x.t)}; const auto &objectList{std::get>(x.t)}; PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_allocate); @@ -639,7 +683,11 @@ CheckIsVarPartOfAnotherVar(dir.source, *objectList); } -void OmpStructureChecker::Leave(const parser::OpenMPExecutableAllocate &) { +void OmpStructureChecker::Leave(const parser::OpenMPExecutableAllocate &x) { + const auto &dir{std::get(x.t)}; + const auto &objectList{std::get>(x.t)}; + if (objectList) + CheckPredefinedAllocatorRestriction(dir.source, *objectList); dirContext_.pop_back(); } @@ -925,7 +973,6 @@ CHECK_SIMPLE_CLAUSE(Nocontext, OMPC_nocontext) CHECK_SIMPLE_CLAUSE(Filter, OMPC_filter) -CHECK_REQ_SCALAR_INT_CLAUSE(Allocator, OMPC_allocator) CHECK_REQ_SCALAR_INT_CLAUSE(Grainsize, OMPC_grainsize) CHECK_REQ_SCALAR_INT_CLAUSE(NumTasks, OMPC_num_tasks) CHECK_REQ_SCALAR_INT_CLAUSE(NumTeams, OMPC_num_teams) diff --git a/flang/test/Semantics/omp-allocate08.f90 b/flang/test/Semantics/omp-allocate08.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/omp-allocate08.f90 @@ -0,0 +1,42 @@ +! RUN: %S/test_errors.sh %s %t %flang_fc1 -fopenmp +! OpenMP Version 5.0 +! 2.11.3 allocate Directive +! If list items within the ALLOCATE directive have the SAVE attribute, are a common block name, or are declared in the scope of a +! module, then only predefined memory allocator parameters can be used in the allocator clause + +module AllocateModule + INTEGER :: z +end module + +subroutine allocate() +use omp_lib +use AllocateModule + integer, SAVE :: x + integer :: w + COMMON /CommonName/ y + + integer(kind=omp_allocator_handle_kind) :: custom_allocator + integer(kind=omp_memspace_handle_kind) :: memspace + type(omp_alloctrait), dimension(1) :: trait + memspace = omp_default_mem_space + trait(1)%key = fallback + trait(1)%value = default_mem_fb + custom_allocator = omp_init_allocator(memspace, 1, trait) + + !$omp allocate(x) allocator(omp_default_mem_alloc) + !$omp allocate(y) allocator(omp_default_mem_alloc) + !$omp allocate(z) allocator(omp_default_mem_alloc) + + !$omp allocate(x) + !$omp allocate(y) + !$omp allocate(z) + + !$omp allocate(w) allocator(custom_allocator) + + !ERROR: If list items within the ALLOCATE directive have the SAVE attribute, are a common block name, or are declared in the scope of a module, then only predefined memory allocator parameters can be used in the allocator clause + !$omp allocate(x) allocator(custom_allocator) + !ERROR: If list items within the ALLOCATE directive have the SAVE attribute, are a common block name, or are declared in the scope of a module, then only predefined memory allocator parameters can be used in the allocator clause + !$omp allocate(y) allocator(custom_allocator) + !ERROR: If list items within the ALLOCATE directive have the SAVE attribute, are a common block name, or are declared in the scope of a module, then only predefined memory allocator parameters can be used in the allocator clause + !$omp allocate(z) allocator(custom_allocator) +end subroutine allocate