+ libgomp.fortran/omp_target_memset-2.f90

Committed as r16-5008-g28d20a591ddf16.

The bug was very interesting: On my system it repeatedly failed
when freeing the memory which turned out to be oddly because of
GOMP_dev2host copying plugin-nvptx.c's ptx_devices[0] from the
device, which must have landed on the device before, albeit I
could not really spot being copied there.

Copying it from and to the device is somewhat harmless, except
that between putting it on the device and back, the stack pointer
was reallocated - which caused that the next attempt to free it
failed - as the previous memory was already freed before.

I still do not understand how that worked together, but there was
surely one bug in the testcase:

As OpenMP implicitly copies the pointer target* when mapping a
pointer, there is a problem when the pointer is neither unassociated
(i.e. null()) nor associated - as here where uninitialized memory
is used.

Instead of using 'null()', I solved it by moving the pointer
declaration inside the target region, avoiding the memory copying
that way.

Tobias

(*OpenMP 6.0 provides means to specify whether that's the case
or not: The ref_ptee, ref_ptr, and ref_ptr_ptee modifiers to the
map clause.)
commit 28d20a591ddf1618d75f2b8261ba85bf15a49876
Author: Tobias Burnus <[email protected]>
Date:   Mon Nov 3 18:30:07 2025 +0100

    libgomp.fortran/omp_target_memset.f90 - Avoid implicit mapping by an uninit size [PR122543]
    
    In OpenMP, pointers are implicitly mapped - which means for Fortran that
    their pointer target is also mapped. However, for uninitialized memory,
    this means that some random pointee with some random amount of memory is
    copied - in the good case, size == 0, but if not, odd things can happen.
    
    Solution: Use 'fptr => null()' before the target mapping or - as done here -
    declare the pointer inside the region.
    
    libgomp/ChangeLog:
    
            PR libgomp/122543
            * testsuite/libgomp.fortran/omp_target_memset.f90: Move fptr inside
            the target to avoid implicit mapping of its uninit pointee.
            * testsuite/libgomp.fortran/omp_target_memset-2.f90: Likewise.
---
 libgomp/testsuite/libgomp.fortran/omp_target_memset-2.f90 | 11 ++++++++---
 libgomp/testsuite/libgomp.fortran/omp_target_memset.f90   |  6 ++++--
 2 files changed, 12 insertions(+), 5 deletions(-)

diff --git a/libgomp/testsuite/libgomp.fortran/omp_target_memset-2.f90 b/libgomp/testsuite/libgomp.fortran/omp_target_memset-2.f90
index 2641086f60d..78c66d3bbc9 100644
--- a/libgomp/testsuite/libgomp.fortran/omp_target_memset-2.f90
+++ b/libgomp/testsuite/libgomp.fortran/omp_target_memset-2.f90
@@ -11,7 +11,6 @@ do dev = omp_initial_device, omp_get_num_devices ()
 block
   integer(c_int) :: i, val, start, tail
   type(c_ptr) :: ptr, ptr2, tmpptr
-  integer(c_int8_t), pointer, contiguous :: fptr(:)
   integer(c_intptr_t) :: intptr
   integer(c_size_t), parameter :: count = 1024
   integer(omp_depend_kind) :: dep(1)
@@ -35,22 +34,28 @@ block
       !$omp taskwait
 
       !$omp target device(dev) is_device_ptr(ptr) depend(depobj: dep(1)) nowait
+      block
+        integer(c_int8_t), pointer, contiguous :: fptr(:)
+        call c_f_pointer (ptr, fptr, [count])
         do i = 1 + start, int(count, c_int) - start - tail
-          call c_f_pointer (ptr, fptr, [count])
           if (fptr(i) /= int (val, c_int8_t)) stop 2
           fptr(i) = fptr(i) + 2_c_int8_t
         end do
+      end block
       !$omp end target
 
       ptr2 = omp_target_memset_async (tmpptr, val + 3, &
                                       count - start - tail, dev, 1, dep)
 
       !$omp target device(dev) is_device_ptr(ptr) depend(depobj: dep(1)) nowait
+      block
+        integer(c_int8_t), pointer, contiguous :: fptr(:)
+        call c_f_pointer (ptr, fptr, [count])
         do i = 1 + start, int(count, c_int) - start - tail
-          call c_f_pointer (ptr, fptr, [count])
           if (fptr(i) /= int (val + 3, c_int8_t)) stop 3
           fptr(i) = fptr(i) - 1_c_int8_t
         end do
+      end block
       !$omp end target
 
       ptr2 = omp_target_memset_async (tmpptr, val - 3, &
diff --git a/libgomp/testsuite/libgomp.fortran/omp_target_memset.f90 b/libgomp/testsuite/libgomp.fortran/omp_target_memset.f90
index 1ee184ac47c..91a6baa7e5c 100644
--- a/libgomp/testsuite/libgomp.fortran/omp_target_memset.f90
+++ b/libgomp/testsuite/libgomp.fortran/omp_target_memset.f90
@@ -6,7 +6,6 @@ implicit none (type, external)
 
 integer(c_int) :: dev, i, val, start, tail
 type(c_ptr) :: ptr, ptr2, tmpptr
-integer(c_int8_t), pointer, contiguous :: fptr(:)
 integer(c_intptr_t) :: intptr
 integer(c_size_t), parameter :: count = 1024
 
@@ -26,10 +25,13 @@ do dev = omp_initial_device, omp_get_num_devices ()
       if (.not. c_associated (tmpptr, ptr2)) stop 1
 
       !$omp target device(dev) is_device_ptr(ptr)
+      block
+        integer(c_int8_t), pointer, contiguous :: fptr(:)
+        call c_f_pointer (ptr, fptr, [count])
         do i = 1 + start, int(count, c_int) - start - tail
-          call c_f_pointer (ptr, fptr, [count])
           if (fptr(i) /= int (val, c_int8_t)) stop 2
         end do
+      end block
       !$omp end target
     end do
   end do

Reply via email to