See attached patch. _gfortran_caf_end_team synchronized the team with
sync_team, whose barrier wait threw away the count of images that had
stopped or failed, and then left STAT= at 0. A stopped or failed image
in the team being ended was therefore never reported. The barrier
round already records how many images had left when it ended, and
counter_barrier_wait_abortable already passes that out; this patch
lets counter_barrier_wait pass it out too. END TEAM keeps the
non-abortable wait, so the remaining images still synchronize with
each other, and then calls TEAM_HEALTH_CHECK on the ended team when
the count is nonzero.
Start with _gfortran_caf_end_team in shmem.c: the barrier wait that
returns the count, the coarray deallocation that no longer takes
STAT=/ERRMSG= (so a deallocation status cannot overwrite the team
status), and TEAM_HEALTH_CHECK at the end, after the team is back on
caf_teams_formed. Then counter_barrier_wait in counter_barrier.c and
counter_barrier.h, which forwards TERMINATED to wait_round; the
comment on TERMINATED moves to it from the abortable variant.
sync_team in sync.c passes NULL. Of the tests, end_team_stat_1 and
end_team_stat_2 are new. signal_team_1, stop_end_team_1 and
stop_sync_team_1 end a team that contains a stopped or failed image,
which now means error termination without STAT=, so they get
END TEAM (STAT=).
Regression tested on x86_64.
OK for mainline?
Regards,
Jerry
---
libgfortran: [PR127837] Set END TEAM STAT= for stopped and failed images
With caf_shmem, END TEAM always returned STAT=0 because
_gfortran_caf_end_team synchronized with sync_team, which does not
report stopped or failed images. Without STAT= such an image did not
cause error termination either, as F2023 11.7.11 requires. END TEAM
now takes the number of terminated images from the barrier round and
runs TEAM_HEALTH_CHECK on the ended team after deallocating its
coarrays; counter_barrier_wait gains a TERMINATED argument for this.
Existing tests that end a team containing a stopped or failed image
now give END TEAM a STAT= variable.
Assisted-by: Claude Opus 5.5
PR libfortran/127837
libgfortran/ChangeLog:
* caf/shmem.c (_gfortran_caf_end_team): Wait with
counter_barrier_wait and set STAT= with TEAM_HEALTH_CHECK when
an image of the team stopped or failed. Do not pass STAT= to
_gfortran_caf_deregister.
* caf/shmem/counter_barrier.c (counter_barrier_wait): Add
TERMINATED argument.
* caf/shmem/counter_barrier.h (counter_barrier_wait): Likewise.
* caf/shmem/sync.c (sync_team): Update call.
gcc/testsuite/ChangeLog:
* gfortran.dg/coarray/signal_team_1.f90: Add STAT= to END TEAM.
* gfortran.dg/coarray/stop_end_team_1.f90: Likewise and check it.
* gfortran.dg/coarray/stop_sync_team_1.f90: Likewise.
* gfortran.dg/coarray/end_team_stat_1.f90: New test.
* gfortran.dg/coarray/end_team_stat_2.f90: New test.
>From 87475204c580c4fff745a3c1d146760d32418466 Mon Sep 17 00:00:00 2001
From: Jerry DeLisle <[email protected]>
Date: Mon, 5 Oct 2026 18:13:33 -0700
Subject: [PATCH] libgfortran: [PR127837] Set END TEAM STAT= for stopped and
failed images
With caf_shmem, END TEAM always returned STAT=0 because
_gfortran_caf_end_team synchronized with sync_team, which does not
report stopped or failed images. Without STAT= such an image did not
cause error termination either, as F2023 11.7.11 requires. END TEAM
now takes the number of terminated images from the barrier round and
runs TEAM_HEALTH_CHECK on the ended team after deallocating its
coarrays; counter_barrier_wait gains a TERMINATED argument for this.
Existing tests that end a team containing a stopped or failed image
now give END TEAM a STAT= variable.
Assisted-by: Claude Opus 5.5
PR libfortran/127837
libgfortran/ChangeLog:
* caf/shmem.c (_gfortran_caf_end_team): Wait with
counter_barrier_wait and set STAT= with TEAM_HEALTH_CHECK when
an image of the team stopped or failed. Do not pass STAT= to
_gfortran_caf_deregister.
* caf/shmem/counter_barrier.c (counter_barrier_wait): Add
TERMINATED argument.
* caf/shmem/counter_barrier.h (counter_barrier_wait): Likewise.
* caf/shmem/sync.c (sync_team): Update call.
gcc/testsuite/ChangeLog:
* gfortran.dg/coarray/signal_team_1.f90: Add STAT= to END TEAM.
* gfortran.dg/coarray/stop_end_team_1.f90: Likewise and check it.
* gfortran.dg/coarray/stop_sync_team_1.f90: Likewise.
* gfortran.dg/coarray/end_team_stat_1.f90: New test.
* gfortran.dg/coarray/end_team_stat_2.f90: New test.
---
.../gfortran.dg/coarray/end_team_stat_1.f90 | 42 +++++++++++++++++++
.../gfortran.dg/coarray/end_team_stat_2.f90 | 18 ++++++++
.../gfortran.dg/coarray/signal_team_1.f90 | 2 +-
.../gfortran.dg/coarray/stop_end_team_1.f90 | 3 +-
.../gfortran.dg/coarray/stop_sync_team_1.f90 | 4 +-
libgfortran/caf/shmem.c | 17 +++++---
libgfortran/caf/shmem/counter_barrier.c | 4 +-
libgfortran/caf/shmem/counter_barrier.h | 10 ++---
libgfortran/caf/shmem/sync.c | 2 +-
9 files changed, 85 insertions(+), 17 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/coarray/end_team_stat_1.f90
create mode 100644 gcc/testsuite/gfortran.dg/coarray/end_team_stat_2.f90
diff --git a/gcc/testsuite/gfortran.dg/coarray/end_team_stat_1.f90 b/gcc/testsuite/gfortran.dg/coarray/end_team_stat_1.f90
new file mode 100644
index 00000000000..1a3fdafefe2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/end_team_stat_1.f90
@@ -0,0 +1,42 @@
+! { dg-do run }
+! { dg-skip-if "CHANGE TEAM needs a coarray library" { *-*-* } { "-fcoarray=single" } { "" } }
+!
+! END TEAM (STAT=) reports a stopped or failed image of the team it ends,
+! not one of a sibling team, and still deallocates the team's coarrays.
+
+program end_team_stat_1
+ use iso_fortran_env, only : team_type, stat_stopped_image, stat_failed_image
+ implicit none
+ type(team_type) :: t
+ integer, allocatable :: a[:]
+ integer :: me, st
+ character(len=40) :: msg
+
+ if (num_images () < 6) stop
+ me = mod (this_image () - 1, 3) + 1
+ form team (me, t)
+
+ change team (t)
+ msg = "unchanged"
+ end team (stat=st, errmsg=msg)
+ if (st /= 0 .or. msg /= "unchanged") error stop 1
+
+ change team (t)
+ allocate (a[*])
+ if (this_image () == num_images ()) then
+ if (me == 1) stop
+ if (me == 2) fail image
+ end if
+ st = -1
+ msg = "unchanged"
+ end team (stat=st, errmsg=msg)
+ if (allocated (a)) error stop 2
+ select case (me)
+ case (1)
+ if (st /= stat_stopped_image .or. msg == "unchanged") error stop 3
+ case (2)
+ if (st /= stat_failed_image .or. msg == "unchanged") error stop 4
+ case (3)
+ if (st /= 0 .or. msg /= "unchanged") error stop 5
+ end select
+end program end_team_stat_1
diff --git a/gcc/testsuite/gfortran.dg/coarray/end_team_stat_2.f90 b/gcc/testsuite/gfortran.dg/coarray/end_team_stat_2.f90
new file mode 100644
index 00000000000..600d4058448
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/end_team_stat_2.f90
@@ -0,0 +1,18 @@
+! { dg-do run }
+! { dg-skip-if "CHANGE TEAM needs a coarray library" { *-*-* } { "-fcoarray=single" } { "" } }
+! { dg-shouldfail "END TEAM without STAT= in a team with a stopped image" }
+!
+! END TEAM without STAT= in a team with a stopped image is error
+! termination.
+
+program end_team_stat_2
+ use iso_fortran_env, only : team_type
+ implicit none
+ type(team_type) :: t
+
+ if (num_images () < 2) error stop
+ form team (1, t)
+ change team (t)
+ if (this_image () == num_images ()) stop
+ end team
+end program end_team_stat_2
diff --git a/gcc/testsuite/gfortran.dg/coarray/signal_team_1.f90 b/gcc/testsuite/gfortran.dg/coarray/signal_team_1.f90
index 958801a7fda..bcce79c939e 100644
--- a/gcc/testsuite/gfortran.dg/coarray/signal_team_1.f90
+++ b/gcc/testsuite/gfortran.dg/coarray/signal_team_1.f90
@@ -22,5 +22,5 @@ program signal_team_1
if (st == stat_failed_image) exit
end do
if (num_images () > 1 .and. st /= stat_failed_image) error stop "not reported"
- end team
+ end team (stat=st)
end program signal_team_1
diff --git a/gcc/testsuite/gfortran.dg/coarray/stop_end_team_1.f90 b/gcc/testsuite/gfortran.dg/coarray/stop_end_team_1.f90
index 79e7d246f57..3b5fe656ff5 100644
--- a/gcc/testsuite/gfortran.dg/coarray/stop_end_team_1.f90
+++ b/gcc/testsuite/gfortran.dg/coarray/stop_end_team_1.f90
@@ -21,7 +21,8 @@ program stop_end_team_1
if (st /= 0 .and. st /= stat_stopped_image) error stop 1
end do
end if
- end team
+ end team (stat=st)
+ if (me == 1 .and. num_images () > 2 .and. st /= stat_stopped_image) error stop 3
st = -1
sync all (stat=st)
if (num_images () > 2 .and. st /= stat_stopped_image) error stop 2
diff --git a/gcc/testsuite/gfortran.dg/coarray/stop_sync_team_1.f90 b/gcc/testsuite/gfortran.dg/coarray/stop_sync_team_1.f90
index 9eba00e7b10..a3c9106d35d 100644
--- a/gcc/testsuite/gfortran.dg/coarray/stop_sync_team_1.f90
+++ b/gcc/testsuite/gfortran.dg/coarray/stop_sync_team_1.f90
@@ -28,5 +28,7 @@ program stop_sync_team_1
sync team (get_team (), stat=st)
if (me == 2 .and. st /= 0) error stop 3
if (me == 1 .and. st /= stat_stopped_image) error stop 4
- end team
+ end team (stat=st)
+ if (me == 2 .and. st /= 0) error stop 5
+ if (me == 1 .and. st /= stat_stopped_image) error stop 6
end program stop_sync_team_1
diff --git a/libgfortran/caf/shmem.c b/libgfortran/caf/shmem.c
index 7fb23f05e6c..014a26e9c9e 100644
--- a/libgfortran/caf/shmem.c
+++ b/libgfortran/caf/shmem.c
@@ -1899,26 +1899,31 @@ void
_gfortran_caf_end_team (int *stat, char *errmsg, size_t errmsg_len)
{
caf_shmem_team_t t = caf_current_team;
-
- if (stat)
- *stat = 0;
+ int terminated;
caf_current_team = caf_current_team->parent;
next_memid = t->parent_teams_last_active_memid;
- sync_team (t);
+ /* The active images synchronize even with a stopped image, unlike in
+ SYNC ALL (F2023 11.7.11). */
+ counter_barrier_wait (&t->u.image_info->image_count, &terminated);
for (struct coarray_allocated *ca = t->allocated; ca;)
{
struct coarray_allocated *nca = ca->next;
_gfortran_caf_deregister ((caf_token_t *) &ca->token,
- CAF_DEREGTYPE_COARRAY_DEALLOCATE_ONLY, stat,
- errmsg, errmsg_len);
+ CAF_DEREGTYPE_COARRAY_DEALLOCATE_ONLY, NULL,
+ NULL, 0);
free (ca);
ca = nca;
}
t->allocated = NULL;
t->parent = caf_teams_formed;
caf_teams_formed = t;
+
+ if (terminated)
+ TEAM_HEALTH_CHECK (t, stat, errmsg, errmsg_len);
+ else if (stat)
+ *stat = 0;
}
void
diff --git a/libgfortran/caf/shmem/counter_barrier.c b/libgfortran/caf/shmem/counter_barrier.c
index 1a30e45dda7..bf3a5fbb9d9 100644
--- a/libgfortran/caf/shmem/counter_barrier.c
+++ b/libgfortran/caf/shmem/counter_barrier.c
@@ -108,10 +108,10 @@ wait_round (counter_barrier *b, bool abortable, int *terminated)
}
void
-counter_barrier_wait (counter_barrier *b)
+counter_barrier_wait (counter_barrier *b, int *terminated)
{
lock_counter_barrier (b);
- while (!wait_round (b, false, NULL))
+ while (!wait_round (b, false, terminated))
;
unlock_counter_barrier (b);
}
diff --git a/libgfortran/caf/shmem/counter_barrier.h b/libgfortran/caf/shmem/counter_barrier.h
index 2eb886545b1..110cd71d76b 100644
--- a/libgfortran/caf/shmem/counter_barrier.h
+++ b/libgfortran/caf/shmem/counter_barrier.h
@@ -88,14 +88,14 @@ void counter_barrier_init_add (counter_barrier *, int);
int counter_barrier_get_count (counter_barrier *);
/* Wait for the count in the barrier drop to or below 0. When the round is
- aborted, take part in the next one. */
+ aborted, take part in the next one. TERMINATED, when given, receives the
+ number of images that had been removed from the barrier when the round
+ ended; images removed later are not counted. */
-void counter_barrier_wait (counter_barrier *);
+void counter_barrier_wait (counter_barrier *, int *terminated);
/* Like counter_barrier_wait, but return false without waiting when the
- barrier is aborting, or when the round is aborted. TERMINATED, when
- given, receives the number of images that had been removed from the
- barrier when the round ended; images removed later are not counted. */
+ barrier is aborting, or when the round is aborted. */
bool counter_barrier_wait_abortable (counter_barrier *, int *terminated);
diff --git a/libgfortran/caf/shmem/sync.c b/libgfortran/caf/shmem/sync.c
index e3041a3c128..4245c155f14 100644
--- a/libgfortran/caf/shmem/sync.c
+++ b/libgfortran/caf/shmem/sync.c
@@ -175,7 +175,7 @@ sync_all (int *terminated)
void
sync_team (caf_shmem_team_t team)
{
- counter_barrier_wait (&team->u.image_info->image_count);
+ counter_barrier_wait (&team->u.image_info->image_count, NULL);
}
bool
--
2.56.0
