[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 7844f5eda1da03ba64b760c2832c13c79fa97c1b 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/3] [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 ee7959be0322c..a468f92de0a48 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -1708,10 +1708,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 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

>From 7a864d456977760333038ac3e7c0be3266dc8e00 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/3] 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 a468f92de0a48..94582f6996e9f 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -1708,7 +1708,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);

>From d7922defcf90c9d60c497c63cad84c0f93612ed2 Mon Sep 17 00:00:00 2001
From: Raghu Maddhipatla <Raghu.Maddhipatla at amd.com>
Date: Thu, 24 Apr 2025 17:05:23 -0500
Subject: [PATCH 3/3] Rebase and addressed review comment by using Ultimate
 symbol.

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

diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index 94582f6996e9f..987066313fee5 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -1727,7 +1727,7 @@ void OmpStructureChecker::Enter(const parser::OpenMPDeclarativeAllocate &x) {
           "argument"_err_en_US,
           source.ToString());
     }
-    if (symbol->has<AssocEntityDetails>()) {
+    if (symbol->GetUltimate().has<AssocEntityDetails>()) {
       context_.Say(source,
           "List item '%s' in ALLOCATE directive must not be an associate "
           "name"_err_en_US,