diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp index ee7959be0322c..987066313fee5 100644 --- a/flang/lib/Semantics/check-omp-structure.cpp +++ b/flang/lib/Semantics/check-omp-structure.cpp @@ -1712,6 +1712,28 @@ void OmpStructureChecker::Enter(const parser::OpenMPDeclarativeAllocate &x) { const auto &objectList{std::get(x.t)}; PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_allocate); const auto &clauseList{std::get(x.t)}; + SymbolSourceMap currSymbols; + GetSymbolsInObjectList(objectList, currSymbols); + for (auto &[symbol, source] : currSymbols) { + if (IsPointer(*symbol)) { + context_.Say(source, + "List item '%s' in ALLOCATE directive must not have POINTER " + "attribute"_err_en_US, + source.ToString()); + } + if (IsDummy(*symbol)) { + context_.Say(source, + "List item '%s' in ALLOCATE directive must not be a dummy " + "argument"_err_en_US, + source.ToString()); + } + if (symbol->GetUltimate().has()) { + context_.Say(source, + "List item '%s' in ALLOCATE directive must not be an associate " + "name"_err_en_US, + source.ToString()); + } + } for (const auto &clause : clauseList.v) { CheckAlignValue(clause); } diff --git a/flang/test/Semantics/OpenMP/allocate04.f90 b/flang/test/Semantics/OpenMP/allocate04.f90 index ea89d9446cc14..bbd74eb2ca101 100644 --- a/flang/test/Semantics/OpenMP/allocate04.f90 +++ b/flang/test/Semantics/OpenMP/allocate04.f90 @@ -4,13 +4,26 @@ ! OpenMP Version 5.0 ! 2.11.3 allocate Directive ! Only the allocator clause is allowed on the allocate directive -subroutine allocate() +! List item in ALLOCATE directive must not be a dummy argument +! List item in ALLOCATE directive must not have POINTER attribute +! List item in ALLOCATE directive must not be a associate name +subroutine allocate(z) use omp_lib +use iso_c_binding - integer :: x, y + type(c_ptr), pointer :: p + integer :: x, y, z + associate (a => x) !$omp allocate(x) allocator(omp_default_mem_alloc) !ERROR: PRIVATE clause is not allowed on the ALLOCATE directive !$omp allocate(y) private(y) + !ERROR: List item 'z' in ALLOCATE directive must not be a dummy argument + !$omp allocate(z) + !ERROR: List item 'p' in ALLOCATE directive must not have POINTER attribute + !$omp allocate(p) + !ERROR: List item 'a' in ALLOCATE directive must not be an associate name + !$omp allocate(a) + end associate end subroutine allocate