[gcc(refs/users/mikael/heads/pr126799_v01)] fortran: Fix element size in collective subroutines shmem implementation [PR126799]
Mikael Morin via Gcc-cvs <[email protected]>
| Newsgroups | gmane.comp.gcc.cvs |
|---|---|
| Message-ID | <[email protected]> |
https://gcc.gnu.org/g:bd35e5b5ffa50016359b57fd44689a7d888eb53d commit bd35e5b5ffa50016359b57fd44689a7d888eb53d Author: Mikael Morin <[email protected]> Date: Wed Aug 12 16:23:20 2026 +0200 fortran: Fix element size in collective subroutines shmem implementation [PR126799] The shared memory implementation of collective subroutines uses the array descriptor span as element size. This gives a bigger value than the true size in some cases, as demonstrated in the testcase with a pointer pointing to an array subreference. The bigger size estimate doesn't only cause over allocation of memory. As the packing and unpacking function don't have the same problem, they initialize and copy back only a part of the allocated buffer, and their element indexing in the buffer doesn't match that of the collective subroutine, causing wrong values to be produced. PR fortran/126799 libgfortran/ChangeLog: * caf/shmem/collective_subroutine.c (collsub_reduce_array): Use the element length field instead of the span field as element size. gcc/testsuite/ChangeLog: * gfortran.dg/coarray/collectives_5.f90: New test. Diff: --- .../gfortran.dg/coarray/collectives_5.f90 | 34 ++++++++++++++++++++++ libgfortran/caf/shmem/collective_subroutine.c | 2 +- 2 files changed, 35 insertions(+), 1 deletion(-) diff --git a/gcc/testsuite/gfortran.dg/coarray/collectives_5.f90 b/gcc/testsuite/gfortran.dg/coarray/collectives_5.f90 new file mode 100644 index 000000000000..749f8402c71a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray/collectives_5.f90 @@ -0,0 +1,34 @@ +! { dg-do run } +! +! PR fortran/126799 +! Check that the collective subroutines code uses span and element length +! correctly when they are different values (in the non-contiguous pointer +! case). The shared memory implementation used to use the span incorrectly +! as element length, causing wrong values to be produced. + +program prog + implicit none + integer, parameter :: k = 2, n = 5 + type t + integer(kind=k) :: c1, c2 + end type + type(t), target :: x(n) + integer(kind=k), pointer :: p(:) + integer :: i, icount + icount = num_images() + !print *, icount + x = [ (t(i*this_image(),i+this_image()), i=1,n) ] + p => x%c1 + call summation(p) + !print '(i4,":",*(" ", i5))', this_image(), x%c1 + if (any(x%c1 /= [ ((icount * (icount + 1) / 2) * i, i=1,n) ])) error stop 1 + p => x%c2 + call summation(p) + !print '(i4,":",*(" ", i5))', this_image(), x%c2 + if (any(x%c2 /= [ (icount * i + icount * (icount + 1) / 2, i=1,n) ])) error stop 2 +contains + subroutine summation(a) + integer(kind=k), pointer, intent(in) :: a(:) + call co_sum(a) + end subroutine +end program diff --git a/libgfortran/caf/shmem/collective_subroutine.c b/libgfortran/caf/shmem/collective_subroutine.c index b498ad2802f5..fd5d56e88b2a 100644 --- a/libgfortran/caf/shmem/collective_subroutine.c +++ b/libgfortran/caf/shmem/collective_subroutine.c @@ -335,7 +335,7 @@ collsub_reduce_array (gfc_descriptor_t *desc, int result_image, if (pi.num_elem == 0) return; - elem_size = GFC_DESCRIPTOR_SPAN (desc); + elem_size = GFC_DESCRIPTOR_SIZE (desc); this_image_size_bytes = elem_size * pi.num_elem; buffer = get_collsub_buf (