[Flang] [Semantics] [OpenMP] Add semantic checks for ALLOCATE directive

[raghavendhra]

Add following semantic checks for ALLOCATE directive as per OpenMP 6.0 standard.

• 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

[llvmbot]

@llvm/pr-subscribers-flang-openmp

@llvm/pr-subscribers-flang-semantics

Author: Raghu Maddhipatla (raghavendhra)

Changes

Add following semantic checks for ALLOCATE directive as per OpenMP 6.0 standard.

• 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

---

Full diff: https://github.com/llvm/llvm-project/pull/123421.diff

2 Files Affected:

• (modified) flang/lib/Semantics/check-omp-structure.cpp (+23)
• (modified) flang/test/Semantics/OpenMP/allocate04.f90 (+15-2)

diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index 6db43cf6f04bd3..a1c8b5cc22ca25 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -1500,10 +1500,33 @@ void OmpStructureChecker::CheckAlignValue(const parser::OmpClause &clause) {
 
 void OmpStructureChecker::Enter(const parser::OpenMPDeclarativeAllocate &x) {
   isPredefinedAllocator = true;
+  SymbolSourceMap symbols;
   const auto &dir{std::get<parser::Verbatim>(x.t)};
   const auto &objectList{std::get<parser::OmpObjectList>(x.t)};
   PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_allocate);
   const auto &clauseList{std::get<parser::OmpClauseList>(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->has<AssocEntityDetails>()) {
+      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 ea89d9446cc146..bbd74eb2ca101c 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

[abidh]

LGTM.

[kiranchandramohan]

Check whether you need to use the Ultimate symbol here.

[kiranchandramohan]

LG