]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
libgomp.fortran/omp_target_memset.f90 - Avoid implicit mapping by an uninit size...
authorTobias Burnus <tburnus@baylibre.com>
Mon, 3 Nov 2025 17:30:07 +0000 (18:30 +0100)
committerTobias Burnus <tburnus@baylibre.com>
Mon, 3 Nov 2025 17:30:07 +0000 (18:30 +0100)
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
libgomp/testsuite/libgomp.fortran/omp_target_memset.f90

index 2641086f60d8dbd081a98ca3a2ace979669a3a6c..78c66d3bbc9d81fbc2283901aef000738c3275ee 100644 (file)
@@ -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, &
index 1ee184ac47c1eda1bf4b2adabb4c3ea2eacfb5d8..91a6baa7e5cdfff11734da42edb2ee4a2878e97e 100644 (file)
@@ -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