https://gcc.gnu.org/g:0bb59375211478da9d4f219b829bf66924387bbe
commit r17-4843-g0bb59375211478da9d4f219b829bf66924387bbe Author: Jerry DeLisle <[email protected]> Date: Sat Sep 19 12:24:05 2026 -0700 libgfortran: [PR127347] caf_shmem: allocate a coarray part for every image Each image's part of a coarray is located by the image's index among all images, both locally and for a remote access through the team's image map. The allocation was sized for the images of the current team, so in a child team the images whose index exceeds the team's size wrote past the end of the allocation, over the next one. Allocate a part for every image of the program. Assisted-by: Claude Opus 5 PR libfortran/127347 libgfortran/ChangeLog: * caf/shmem.c (_gfortran_caf_register): Allocate a part for every image of the program. gcc/testsuite/ChangeLog: * gfortran.dg/coarray/team_alloc_overlap_1.f90: New test. Diff: --- .../gfortran.dg/coarray/team_alloc_overlap_1.f90 | 27 ++++++++++++++++++++++ libgfortran/caf/shmem.c | 12 ++++------ 2 files changed, 32 insertions(+), 7 deletions(-) diff --git a/gcc/testsuite/gfortran.dg/coarray/team_alloc_overlap_1.f90 b/gcc/testsuite/gfortran.dg/coarray/team_alloc_overlap_1.f90 new file mode 100644 index 000000000000..15fcc6978c93 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray/team_alloc_overlap_1.f90 @@ -0,0 +1,27 @@ +! { dg-do run } +! { dg-skip-if "CHANGE TEAM needs a coarray library" { *-*-* } { "-fcoarray=single" } { "" } } +! +! Coarrays allocated in a child team must not overlap. Each image's part is +! located by its index among all images, so the allocation has to provide a +! part for every image and not only for those of the team. + +program team_alloc_overlap_1 + use iso_fortran_env, only: team_type + implicit none + integer, parameter :: m = 1000 + integer, allocatable :: a(:)[:], b(:)[:] + type(team_type) :: t + integer :: me + + me = this_image () + form team (merge (1, 2, mod (me, 2) == 1), t) + change team (t) + allocate (a(m)[*], b(m)[*]) + a = me + b = -me + sync all + if (any (a /= me)) stop 1 + if (any (b /= -me)) stop 2 + deallocate (a, b) + end team +end program team_alloc_overlap_1 diff --git a/libgfortran/caf/shmem.c b/libgfortran/caf/shmem.c index fe1e5e293842..605487bd0ceb 100644 --- a/libgfortran/caf/shmem.c +++ b/libgfortran/caf/shmem.c @@ -311,11 +311,9 @@ _gfortran_caf_register (size_t size, caf_register_t type, caf_token_t *token, allocator_lock (&local->ai.alloc); mem = alloc_get_memory_by_id_created ( - &local->ai, size * caf_current_team->u.image_info->image_count.count, - next_memid, &created); + &local->ai, size * local->total_num_images, next_memid, &created); if (created) - memset (mem, 0, - size * caf_current_team->u.image_info->image_count.count); + memset (mem, 0, size * local->total_num_images); allocator_unlock (&local->ai.alloc); } break; @@ -333,9 +331,9 @@ _gfortran_caf_register (size_t size, caf_register_t type, caf_token_t *token, */ break; default: - mem = alloc_get_memory_by_id ( - &local->ai, size * caf_current_team->u.image_info->image_count.count, - next_memid); + /* Each image's part is at its index among all images. */ + mem = alloc_get_memory_by_id (&local->ai, size * local->total_num_images, + next_memid); break; }
