https://gcc.gnu.org/g:bd2a164d7fdf1f109a8019aa2d32a2a2ad4893c4
commit r17-4848-gbd2a164d7fdf1f109a8019aa2d32a2a2ad4893c4 Author: Jerry DeLisle <[email protected]> Date: Sat Sep 19 12:24:05 2026 -0700 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. Diff: --- .../gfortran.dg/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(-) 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 000000000000..e780c00bbef9 --- /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 605487bd0ceb..08ae3113da5a 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 fbbe93e80f27..c1099a7f89af 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;
