[gcc/devel/omp/gcc-16] libgomp.fortran/map-subarray-6.f90: Fix and robustify

https://gcc.gnu.org/g:905f4c929d32a06936fb205ee76e3764f4534358

commit 905f4c929d32a06936fb205ee76e3764f4534358
Author: Tobias Burnus <[email protected]>
Date:   Tue Apr 28 14:15:21 2026 +0200

    libgomp.fortran/map-subarray-6.f90: Fix and robustify
    
    Changes:
    * Actually initialize the proper variable.
    * Handle the three cases explicitly: self mapping/host fallback, mapping
      but host accessible and mapping and (potentially) not host accessible.
      Hence, remove 'dg-should-fail' - as the code should now always run.
    * Add more checks for not pointer attaching, using values outside mapped
      range.
    * Add several comments and handle the case that 'tgt' is actually removed
      during gimplification as unused. (Two cases: once the result with 'tgt'
      removed - and once using 'tgt'/'tgt2' in the target region - and checking
      then for the result).
    
    libgomp/ChangeLog:
    
            * testsuite/libgomp.fortran/map-subarray-6.f90: Fix, extend, and
            robustify.
    
    (cherry picked from commit a61760c4e555f9f5af2ea1ca3aa7abc2e578eed1)

Diff:
---
 .../testsuite/libgomp.fortran/map-subarray-6.f90   | 146 +++++++++++++++++++--
 1 file changed, 137 insertions(+), 9 deletions(-)

diff --git a/libgomp/testsuite/libgomp.fortran/map-subarray-6.f90 b/libgomp/testsuite/libgomp.fortran/map-subarray-6.f90
index 9f0edf70890e..243e88b70bde 100644
--- a/libgomp/testsuite/libgomp.fortran/map-subarray-6.f90
+++ b/libgomp/testsuite/libgomp.fortran/map-subarray-6.f90
@@ -1,5 +1,9 @@
 ! { dg-do run }
 
+use iso_c_binding
+use omp_lib
+implicit none
+
 type t
   integer, pointer :: p(:)
   integer, pointer :: p2(:)
@@ -7,20 +11,144 @@ end type t
 
 type(t) :: var
 integer, target :: tgt(5), tgt2(1000)
+logical :: host_accessible, self_mapping
+integer(c_intptr_t) :: ip, ip2
+
+ip = transfer(c_loc(tgt), ip)
+ip2 = transfer(c_loc(tgt2), ip2)
+
 var%p => tgt
 var%p2 => tgt2
 
-p = 0
-p2 = 0
+! 'map(var)' shall never do any pointer attachment - even if the pointer
+! variables are mapped to the device.
+!
+! There are three case:
+!
+! 1. Host fallback or self mapping: In the target region, the values are modified on the host
+! 2. Host memory inaccessible: var's pointers point to the host version (inaccessible);
+!    tgt and tgt2 are mapped from/to the device but are inaccessible via var's pointers.
+! 3. No selfmapping but variables are accessible on the host:
+!    Modifying var%p and var%p2 changes the value on the host - but copying back tgt and
+!    tgt2 will set the value prior to the copy in.
 
-!$omp target map(tgt, tgt2(4:6), var)
-  var%p(1) = 5
-  var%p2(5) = 7
+! NOTE: Due to PR libgomp/113216, omp_target_is_accessible will report .false. on Nvptx
+! even if host access to the device is possible. - This will reduce the test coverage
+! but will not cause a fail.
+
+host_accessible = omp_target_is_accessible(c_loc(tgt), c_sizeof(tgt), omp_default_device) /= 0
+!host_accessible = .true.  ! set this manually on nvptx with USM support, until fixed
+
+self_mapping = .false.
+!$omp target map(to: self_mapping)
+  self_mapping = .true.
 !$omp end target
 
-if (var%p(1).ne.5) stop 1
-if (var%p2(5).ne.7) stop 2
+print *, (self_mapping ? '' : 'NO '), 'self mapping, ', &
+         (host_accessible ? '' : 'NOT '), 'host accessible'
 
