[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 (
lmpx.com only provides a reader for public news (NNTP) servers. It is not affiliated with the servers or forums shown here and is not responsible for the content of articles, which is written by their respective authors.