https://gcc.gnu.org/g:39a6b7de56ebd7091c092a4b07fed3809f10544d
commit r17-4633-g39a6b7de56ebd7091c092a4b07fed3809f10544d Author: Jerry DeLisle <[email protected]> Date: Fri Aug 28 16:40:44 2026 -0700 libgfortran: [PR127347] caf_shmem: terminate all images on ERROR STOP An image executing ERROR STOP exited on its own, and the other images blocked forever in their next image control statement. ERROR STOP initiates error termination of all images. The image now records that it error stopped before exiting, and the supervisor terminates all other images when it reaps it. Only the fork based supervisor does so. Assisted-by: Claude Opus 5 PR libfortran/127347 libgfortran/ChangeLog: * caf/shmem.c (mark_error_stopped): New function. (_gfortran_caf_error_stop_str, _gfortran_caf_error_stop): Call it. * caf/shmem/supervisor.c (supervisor_main_loop): Terminate all images when an image error stopped. * caf/shmem/supervisor.h (image_status): Add IMAGE_ERROR_STOP. gcc/testsuite/ChangeLog: * gfortran.dg/coarray/error_stop_1.f90: New test. Diff: --- gcc/testsuite/gfortran.dg/coarray/error_stop_1.f90 | 18 ++++++++++++++++ libgfortran/caf/shmem.c | 13 ++++++++++++ libgfortran/caf/shmem/supervisor.c | 24 ++++++++++++++-------- libgfortran/caf/shmem/supervisor.h | 4 +++- 4 files changed, 50 insertions(+), 9 deletions(-) diff --git a/gcc/testsuite/gfortran.dg/coarray/error_stop_1.f90 b/gcc/testsuite/gfortran.dg/coarray/error_stop_1.f90 new file mode 100644 index 000000000000..bdbd20f6fd66 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray/error_stop_1.f90 @@ -0,0 +1,18 @@ +! { dg-do run } +! { dg-shouldfail "ERROR STOP terminates all images" } +! { dg-output "ERROR STOP no way back" } +! +! ERROR STOP on one image has to terminate all other images. Without that +! the surviving images block in the SYNC ALL below until the test times out. + +program error_stop_all_images + implicit none + integer :: i + + sync all + if (this_image () == num_images ()) error stop "no way back" + + do i = 1, 100 + sync all + end do +end program error_stop_all_images diff --git a/libgfortran/caf/shmem.c b/libgfortran/caf/shmem.c index 6288d22204c6..c6735146a2eb 100644 --- a/libgfortran/caf/shmem.c +++ b/libgfortran/caf/shmem.c @@ -570,6 +570,17 @@ _gfortran_caf_sync_images (int count, int images[], int *stat, char *errmsg, extern void _gfortran_report_exception (void); +/* Tell the supervisor that this image error stopped, so that it can terminate + all other images. */ + +static void +mark_error_stopped (void) +{ + if (this_image.supervisor && this_image.image_num >= 0) + this_image.supervisor->images[this_image.image_num].status + = IMAGE_ERROR_STOP; +} + void _gfortran_caf_stop_numeric (int stop_code, bool quiet) { @@ -607,6 +618,7 @@ _gfortran_caf_error_stop_str (const char *string, size_t len, bool quiet) fputc (*(string++), stderr); fputs ("\n", stderr); } + mark_error_stopped (); exit (1); } @@ -739,6 +751,7 @@ _gfortran_caf_error_stop (int error, bool quiet) _gfortran_report_exception (); fprintf (stderr, "ERROR STOP %d\n", error); } + mark_error_stopped (); exit (error); } diff --git a/libgfortran/caf/shmem/supervisor.c b/libgfortran/caf/shmem/supervisor.c index 0836b89d99f9..ff4a592b6f28 100644 --- a/libgfortran/caf/shmem/supervisor.c +++ b/libgfortran/caf/shmem/supervisor.c @@ -408,12 +408,24 @@ supervisor_main_loop (int *argc __attribute__ ((unused)), --i; continue; } - if (WIFEXITED (chstatus) && !WEXITSTATUS (chstatus)) + for (j = 0; + j < local->total_num_images && m->images[j].pid != finished_pid; + j++) + ; + + /* An ERROR STOP on any image terminates all images. */ + if (j < local->total_num_images + && m->images[j].status == IMAGE_ERROR_STOP) { - for (j = 0; - j < local->total_num_images && m->images[j].pid != finished_pid; - j++) + kill_all_images (m); + while (wait (NULL) > 0) ; + *exit_code = WIFEXITED (chstatus) ? WEXITSTATUS (chstatus) : 1; + return 0; + } + + if (WIFEXITED (chstatus) && !WEXITSTATUS (chstatus)) + { /* Only set the status, when it has not been set by the (failing) image already. */ if (m->images[j].status == IMAGE_OK) @@ -424,10 +436,6 @@ supervisor_main_loop (int *argc __attribute__ ((unused)), } else if (!WIFEXITED (chstatus) || WEXITSTATUS (chstatus)) { - for (j = 0; - j < local->total_num_images && m->images[j].pid != finished_pid; - j++) - ; if (WEXITSTATUS (chstatus) == 210) { --i; diff --git a/libgfortran/caf/shmem/supervisor.h b/libgfortran/caf/shmem/supervisor.h index e5c275b65268..a956092e2635 100644 --- a/libgfortran/caf/shmem/supervisor.h +++ b/libgfortran/caf/shmem/supervisor.h @@ -41,7 +41,9 @@ typedef enum IMAGE_UNKNOWN = 0, IMAGE_OK, IMAGE_FAILED, - IMAGE_SUCCESS + IMAGE_SUCCESS, + /* The image executed an ERROR STOP and requires all images to terminate. */ + IMAGE_ERROR_STOP } image_status; typedef struct
