[flang-commits] [flang] [Flang] [Semantics] [OpenMP] Add semantic checks for ALLOCATE directive (PR #123421)

[Raghu Maddhipatla via flang-commits]

https://github.com/raghavendhra updated https://github.com/llvm/llvm-project/pull/123421

>From e1ff8e82455d17ef437bea14ecfc611085fe6655 Mon Sep 17 00:00:00 2001
From: Raghu Maddhipatla <Raghu.Maddhipatla at amd.com>
Date: Fri, 17 Jan 2025 17:06:09 -0600
Subject: [PATCH 1/2] [Flang] [Semantics] [OpenMP] Add semantic checks for
 ALLOCATE directive.

---
 flang/lib/Semantics/check-omp-structure.cpp | 23 +++++++++++++++++++++
 flang/test/Semantics/OpenMP/allocate04.f90  | 17 +++++++++++++--
 2 files changed, 38 insertions(+), 2 deletions(-)

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

>From 818557b094fc732b1e877d0b08cbf1d7a0f88989 Mon Sep 17 00:00:00 2001
From: Raghu Maddhipatla <Raghu.Maddhipatla at amd.com>
Date: Fri, 17 Jan 2025 17:54:00 -0600
Subject: [PATCH 2/2] Remove unused variable and rebase with main branch.

---
 flang/lib/Semantics/check-omp-structure.cpp | 1 -
 1 file changed, 1 deletion(-)

diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index a1c8b5cc22ca25..b7e3ac7044b4d4 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -1500,7 +1500,6 @@ 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);