From 9693473ab3767ebf91e29b37d4bccfc3c0ce0b01 Mon Sep 17 00:00:00 2001 From: Dan Bonachea Date: Thu, 15 Jan 2026 20:13:15 -0800 Subject: [PATCH 1/3] Implement prif_fail_image() This provides a trivial implementation of prif_fail_image() that just hangs the calling image forever (unless it is the only image, in which case it just terminates). This is "trivial" in the sense that other images never directly learn that another image has failed, but it is nevertheless believed to be standards-conforming. --- src/caffeine/caffeine.c | 12 ++++++++++++ src/caffeine/prif_private_s.F90 | 5 +++++ src/caffeine/program_termination_s.F90 | 6 +++++- 3 files changed, 22 insertions(+), 1 deletion(-) diff --git a/src/caffeine/caffeine.c b/src/caffeine/caffeine.c index b4704a252..43ea6b7fb 100644 --- a/src/caffeine/caffeine.c +++ b/src/caffeine/caffeine.c @@ -137,6 +137,18 @@ void caf_decaffeinate(int exit_code) gasnet_exit(exit_code); } +void caf_fail_image() { + fprintf(stderr,"FAIL IMAGE on image %d\n", myproc+1); + gasnett_flush_streams(); + + if (numprocs > 1) { + // spin-wait until we are killed, while still servicing network requests: + GASNET_BLOCKUNTIL((gasnett_nsleep(1000), 0)); + } + + gasnet_exit(1); +} + void caf_fatal_error( const CFI_cdesc_t* Fstr ) { const char *msg = (char *)Fstr->base_addr; diff --git a/src/caffeine/prif_private_s.F90 b/src/caffeine/prif_private_s.F90 index 62c352238..77c275ea7 100644 --- a/src/caffeine/prif_private_s.F90 +++ b/src/caffeine/prif_private_s.F90 @@ -53,6 +53,11 @@ subroutine caf_decaffeinate(exit_code) bind(C) integer(c_int), value :: exit_code end subroutine + subroutine caf_fail_image() bind(C) + !! void caf_fail_image(); + implicit none + end subroutine + pure subroutine caf_fatal_error(str) bind(C) !! void caf_fatal_error( const CFI_cdesc_t* Fstr ) import c_char diff --git a/src/caffeine/program_termination_s.F90 b/src/caffeine/program_termination_s.F90 index 883c2535f..860ad9394 100644 --- a/src/caffeine/program_termination_s.F90 +++ b/src/caffeine/program_termination_s.F90 @@ -135,7 +135,11 @@ subroutine prif_error_stop_integer(quiet, stop_code) end subroutine module procedure prif_fail_image - call unimplemented("prif_fail_image") +# ifndef CAF_FAIL_IMAGE_SUPPRESS_FLUSH + call flush_all() +# endif + + call caf_fail_image() end procedure subroutine run_callbacks(is_error_stop, quiet, stop_code_int, stop_code_char) From f5fc88cbf383927c8bc83df26159b154ee0f651a Mon Sep 17 00:00:00 2001 From: Dan Bonachea Date: Thu, 15 Jan 2026 20:14:56 -0800 Subject: [PATCH 2/3] Update implementation-status --- docs/implementation-status.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/implementation-status.md b/docs/implementation-status.md index 15e378ed2..9550d974e 100644 --- a/docs/implementation-status.md +++ b/docs/implementation-status.md @@ -42,7 +42,7 @@ are accepted, but in some cases, the associated runtime behavior is not fully im |-----------|--------|-------| | `prif_init` | **YES** | | | `prif_stop`, `prif_error_stop` | **YES** | | -| `prif_fail_image` | no | | +| `prif_fail_image` | **YES** | trivial implementation | | `prif_register_stop_callback` | **YES** | | From c09e1d0c7551ef9b9f30e2d00fe2c817f54254da Mon Sep 17 00:00:00 2001 From: Dan Bonachea Date: Thu, 15 Jan 2026 20:22:27 -0800 Subject: [PATCH 3/3] Add fail_image test --- .github/workflows/build.yml | 5 +++++ example/support-test/fail_image.F90 | 15 +++++++++++++++ 2 files changed, 20 insertions(+) create mode 100644 example/support-test/fail_image.F90 diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index 31c986a46..d520270b9 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -296,6 +296,11 @@ jobs: ./run-fpm.sh run --verbose --example stop_with_no_code ( set +e ; ./run-fpm.sh run --verbose --example stop_with_integer_code ; test $? = 99 ) ( set +e ; ./run-fpm.sh run --verbose --example error_stop_with_integer_code ; test $? = 100 ) + ( set +e ; \ + export CAF_IMAGES=1; \ + ./run-fpm.sh run --verbose --example fail_image 2>&1 | tee output ; \ + test ${PIPESTATUS[0]} > 0 && grep -q "FAIL IMAGE" output \ + ) unset GASNET_SPAWN_VERBOSE for ((i=1; i<=4; i++)); do \ (set +e ; \ diff --git a/example/support-test/fail_image.F90 b/example/support-test/fail_image.F90 new file mode 100644 index 000000000..bbfc516a5 --- /dev/null +++ b/example/support-test/fail_image.F90 @@ -0,0 +1,15 @@ +program fail_image + use iso_c_binding, only: c_bool + use prif, only : & + prif_init & + ,prif_error_stop & + ,prif_fail_image + implicit none + + integer init_exit_code + logical(kind=c_bool), parameter :: false = .false._c_bool + + call prif_init(init_exit_code) + call prif_fail_image() + call prif_error_stop(quiet=false) ! test fails if this line runs +end program