diff mbox series

libgfortran: [PR127702] caf_shmem: do not take the size of a, team from its barrier

Message ID ca81aedd-d9ce-4669-91c7-0b8594a25a02@gmail.com
State New
Headers
Series libgfortran: [PR127702] caf_shmem: do not take the size of a, team from its barrier |

Commit Message

Jerry D Oct. 2, 2026, 4:57 p.m. UTC 
  I forgot to include gcc-patches.


-------- Forwarded Message --------
Subject: [PATCH] libgfortran: [PR127702] caf_shmem: do not take the size of a, 
team from its barrier
Date: Fri, 2 Oct 2026 09:56:20 -0700
From: Jerry D <jvdelisle2@gmail.com>
To: gfortran <fortran@gcc.gnu.org>

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.
---
diff mbox series

Patch

From 38666c8113d1804b27484b05d419de59979dd34e Mon Sep 17 00:00:00 2001
From: Jerry DeLisle <jvdelisle@gcc.gnu.org>
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