[flang-commits] [flang] b00b193 - [flang][cuda] Allow POINTER component to have device attribute (#126116)

[via flang-commits]

Author: Valentin Clement (バレンタイン クレメン)
Date: 2025-02-06T19:43:04-08:00
New Revision: b00b193728aef6f8a9685d0802c4382801d9efca

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

LOG: [flang][cuda] Allow POINTER component to have device attribute (#126116)

Added: 
    

Modified: 
    flang/lib/Semantics/check-declarations.cpp
    flang/test/Semantics/cuf03.cuf

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index 5c26469b9fa248..bf4dc16a15b4a2 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -989,9 +989,9 @@ void CheckHelper::CheckObjectEntity(
       }
       break;
     case common::CUDADataAttr::Device:
-      if (isComponent && !IsAllocatable(symbol)) {
+      if (isComponent && !IsAllocatable(symbol) && !IsPointer(symbol)) {
         messages_.Say(
-            "Component '%s' with ATTRIBUTES(DEVICE) must also be allocatable"_err_en_US,
+            "Component '%s' with ATTRIBUTES(DEVICE) must also be allocatable or pointer"_err_en_US,
             symbol.name());
       }
       break;

diff  --git a/flang/test/Semantics/cuf03.cuf b/flang/test/Semantics/cuf03.cuf
index 93b136ad7d3157..fe9dd5b3ecf05b 100644
--- a/flang/test/Semantics/cuf03.cuf
+++ b/flang/test/Semantics/cuf03.cuf
@@ -54,6 +54,14 @@ module m
   !ERROR: Object 'um' with ATTRIBUTES(UNIFIED) must be declared in a host subprogram
   real, unified :: um
 
+  type :: t3
+  !ERROR: Component 'r' with ATTRIBUTES(DEVICE) must also be allocatable or pointer
+    real, device :: r
+    real, device, pointer :: rp ! ok
+    real, device, allocatable :: ra ! ok
+    real, device, pointer, contiguous :: rpc ! ok
+  end type
+
  contains
   attributes(device) subroutine devsubr(n,da,rs)
     integer, intent(in) :: n