I have attached two patches. These must be applied in order.
The first one is a cleanup I found while testing the fixes for PR127347.
It is simple and I plan to push shortly.
The second is a fixup that I renamed to PR127702 which Mikael reported.
For information, after these two go in, I have a fix for PR127684 which I also
discovered during testing. I will post that a little later.
Regression tested on x86_64.
OK for mainline?
Regards,
Jerry
---
libgfortran: [PR127702] caf_shmem: do not take the size of a
team from its barrier
A team's image_count is the barrier its images synchronize in, and its
count drops as images of the team terminate. It was also used as the
number of images of the team, so NUM_IMAGES shrank once an image had
stopped, IMAGE_STATUS reported an active image as stopped, and FORM
TEAM and the collectives laid themselves out over too few images.
Use the size of the team's image map, which does not change.
Assisted-by: Claude Opus 5
PR libfortran/127702
libgfortran/ChangeLog:
* caf/shmem.c (_gfortran_caf_num_images, _gfortran_caf_image_status)
(_gfortran_caf_form_team): Take the size of a team from its image
map.
* caf/shmem/collective_subroutine.c (collsub_reduce_array):
Likewise.
gcc/testsuite/ChangeLog:
* gfortran.dg/coarray/num_images_stopped_1.f90: New test.
---
From 21b50fc28922c10a54bd950883201bb0dd169378 Mon Sep 17 00:00:00 2001
From: Jerry DeLisle <[email protected]>
Date: Sat, 19 Sep 2026 12:24:05 -0700
Subject: [PATCH] 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.
---
.../coarray/team_alloc_overlap_1.f90 | 27 +++++++++++++++++++
libgfortran/caf/shmem.c | 12 ++++-----
2 files changed, 32 insertions(+), 7 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/coarray/team_alloc_overlap_1.f90
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 00000000000..15fcc6978c9
--- /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 fe1e5e29384..605487bd0ce 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;
}
--
2.55.0
From 38666c8113d1804b27484b05d419de59979dd34e Mon Sep 17 00:00:00 2001
From: Jerry DeLisle <[email protected]>
Date: Sat, 19 Sep 2026 12:24:05 -0700
Subject: [PATCH] libgfortran: [PR127702] caf_shmem: do not take the size of a
team from its barrier
A team's image_count is the barrier its images synchronize in, and its
count drops as images of the team terminate. It was also used as the
number of images of the team, so NUM_IMAGES shrank once an image had
stopped, IMAGE_STATUS reported an active image as stopped, and FORM
TEAM and the collectives laid themselves out over too few images.
Use the size of the team's image map, which does not change.
Assisted-by: Claude Opus 5
PR libfortran/127702
libgfortran/ChangeLog:
* caf/shmem.c (_gfortran_caf_num_images, _gfortran_caf_image_status)
(_gfortran_caf_form_team): Take the size of a team from its image
map.
* caf/shmem/collective_subroutine.c (collsub_reduce_array):
Likewise.
gcc/testsuite/ChangeLog:
* gfortran.dg/coarray/num_images_stopped_1.f90: New test.
---
.../coarray/num_images_stopped_1.f90 | 23 +++++++++++++++++++
libgfortran/caf/shmem.c | 19 +++++++--------
libgfortran/caf/shmem/collective_subroutine.c | 8 +++----
3 files changed, 35 insertions(+), 15 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/coarray/num_images_stopped_1.f90
diff --git a/gcc/testsuite/gfortran.dg/coarray/num_images_stopped_1.f90 b/gcc/testsuite/gfortran.dg/coarray/num_images_stopped_1.f90
new file mode 100644
index 00000000000..e780c00bbef
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/num_images_stopped_1.f90
@@ -0,0 +1,23 @@
+! { dg-do run }
+! PR 127702
+!
+! NUM_IMAGES and IMAGE_STATUS still count an image that has stopped.
+
+program num_images_stopped_1
+ use iso_fortran_env, only: stat_stopped_image
+ implicit none
+ integer :: n, st
+
+ n = num_images ()
+ if (n == 1) stop
+ sync all
+ if (this_image () == 1) stop
+
+ do
+ sync all (stat=st)
+ if (st == stat_stopped_image) exit
+ end do
+ if (num_images () /= n) stop 1
+ if (image_status (n) /= 0) stop 2
+ if (image_status (1) /= stat_stopped_image) stop 3
+end program num_images_stopped_1
diff --git a/libgfortran/caf/shmem.c b/libgfortran/caf/shmem.c
index 605487bd0ce..08ae3113da5 100644
--- a/libgfortran/caf/shmem.c
+++ b/libgfortran/caf/shmem.c
@@ -176,13 +176,12 @@ _gfortran_caf_num_images (caf_team_t team, int32_t *team_number)
while (cur) \
{ \
if (cur->u.image_info->team_id == *team_number) \
- return counter_barrier_get_count (&cur->u.image_info->image_count); \
+ return cur->u.image_info->image_map_size; \
cur = cur->parent; \
}
if (team)
- return counter_barrier_get_count (
- &((caf_shmem_team_t) team)->u.image_info->image_count);
+ return ((caf_shmem_team_t) team)->u.image_info->image_map_size;
if (team_number)
{
@@ -194,8 +193,7 @@ _gfortran_caf_num_images (caf_team_t team, int32_t *team_number)
CHECK_TEAMS
}
- return counter_barrier_get_count (
- &caf_current_team->u.image_info->image_count);
+ return caf_current_team->u.image_info->image_map_size;
}
@@ -676,7 +674,7 @@ _gfortran_caf_image_status (int image, caf_team_t *team)
if (team)
t = *(caf_shmem_team_t *) team;
- if (image > t->u.image_info->image_count.count)
+ if (image > t->u.image_info->image_map_size)
return CAF_STAT_STOPPED_IMAGE;
image_index = t->u.image_info->image_map[image - 1];
@@ -1760,7 +1758,7 @@ _gfortran_caf_form_team (int team_no, caf_team_t *team, int *new_index,
if (new_index
&& (*new_index <= 0
- || *new_index > caf_current_team->u.image_info->image_count.count))
+ || *new_index > caf_current_team->u.image_info->image_map_size))
{
caf_internal_error (new_index_out_of_range, stat, errmsg, errmsg_len);
return;
@@ -1795,7 +1793,7 @@ _gfortran_caf_form_team (int team_no, caf_team_t *team, int *new_index,
{alloc_get_memory_by_id_created (
&local->ai,
sizeof (struct shmem_image_info)
- + caf_current_team->u.image_info->image_count.count * sizeof (int),
+ + caf_current_team->u.image_info->image_map_size * sizeof (int),
-tmemid, &created)}};
if (created)
@@ -1810,8 +1808,7 @@ _gfortran_caf_form_team (int team_no, caf_team_t *team, int *new_index,
t->u.image_info->lastmemid = tmemid;
register_team (t);
/* Initialize a freshly created image_map with -1. */
- for (int i = 0; i < caf_current_team->u.image_info->image_count.count;
- ++i)
+ for (int i = 0; i < caf_current_team->u.image_info->image_map_size; ++i)
t->u.image_info->image_map[i] = -1;
}
counter_barrier_init_add (&t->u.image_info->image_count, 1);
@@ -1854,7 +1851,7 @@ _gfortran_caf_form_team (int team_no, caf_team_t *team, int *new_index,
New team: 1 1 1 2 2 2
*/
im = caf_current_team->index * cnt
- / caf_current_team->u.image_info->image_count.count;
+ / caf_current_team->u.image_info->image_map_size;
/* Map our old index into the domain of the new team's size. */
do
{
diff --git a/libgfortran/caf/shmem/collective_subroutine.c b/libgfortran/caf/shmem/collective_subroutine.c
index fbbe93e80f2..c1099a7f89a 100644
--- a/libgfortran/caf/shmem/collective_subroutine.c
+++ b/libgfortran/caf/shmem/collective_subroutine.c
@@ -343,7 +343,7 @@ collsub_reduce_array (gfc_descriptor_t *desc, int result_image,
this_image_size_bytes = elem_size * pi.num_elem;
buffer = get_collsub_buf (
- this_image_size_bytes * caf_current_team->u.image_info->image_count.count);
+ this_image_size_bytes * caf_current_team->u.image_info->image_map_size);
this_image_buf = buffer + this_image_size_bytes * this_img_id;
if (packed)
@@ -356,12 +356,12 @@ collsub_reduce_array (gfc_descriptor_t *desc, int result_image,
return false;
for (; ((this_img_id >> cbit) & 1) == 0
- && (caf_current_team->u.image_info->image_count.count >> cbit) != 0;
+ && (caf_current_team->u.image_info->image_map_size >> cbit) != 0;
cbit++)
{
imoffset = 1 << cbit;
if (this_img_id + imoffset
- < caf_current_team->u.image_info->image_count.count)
+ < caf_current_team->u.image_info->image_map_size)
{
/* Reduce arrays elementwise. */
roll_iter = this_image_buf;
@@ -373,7 +373,7 @@ collsub_reduce_array (gfc_descriptor_t *desc, int result_image,
if (!collsub_sync ())
return false;
}
- for (; (caf_current_team->u.image_info->image_count.count >> cbit) != 0;
+ for (; (caf_current_team->u.image_info->image_map_size >> cbit) != 0;
cbit++)
if (!collsub_sync ())
return false;
--
2.55.0