-end
+var%p = 1
+var%p2 = 2
+
+! The following is slightly tricky as well: As 'tgt' is not used, it is optimized away
+! by during gimplification! - Hence, 'tgt' is also not copied back.
+! For 'tgt2(4:6)', the expression is too complex for the gimplifier - hence, it
+! is copied back ...
+
+!$omp target map(tgt, tgt2(4:6),var) firstprivate(host_accessible, ip, ip2)
+  ! No pointer attachment = points to the host
+  if (ip /= transfer(c_loc(var%p), ip)) stop 1
+  if (ip2 /= transfer(c_loc(var%p2), ip2)) stop 2
+
+  if (lbound(var%p,1) /= 1 .or. ubound(var%p,1) /= 5 .or. .not.associated(var%p)) &
+    stop 3
+  if (lbound(var%p2,1) /= 1 .or. ubound(var%p2,1) /= 1000 .or. .not.associated(var%p2)) &
+    stop 4
+
+  if (omp_is_initial_device() .or. host_accessible) then
+    if (any (var%p /= 1)) stop 5
+    if (any (var%p2 /= 2)) stop 6
+    var%p(1) = 5
+    var%p2(5) = 6
+    var%p2(22) = 7
+  end if
+!$omp end target
 
-! { dg-shouldfail "" { offload_device_nonshared_as } }
+if (omp_get_default_device() == omp_get_num_devices() &
+    .or. omp_get_default_device() == omp_initial_device &
+    .or. host_accessible) then
+  if (self_mapping) then
+    if (var%p(1) /= 5) stop 7
+    if (var%p2(5) /= 6) stop 8
+    if (var%p2(22) /= 7) stop 9
+  else
+    if (var%p(1) /= 5) stop 10  ! NO copy back - hence, value is 5
+    if (var%p2(5) /= 2) stop 11
+    if (var%p2(22) /= 7) stop 12
+  endif
+  if (any (var%p(2:) /= 1)) stop 13
+  if (any (var%p2(:4) /= 2) &
+      .or. any (var%p2(6:21) /= 2) &
+      .or. any (var%p2(23:) /= 2)) &
+    stop 14
+else
+  if (any(var%p /= 1)) stop 15
+  if (any(var%p2 /= 2)) stop 16
+end if
+
+
+! The same - but now using tgt / tgt2 inside the region
+
+var%p = 1
+var%p2 = 2
+
+!$omp target map(tgt, tgt2(4:6),var) firstprivate(host_accessible, ip, ip2)
+  ! No pointer attachment = points to the host
+  if (ip /= transfer(c_loc(var%p), ip)) stop 17
+  if (ip2 /= transfer(c_loc(var%p2), ip2)) stop 18
+
+  if (omp_is_initial_device() .or. self_mapping) then
+    if (.not. c_associated(c_loc(var%p), c_loc(tgt))) stop 19
+    if (.not. c_associated(c_loc(var%p2), c_loc(tgt2))) stop 20
+  else
+    if (c_associated(c_loc(var%p), c_loc(tgt))) stop 21
+    if (c_associated(c_loc(var%p2), c_loc(tgt2))) stop 22
+  endif
+
+  if (lbound(var%p,1) /= 1 .or. ubound(var%p,1) /= 5 .or. .not.associated(var%p)) &
+    stop 23
+  if (lbound(var%p2,1) /= 1 .or. ubound(var%p2,1) /= 1000 .or. .not.associated(var%p2)) &
+    stop 24
+
+  if (omp_is_initial_device() .or. host_accessible) then
+    if (any (var%p /= 1)) stop 25
+    if (any (var%p2 /= 2)) stop 26
+    var%p(1) = 5
+    var%p2(5) = 6
+    var%p2(22) = 7
+  end if
+!$omp end target
+
+if (omp_get_default_device() == omp_get_num_devices() &
+    .or. omp_get_default_device() == omp_initial_device &
+    .or. host_accessible) then
+  if (self_mapping) then
+    if (var%p(1) /= 5) stop 27
+    if (var%p2(5) /= 6) stop 28
+    if (var%p2(22) /= 7) stop 29
+  else
+    if (var%p(1) /= 1) stop 30  ! NOW tgt is copied back
+    if (var%p2(5) /= 2) stop 31
+    if (var%p2(22) /= 7) stop 32
+  endif
+  if (any (var%p(2:) /= 1)) stop 33
+  if (any (var%p2(:4) /= 2) &
+      .or. any (var%p2(6:21) /= 2) &
+      .or. any (var%p2(23:) /= 2)) &
+    stop 34
+else
+  if (any(var%p /= 1)) stop 35
+  if (any(var%p2 /= 2)) stop 36
+end if
+
+end