[flang-commits] [flang] [flang][OpenMP] Add semantic checks for is_device_ptr (PR #71255)

[via flang-commits]

https://github.com/shraiysh updated https://github.com/llvm/llvm-project/pull/71255

>From 27f3746e8aaaa1a1c0ceeddf3540e132a3339889 Mon Sep 17 00:00:00 2001
From: Shraiysh Vaishay <shraiysh.vaishay at amd.com>
Date: Fri, 3 Nov 2023 18:43:11 -0500
Subject: [PATCH] [flang][OpenMP] Add semantic checks for is_device_ptr

This patch adds the following semantic check for is_device_ptr

```
A list item that appears in an is_device_ptr clause must be a
dummy argument that does not have the ALLOCATABLE, POINTER or
VALUE attribute.
```
---
 flang/include/flang/Semantics/tools.h       |  3 ++
 flang/lib/Semantics/check-omp-structure.cpp | 27 ++++++++++--------
 flang/test/Semantics/OpenMP/target01.f90    | 31 +++++++++++++++++++--
 3 files changed, 47 insertions(+), 14 deletions(-)

diff --git a/flang/include/flang/Semantics/tools.h b/flang/include/flang/Semantics/tools.h
index e3deb2da1be04ab..633787f45e85255 100644
--- a/flang/include/flang/Semantics/tools.h
+++ b/flang/include/flang/Semantics/tools.h
@@ -143,6 +143,9 @@ inline bool IsPointer(const Symbol &symbol) {
 inline bool IsAllocatable(const Symbol &symbol) {
   return symbol.attrs().test(Attr::ALLOCATABLE);
 }
+inline bool IsValue(const Symbol &symbol) {
+  return symbol.attrs().test(Attr::VALUE);
+}
 // IsAllocatableOrObjectPointer() may be the better choice
 inline bool IsAllocatableOrPointer(const Symbol &symbol) {
   return IsPointer(symbol) || IsAllocatable(symbol);
diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index 12f54fbd51e1c2f..003c2635d6e0462 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -2852,18 +2852,21 @@ void OmpStructureChecker::Enter(const parser::OmpClause::IsDevicePtr &x) {
     const auto &isDevicePtrClause{
         std::get<parser::OmpClause::IsDevicePtr>(itr->second->u)};
     const auto &isDevicePtrList{isDevicePtrClause.v};
-    std::list<parser::Name> isDevicePtrNameList;
-    for (const auto &ompObject : isDevicePtrList.v) {
-      if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
-        if (name->symbol) {
-          if (!(IsBuiltinCPtr(*(name->symbol)))) {
-            context_.Say(itr->second->source,
-                "Variable '%s' in IS_DEVICE_PTR clause must be of type C_PTR"_err_en_US,
-                name->ToString());
-          } else {
-            isDevicePtrNameList.push_back(*name);
-          }
-        }
+    SymbolSourceMap currSymbols;
+    GetSymbolsInObjectList(isDevicePtrList, currSymbols);
+    for (auto &[symbol, source] : currSymbols) {
+      if (!(IsBuiltinCPtr(*symbol))) {
+        context_.Say(itr->second->source,
+            "Variable '%s' in IS_DEVICE_PTR clause must be of type C_PTR"_err_en_US,
+            source.ToString());
+      } else if (!(IsDummy(*symbol))) {
+        context_.Say(itr->second->source,
+            "Variable '%s' in IS_DEVICE_PTR clause must be a dummy argument"_err_en_US,
+            source.ToString());
+      } else if (IsAllocatableOrPointer(*symbol) || IsValue(*symbol)) {
+        context_.Say(itr->second->source,
+            "Variable '%s' in IS_DEVICE_PTR clause must be a dummy argument that does not have the ALLOCATABLE, POINTER or VALUE attribute."_err_en_US,
+            source.ToString());
       }
     }
   }
diff --git a/flang/test/Semantics/OpenMP/target01.f90 b/flang/test/Semantics/OpenMP/target01.f90
index d672b905a70ad2f..485fa1f2530c3b7 100644
--- a/flang/test/Semantics/OpenMP/target01.f90
+++ b/flang/test/Semantics/OpenMP/target01.f90
@@ -1,5 +1,6 @@
 ! RUN: %python %S/../test_errors.py %s %flang_fc1 -fopenmp
- 
+
+subroutine foo(b)
 use iso_c_binding
 integer :: x,y
 type(C_PTR) :: b
@@ -28,4 +29,30 @@
   y = y - 1
 !$omp end target
 
-end
+end subroutine foo
+
+subroutine bar(b1, b2, b3)
+  use iso_c_binding
+  integer :: y
+  type(c_ptr) :: c
+  type(c_ptr), allocatable :: b1
+  type(c_ptr), pointer :: b2
+  type(c_ptr), value :: b3
+
+  !ERROR: Variable 'c' in IS_DEVICE_PTR clause must be a dummy argument
+  !$omp target is_device_ptr(c)
+    y = y + 1
+  !$omp end target
+  !ERROR: Variable 'b1' in IS_DEVICE_PTR clause must be a dummy argument that does not have the ALLOCATABLE, POINTER or VALUE attribute.
+  !$omp target is_device_ptr(b1)
+    y = y + 1
+  !$omp end target
+  !ERROR: Variable 'b2' in IS_DEVICE_PTR clause must be a dummy argument that does not have the ALLOCATABLE, POINTER or VALUE attribute.
+  !$omp target is_device_ptr(b2)
+    y = y + 1
+  !$omp end target
+  !ERROR: Variable 'b3' in IS_DEVICE_PTR clause must be a dummy argument that does not have the ALLOCATABLE, POINTER or VALUE attribute.
+  !$omp target is_device_ptr(b3)
+    y = y + 1
+  !$omp end target
+end subroutine bar