create example using stop callback

example/support-test/register_stop_callback.f90

@@ -0,0 +1,28 @@
+program register_stop_callback
+    use iso_c_binding, only: c_bool, c_int
+    use prif, only : &
+       prif_init, &
+       prif_register_stop_callback, &
+       prif_stop, &
+       prif_stop_callback_interface
+    implicit none
+
+    integer init_exit_code
+    logical(kind=c_bool), parameter :: false = .false._c_bool
+    ! use of the pointer is unnecessary according to the standard,
+    ! but gfortran complains without it
+    procedure(prif_stop_callback_interface), pointer :: callback_ptr
+    callback_ptr => callback
+
+    call prif_init(init_exit_code)
+    call prif_register_stop_callback(callback_ptr)
+    call prif_stop(false)
+contains
+    subroutine callback(is_error_stop, quiet, stop_code_int, stop_code_char)
+        logical(c_bool), intent(in) :: is_error_stop, quiet
+        integer(c_int), intent(in), optional :: stop_code_int
+        character(len=*), intent(in), optional :: stop_code_char
+
+        print *, "callback invoked"
+    end subroutine
+end program

src/prif.F90

@@ -120,7 +120,7 @@ module subroutine prif_init(stat)
 
     module subroutine prif_register_stop_callback(callback)
       implicit none
-      procedure(prif_stop_callback_interface), pointer :: callback
+      procedure(prif_stop_callback_interface), pointer, intent(in) :: callback
     end subroutine
 
     module subroutine prif_stop(quiet, stop_code_int, stop_code_char)

test/caf_stop_test.f90

@@ -15,6 +15,7 @@ function test_prif_this_image() result(tests)
                 [ it("exits with a zero exitstat when the program omits the stop code", exit_with_no_stop_code) &
                  ,it("prints an integer stop code and exits with exitstat equal to the stop code", exit_with_integer_stop_code) &
                  ,it("prints a character stop code and exits with a non-zero exitstat", exit_with_character_stop_code) &
+                 ,it("invokes a registered callback", check_callback_invocation) &
                 ])
     end function
 
@@ -57,4 +58,17 @@ function exit_with_character_stop_code() result(result_)
 
     end function
 
+    function check_callback_invocation() result(result_)
+      type(result_t) :: result_
+
+      integer :: exit_status
+
+      call execute_command_line( &
+        command = "./build/run-fpm.sh run --example register_stop_callback > /dev/null 2>&1", &
+        wait = .true., &
+        exitstat = exit_status &
+      )
+      result_ = assert_equals(0, exit_status)
+    end function
+
 end module caf_stop_test