Add trivial implementation for prif_fail_image

.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 ; \

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** |  |
 
 

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 

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;

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

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)