On 10/5/26 10:04 AM, Jerry D wrote:
See the attached patch. In my campaign to identify caf related bugs I discovered
this one.
Regression tested under heavy loads.
OK for mainline?
Regards,
Jerry
I am working on ways to create LLM assisted patches more human readable. Using
Claude, and I suspect other LLMs, one can set up rules and guidelines to follow.
The attached V2 of the subject patch is essentially identical with an improved
commit message that better explanations of the problem and the fix. There is a
bit of a guide here on how to review all this as well.
How the hang happens: image 1 waits in SYNC IMAGES ([2, 3]) when image
3 stops. Image 2 then executes SYNC IMAGES ([1, 3]), finds image 3
stopped and returns with STAT_STOPPED_IMAGE without synchronizing, so
image 1 is not released. FAIL IMAGE leads to the same hang.
The point to check is the order in sync_table_terminated: under the
table lock it releases the waiting images and takes back their
unmatched counts, and only then stores the new status. Outside the
WIN32 supervisor, which this patch does not change, every change of an
image's status to stopped or failed goes through it.
Reading guide: start with sync.h, the new waiting and aborted fields
and what sync_table and sync_table_terminated promise. Then those two
functions in sync.c. In shmem.c, _gfortran_caf_sync_images drops its
early return for a terminated image and sets STAT= only when sync_table
reports a terminated image. The other shmem.c and supervisor.c hunks
route the status changes through sync_table_terminated, which replaces
the supervisor's wake-up of all waiting images. set_table_parts and
the sync_init changes only lay out the enlarged table.
Regression tested on x86_64.
OK for mainline?
Regards,
Jerry
PS Feedback on the format of this email is greatly appreciated.
---
libgfortran: [PR127684] caf_shmem: SYNC IMAGES hang on
terminated image
SYNC IMAGES hung when an image of the image set stopped or failed while
another image of the set was waiting in the statement.
An image that found a stopped or failed image in its set returned at once
with STAT=, without synchronizing, so an image already waiting for it was
never released. The supervisor also woke the waiting images without
holding the table lock, so a wakeup could be lost.
Each image now records the set it waits for. Images that stop or fail,
and the POSIX supervisor when it reaps one, set the status through the
new sync_table_terminated, which holds the table lock. For a stopped
image it releases the images waiting for it and takes back the counts
they raised that no partner has matched, before it stores the status,
so an image that sees the stop cannot pair with the aborted statement.
A failed image is skipped and the other images of the set synchronize
(F2023 11.7.11).
Assisted-by: Claude Opus 5.5
PR libfortran/127684
libgfortran/ChangeLog:
* caf/shmem.c (_gfortran_caf_sync_images): Do not return early for
a stopped or failed image. Check the images only when one of them
terminated.
(mark_stopped): Use sync_table_terminated.
(_gfortran_caf_fail_image): Likewise.
* caf/shmem/supervisor.c (supervisor_main_loop): Likewise. Do not
signal all images waiting in sync_table.
* caf/shmem/sync.c (set_table_parts): New function.
(sync_init): Use it.
(sync_init_supervisor): Allocate the image sets of the waiting
images and the aborted flags.
(stopped_image_in): New function.
(sync_table): Return whether an image of the set terminated. Only
synchronize memory when an image of the set stopped. Record the
image set and end the wait when aborted.
(sync_table_terminated): New function.
* caf/shmem/sync.h (sync_t): Add waiting and aborted.
(sync_table): Return bool.
(sync_table_terminated): Declare.
gcc/testsuite/ChangeLog:
* gfortran.dg/coarray/sync_images_failed_1.f90: New test.
* gfortran.dg/coarray/sync_images_stopped_2.f90: New test.
---
From a7b395ce995f6ce3da1d765fe034f45b20dc20f4 Mon Sep 17 00:00:00 2001
From: Jerry DeLisle <[email protected]>
Date: Wed, 30 Sep 2026 19:26:47 -0700
Subject: [PATCH] libgfortran: [PR127684] caf_shmem: SYNC IMAGES hang on
terminated image
SYNC IMAGES hung when an image of the image set stopped or failed while
another image of the set was waiting in the statement.
An image that found a stopped or failed image in its set returned at once
with STAT=, without synchronizing, so an image already waiting for it was
never released. The supervisor also woke the waiting images without
holding the table lock, so a wakeup could be lost.
Each image now records the set it waits for. Images that stop or fail,
and the POSIX supervisor when it reaps one, set the status through the
new sync_table_terminated, which holds the table lock. For a stopped
image it releases the images waiting for it and takes back the counts
they raised that no partner has matched, before it stores the status,
so an image that sees the stop cannot pair with the aborted statement.
A failed image is skipped and the other images of the set synchronize
(F2023 11.7.11).
Assisted-by: Claude Opus 5.5
PR libfortran/127684
libgfortran/ChangeLog:
* caf/shmem.c (_gfortran_caf_sync_images): Do not return early for
a stopped or failed image. Check the images only when one of them
terminated.
(mark_stopped): Use sync_table_terminated.
(_gfortran_caf_fail_image): Likewise.
* caf/shmem/supervisor.c (supervisor_main_loop): Likewise. Do not
signal all images waiting in sync_table.
* caf/shmem/sync.c (set_table_parts): New function.
(sync_init): Use it.
(sync_init_supervisor): Allocate the image sets of the waiting
images and the aborted flags.
(stopped_image_in): New function.
(sync_table): Return whether an image of the set terminated. Only
synchronize memory when an image of the set stopped. Record the
image set and end the wait when aborted.
(sync_table_terminated): New function.
* caf/shmem/sync.h (sync_t): Add waiting and aborted.
(sync_table): Return bool.
(sync_table_terminated): Declare.
gcc/testsuite/ChangeLog:
* gfortran.dg/coarray/sync_images_failed_1.f90: New test.
* gfortran.dg/coarray/sync_images_stopped_2.f90: New test.
---
.../coarray/sync_images_failed_1.f90 | 55 +++++++++++
.../coarray/sync_images_stopped_2.f90 | 58 +++++++++++
libgfortran/caf/shmem.c | 34 ++-----
libgfortran/caf/shmem/supervisor.c | 11 +--
libgfortran/caf/shmem/sync.c | 95 +++++++++++++++++--
libgfortran/caf/shmem/sync.h | 18 +++-
6 files changed, 227 insertions(+), 44 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/coarray/sync_images_failed_1.f90
create mode 100644 gcc/testsuite/gfortran.dg/coarray/sync_images_stopped_2.f90
diff --git a/gcc/testsuite/gfortran.dg/coarray/sync_images_failed_1.f90 b/gcc/testsuite/gfortran.dg/coarray/sync_images_failed_1.f90
new file mode 100644
index 00000000000..c076ee4d88e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/sync_images_failed_1.f90
@@ -0,0 +1,55 @@
+! { dg-do run }
+! PR 127684
+!
+! SYNC IMAGES (STAT=) with a failed image in the image set synchronizes the
+! active images of the set (F2023 11.7.11), both for an image that already
+! waits in the statement when the image fails and for one that arrives later.
+!
+! Image 1 tells image 3 that it is about to wait for images 2 and 3; image 3
+! spins to give it time to start waiting, then fails. Image 2 executes its
+! SYNC IMAGES only after it sees image 3 failed, and image 1 reads X from
+! image 2 to check that the two synchronized. Without the fix the test hangs.
+
+program sync_images_failed_1
+ use iso_fortran_env, only : atomic_int_kind, stat_failed_image
+ implicit none
+ integer(atomic_int_kind) :: arrived[*], a
+ integer :: st, x[*]
+
+ if (num_images () < 3) stop
+ arrived = 0
+ x = 0
+ sync all
+
+ select case (this_image ())
+ case (1)
+ call atomic_define (arrived[3], 1)
+ st = 0
+ sync images ([2, 3], stat=st)
+ if (st /= stat_failed_image) stop 1
+ if (x[2] /= 42) stop 2
+ case (2)
+ do while (image_status (3) /= stat_failed_image)
+ end do
+ x = 42
+ st = 0
+ sync images ([1, 3], stat=st)
+ if (st /= stat_failed_image) stop 3
+ case (3)
+ a = 0
+ do while (a == 0)
+ call atomic_ref (a, arrived)
+ end do
+ call spin ()
+ fail image
+ end select
+contains
+ subroutine spin ()
+ integer :: c
+ integer(kind=8) :: v
+ v = 2
+ do c = 1, 20000000
+ v = mod (v * 2, 199679_8)
+ end do
+ end subroutine
+end program sync_images_failed_1
diff --git a/gcc/testsuite/gfortran.dg/coarray/sync_images_stopped_2.f90 b/gcc/testsuite/gfortran.dg/coarray/sync_images_stopped_2.f90
new file mode 100644
index 00000000000..5d5ac61c83f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/sync_images_stopped_2.f90
@@ -0,0 +1,58 @@
+! { dg-do run }
+! PR 127684
+!
+! SYNC IMAGES (STAT=) with a stopped image in the image set has the effect of
+! SYNC MEMORY (F2023 11.7.11), both for an image that already waits in the
+! statement when the image stops and for one that arrives later. The next
+! SYNC IMAGES of these two images has to pair with each other.
+!
+! Image 1 tells image 3 that it is about to wait for images 2 and 3; image 3
+! spins to give it time to start waiting, then stops. Image 2 executes its
+! first SYNC IMAGES only after it sees image 3 stopped, and image 1 checks
+! the pairing of the next one through X. Without the fix the test hangs.
+
+program sync_images_stopped_2
+ use iso_fortran_env, only : atomic_int_kind, stat_stopped_image
+ implicit none
+ integer(atomic_int_kind) :: arrived[*], a
+ integer :: st, x[*]
+
+ if (num_images () < 3) stop
+ arrived = 0
+ x = 0
+ sync all
+
+ select case (this_image ())
+ case (1)
+ call atomic_define (arrived[3], 1)
+ st = 0
+ sync images ([2, 3], stat=st)
+ if (st /= stat_stopped_image) stop 1
+ sync images (2)
+ if (x[2] /= 42) stop 2
+ case (2)
+ do while (image_status (3) /= stat_stopped_image)
+ end do
+ st = 0
+ sync images ([1, 3], stat=st)
+ if (st /= stat_stopped_image) stop 3
+ x = 42
+ sync images (1)
+ case (3)
+ a = 0
+ do while (a == 0)
+ call atomic_ref (a, arrived)
+ end do
+ call spin ()
+ stop
+ end select
+contains
+ subroutine spin ()
+ integer :: c
+ integer(kind=8) :: v
+ v = 2
+ do c = 1, 20000000
+ v = mod (v * 2, 199679_8)
+ end do
+ end subroutine
+end program sync_images_stopped_2
diff --git a/libgfortran/caf/shmem.c b/libgfortran/caf/shmem.c
index 08ae3113da5..d5d725b40e6 100644
--- a/libgfortran/caf/shmem.c
+++ b/libgfortran/caf/shmem.c
@@ -528,23 +528,6 @@ _gfortran_caf_sync_images (int count, int images[], int *stat, char *errmsg,
if (images[c] > 0 && images[c] <= max_id)
{
mapped_images[c] = map[images[c] - 1];
- switch (this_image.supervisor->images[mapped_images[c]].status)
- {
- case IMAGE_SUCCESS:
- caf_internal_error ("SYNC IMAGES: Image %d is stopped", stat,
- errmsg, errmsg_len, images[c]);
- /* We can come here only, when stat is non-NULL. */
- *stat = CAF_STAT_STOPPED_IMAGE;
- return;
- case IMAGE_FAILED:
- caf_internal_error ("SYNC IMAGES: Image %d has failed", stat,
- errmsg, errmsg_len, images[c]);
- /* We can come here only, when stat is non-NULL. */
- *stat = CAF_STAT_FAILED_IMAGE;
- return;
- default:
- break;
- }
for (int i = 0; i < c; ++i)
if (mapped_images[c] == mapped_images[i])
{
@@ -570,8 +553,12 @@ _gfortran_caf_sync_images (int count, int images[], int *stat, char *errmsg,
HEALTH_CHECK (stat, errmsg, errmsg_len);
__asm__ __volatile__ ("" ::: "memory");
- sync_table (&local->si, mapped_images, count);
- if (count > 0)
+ if (!sync_table (&local->si, mapped_images, count))
+ {
+ if (stat)
+ *stat = 0;
+ }
+ else if (count > 0)
check_health (mapped_images, count, stat, errmsg, errmsg_len);
else
HEALTH_CHECK (stat, errmsg, errmsg_len);
@@ -589,11 +576,7 @@ mark_stopped (void)
return;
if (this_image.supervisor->images[this_image.image_num].status == IMAGE_OK)
- {
- this_image.supervisor->images[this_image.image_num].status
- = IMAGE_SUCCESS;
- atomic_fetch_add (&this_image.supervisor->finished_images, 1);
- }
+ sync_table_terminated (&local->si, this_image.image_num, true);
leave_teams (true);
}
@@ -657,8 +640,7 @@ void
_gfortran_caf_fail_image (void)
{
fputs ("IMAGE FAILED!\n", stderr);
- this_image.supervisor->images[this_image.image_num].status = IMAGE_FAILED;
- atomic_fetch_add (&this_image.supervisor->failed_images, 1);
+ sync_table_terminated (&local->si, this_image.image_num, false);
leave_teams (false);
exit (0);
}
diff --git a/libgfortran/caf/shmem/supervisor.c b/libgfortran/caf/shmem/supervisor.c
index 246f98aab63..67dffcd23d0 100644
--- a/libgfortran/caf/shmem/supervisor.c
+++ b/libgfortran/caf/shmem/supervisor.c
@@ -432,8 +432,7 @@ supervisor_main_loop (int *argc __attribute__ ((unused)),
image already. */
if (m->images[j].status == IMAGE_OK)
{
- m->images[j].status = IMAGE_SUCCESS;
- atomic_fetch_add (&m->finished_images, 1);
+ sync_table_terminated (&local->si, j, true);
}
}
else if (!WIFEXITED (chstatus) || WEXITSTATUS (chstatus))
@@ -484,8 +483,7 @@ supervisor_main_loop (int *argc __attribute__ ((unused)),
already, e.g. by a STOP with a non-zero stop code. */
if (m->images[j].status == IMAGE_OK)
{
- m->images[j].status = IMAGE_FAILED;
- atomic_fetch_add (&m->failed_images, 1);
+ sync_table_terminated (&local->si, j, false);
/* The image did not leave the barriers of its teams, so do
it for it. */
update_registered_teams ();
@@ -496,11 +494,6 @@ supervisor_main_loop (int *argc __attribute__ ((unused)),
*exit_code = 1;
}
}
- /* Trigger waiting sync images aka sync_table. */
- for (j = 0; j < local->total_num_images; j++)
- caf_shmem_cond_signal (&SHMPTR_AS (caf_shmem_condvar *,
- m->sync_shared.sync_images_cond_vars,
- &local->sm)[j]);
counter_barrier_add (&m->num_active_images, -1);
#elif defined(WIN32)
DWORD res = WaitForMultipleObjects (count_waiting, waiting_handles, FALSE,
diff --git a/libgfortran/caf/shmem/sync.c b/libgfortran/caf/shmem/sync.c
index 9deb31f0871..1dfd1621c15 100644
--- a/libgfortran/caf/shmem/sync.c
+++ b/libgfortran/caf/shmem/sync.c
@@ -42,21 +42,34 @@ unlock_table (sync_t *si)
caf_shmem_mutex_unlock (&si->cis->sync_images_table_lock);
}
+/* Set the pointers to the parts of the sync images table. */
+
+static void
+set_table_parts (sync_t *si, int *table)
+{
+ const size_t n = local->total_num_images;
+
+ si->table = table;
+ si->waiting = table + n * n;
+ si->aborted = table + 2 * n * n;
+}
+
void
sync_init (sync_t *si, shared_memory sm)
{
- *si = (sync_t) {
- &this_image.supervisor->sync_shared,
- SHMPTR_AS (int *, this_image.supervisor->sync_shared.sync_images_table, sm),
- SHMPTR_AS (caf_shmem_condvar *,
- this_image.supervisor->sync_shared.sync_images_cond_vars, sm)};
+ si->cis = &this_image.supervisor->sync_shared;
+ si->triggers = SHMPTR_AS (caf_shmem_condvar *,
+ si->cis->sync_images_cond_vars, sm);
+ set_table_parts (si, SHMPTR_AS (int *, si->cis->sync_images_table, sm));
}
void
sync_init_supervisor (sync_t *si, alloc *ai)
{
const int num_images = local->total_num_images;
- const size_t table_size_in_bytes = sizeof (int) * num_images * num_images;
+ /* N x N counts, N x N waiting flags and N aborted flags, see sync_t. */
+ const size_t table_size_in_bytes
+ = sizeof (int) * (2 * num_images * num_images + num_images);
si->cis = &this_image.supervisor->sync_shared;
@@ -71,7 +84,7 @@ sync_init_supervisor (sync_t *si, alloc *ai)
= allocator_shared_malloc (alloc_get_allocator (ai),
sizeof (caf_shmem_condvar) * num_images);
- si->table = SHMPTR_AS (int *, si->cis->sync_images_table, ai->mem);
+ set_table_parts (si, SHMPTR_AS (int *, si->cis->sync_images_table, ai->mem));
si->triggers
= SHMPTR_AS (caf_shmem_condvar *, si->cis->sync_images_cond_vars, ai->mem);
@@ -81,7 +94,18 @@ sync_init_supervisor (sync_t *si, alloc *ai)
memset (si->table, 0, table_size_in_bytes);
}
-void
+/* Whether one of the SIZE IMAGES has stopped. */
+
+static bool
+stopped_image_in (const int *images, int size)
+{
+ for (int i = 0; i < size; ++i)
+ if (this_image.supervisor->images[images[i]].status == IMAGE_SUCCESS)
+ return true;
+ return false;
+}
+
+bool
sync_table (sync_t *si, int *images, int size)
{
/* The variable `table` is an N x N matrix, where N is the number of all
@@ -97,6 +121,7 @@ sync_table (sync_t *si, int *images, int size)
/* The table is allocated for all images, so the row stride is the total
number of images and not the (shrinking) number of images in a team. */
const size_t img_c = local->total_num_images;
+ bool terminated;
int i;
if (size <= 0)
@@ -106,6 +131,16 @@ sync_table (sync_t *si, int *images, int size)
}
lock_table (si);
+ /* With a stopped image in the set this only has the effect of SYNC
+ MEMORY; failed images are skipped (F2023 11.7.11). */
+ if (stopped_image_in (images, size))
+ {
+ unlock_table (si);
+ return true;
+ }
+ for (i = 0; i < size; ++i)
+ si->waiting[images[i] + img_c * this_image.image_num] = 1;
+ si->aborted[this_image.image_num] = 0;
for (i = 0; i < size; ++i)
{
if (this_image.supervisor->images[images[i]].status != IMAGE_OK)
@@ -115,6 +150,9 @@ sync_table (sync_t *si, int *images, int size)
}
for (;;)
{
+ /* An image of the set stopped, see sync_table_terminated. */
+ if (si->aborted[this_image.image_num])
+ break;
for (i = 0; i < size; ++i)
if (this_image.supervisor->images[images[i]].status == IMAGE_OK
&& table[images[i] + img_c * this_image.image_num]
@@ -125,6 +163,47 @@ sync_table (sync_t *si, int *images, int size)
caf_shmem_cond_wait (&si->triggers[this_image.image_num],
&si->cis->sync_images_table_lock);
}
+ terminated = si->aborted[this_image.image_num];
+ for (i = 0; i < size; ++i)
+ {
+ si->waiting[images[i] + img_c * this_image.image_num] = 0;
+ if (this_image.supervisor->images[images[i]].status != IMAGE_OK)
+ terminated = true;
+ }
+ unlock_table (si);
+ return terminated;
+}
+
+void
+sync_table_terminated (sync_t *si, int image, bool stopped)
+{
+ volatile int *table = si->table;
+ const size_t img_c = local->total_num_images;
+
+ lock_table (si);
+ for (size_t j = 0; j < img_c; ++j)
+ {
+ if (!si->waiting[image + img_c * j])
+ continue;
+ if (stopped)
+ {
+ /* Take back the counts of J that its partners have not matched.
+ IMAGE is marked stopped only below, so no image that sees the
+ stop can pair with J's aborted SYNC IMAGES. */
+ for (size_t k = 0; k < img_c; ++k)
+ if (si->waiting[k + img_c * j]
+ && table[k + img_c * j] > table[j + img_c * k])
+ --table[k + img_c * j];
+ si->aborted[j] = 1;
+ }
+ caf_shmem_cond_signal (&si->triggers[j]);
+ }
+ /* The images woken above need the table lock to return from their wait,
+ so they see this count and the new status. */
+ atomic_fetch_add (stopped ? &this_image.supervisor->finished_images
+ : &this_image.supervisor->failed_images, 1);
+ this_image.supervisor->images[image].status
+ = stopped ? IMAGE_SUCCESS : IMAGE_FAILED;
unlock_table (si);
}
diff --git a/libgfortran/caf/shmem/sync.h b/libgfortran/caf/shmem/sync.h
index d7b96992840..e4916f5958f 100644
--- a/libgfortran/caf/shmem/sync.h
+++ b/libgfortran/caf/shmem/sync.h
@@ -41,6 +41,12 @@ typedef struct {
sync_shared *cis;
int *table; // we can cache the table and the trigger pointers here
caf_shmem_condvar *triggers;
+ /* Guarded by sync_images_table_lock, like TABLE. With N the number of all
+ images, waiting[K + N * J] is set while image J waits in sync_table with
+ image K in its set, and aborted[J] is set by sync_table_terminated when
+ an image of that set stops. Image J clears both. */
+ int *waiting;
+ int *aborted;
} sync_t;
typedef caf_shmem_mutex caf_shmem_lock_t;
@@ -69,7 +75,17 @@ void sync_team (caf_shmem_team_t team);
bool sync_team_unless_stopped (caf_shmem_team_t team, int *terminated);
-void sync_table (sync_t *, int *, int);
+/* Synchronize with the SIZE images in the array, or with the images of the
+ current team when SIZE is zero. Returns true when an image of the set
+ terminated before the images synchronized. */
+
+bool sync_table (sync_t *, int *, int);
+
+/* Set the status of IMAGE, which terminated, to stopped or failed, count it
+ and wake the images waiting for it in sync_table. When it STOPPED, the
+ synchronizations of these images are aborted. */
+
+void sync_table_terminated (sync_t *, int image, bool stopped);
void lock_alloc_lock (sync_t *);
--
2.55.0
