1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
|
program false_assertion
use assert_m
implicit none
#if ASSERT_PARALLEL_CALLBACKS
assert_this_image => assert_callback_this_image
assert_error_stop => assert_callback_error_stop
#endif
call assert(.false., "false-assertion: unconditionally failing test")
#if ASSERT_PARALLEL_CALLBACKS
! By default, assert uses `THIS_IMAGE()` in multi-image mode while
! composing assertion output, and invokes `ERROR STOP` to print the
! assertion and terminate execution.
!
! The ASSERT_PARALLEL_CALLBACKS preprocessor flag enables the client to replace
! the default use of these two Fortran features with client-provided callbacks.
! To use this feature, the client must build the library with `-DASSERT_PARALLEL_CALLBACKS`,
! and then at startup set the `assert_this_image` and `assert_error_stop`
! procedure pointers to reference the desired callbacks.
contains
pure function assert_callback_this_image() result(this_image_id)
implicit none
integer :: this_image_id
this_image_id = 42
end function
pure subroutine assert_callback_error_stop(stop_code_char)
implicit none
character(len=*), intent(in) :: stop_code_char
error stop "Hello from assert_callback_error_stop!" // NEW_LINE('a') // &
"Your assertion: " // NEW_LINE('a') // stop_code_char
end subroutine
#endif
end program
|
