[PATCH] fortran: Fix element size in collective subroutines implementation [PR126799]

From f436ee6ba90660b35f9bc09a2d04cfc679eba8d7 Mon Sep 17 00:00:00 2001
From: Mikael Morin <[email protected]>
Date: Wed, 12 Aug 2026 16:23:20 +0200
Subject: [PATCH] fortran: Fix element size in collective subroutines
 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 functions 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.
---
 .../gfortran.dg/coarray/collectives_5.f90     | 34 +++++++++++++++++++
 libgfortran/caf/shmem/collective_subroutine.c |  2 +-
 2 files changed, 35 insertions(+), 1 deletion(-)
 create mode 100644 gcc/testsuite/gfortran.dg/coarray/collectives_5.f90

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 00000000000..5906abff4ed
--- /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 (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 b498ad2802f..fd5d56e88b2 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 (
-- 
2.53.0