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

[via flang-commits]

Author: Shraiysh
Date: 2023-11-06T12:07:31-06:00
New Revision: d6b69a1bb9f5db5cfa24d372e4aab6365c1496f9

URL: https://github.com/llvm/llvm-project/commit/d6b69a1bb9f5db5cfa24d372e4aab6365c1496f9
DIFF: https://github.com/llvm/llvm-project/commit/d6b69a1bb9f5db5cfa24d372e4aab6365c1496f9.diff

LOG: [flang][OpenMP] Add semantic checks for is_device_ptr (#71255)

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.
```

Added: 
    

Modified: 
    flang/include/flang/Semantics/tools.h
    flang/lib/Semantics/check-omp-structure.cpp
    flang/test/Semantics/OpenMP/target01.f90

Removed: 
    


################################################################################
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 a328424e0c098d0..2054a13bd92e790 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -2864,18 +2864,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