diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index 9765e2d..011816d 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -180,3 +180,4 @@ jobs: run: | set -x ( set +e ; fpm run --example false-assertion ${FPM_FLAGS} --flag "$FFLAGS" ; test $? = $ERROR_STOP_CODE ) + ( set +e ; fpm run --example invoke-via-macro ${FPM_FLAGS} --flag "$FFLAGS" ; test $? = $ERROR_STOP_CODE ) diff --git a/include/assert_macros.h b/include/assert_macros.h index ba32723..ed6e390 100644 --- a/include/assert_macros.h +++ b/include/assert_macros.h @@ -21,8 +21,8 @@ #endif #if ASSERTIONS -# define call_assert(assertion) call assert_always(assertion, "call_assert(" // CPP_STRINGIFY_SOURCE(assertion) // ") in file " // __FILE__ // ", line " // fortran_stringify_integer(__LINE__)) -# define call_assert_describe(assertion, description) call assert_always(assertion, description // " in file " // __FILE__ // ", line " // fortran_stringify_integer(__LINE__)) +# define call_assert(assertion) call assert_always(assertion, "call_assert(" // CPP_STRINGIFY_SOURCE(assertion) // ")", __FILE__, __LINE__) +# define call_assert_describe(assertion, description) call assert_always(assertion, description, __FILE__, __LINE__) #else # define call_assert(assertion) # define call_assert_describe(assertion, description) diff --git a/src/assert/assert_subroutine_m.F90 b/src/assert/assert_subroutine_m.F90 index 8fd0a68..81edb3b 100644 --- a/src/assert/assert_subroutine_m.F90 +++ b/src/assert/assert_subroutine_m.F90 @@ -87,38 +87,66 @@ pure subroutine assert(assertion, description) end subroutine - pure subroutine assert_always(assertion, description) + pure subroutine assert_always(assertion, description, file, line) !! Same as above but always enforces the assertion (regardless of ASSERTIONS) implicit none logical, intent(in) :: assertion character(len=*), intent(in) :: description + character(len=*), intent(in), optional :: file + integer, intent(in), optional :: line character(len=:), allocatable :: message + character(len=:), allocatable :: location integer me check_assertion: & if (.not. assertion) then + ! Avoid harmless warnings from Cray Fortran: + allocate(character(len=0)::message) + allocate(character(len=0)::location) + + ! format source location, if known + location = '' + if (present(file)) then + location = ' at ' // file // ':' + if (present(line)) then ! only print line number if file is also known + block + character(len=128) line_str + write(line_str, '(i0)') line + location = location // trim(adjustl(line_str)) + end block + else + location = location // '' + endif + endif #if ASSERT_MULTI_IMAGE # if ASSERT_PARALLEL_CALLBACKS - me = assert_this_image() + if (associated(assert_this_image)) then + me = assert_this_image() + else + me = 0 + endif # else me = this_image() # endif block character(len=128) image_number write(image_number, *) me - message = 'Assertion failure on image ' // trim(adjustl(image_number)) // ':' // description + message = 'Assertion failure on image ' // trim(adjustl(image_number)) // location // ': ' // description end block #else - message = 'Assertion failure: ' // description + message = 'Assertion failure' // location // ': ' // description me = 0 ! avoid a harmless warning #endif #if ASSERT_PARALLEL_CALLBACKS - call assert_error_stop(message) -#else - error stop message, QUIET=.false. + if (associated(assert_this_image)) then + call assert_error_stop(message) + else + ; ! deliberate fall-thru + endif #endif + error stop message, QUIET=.false. end if check_assertion diff --git a/src/assert/fortran_stringify_integer_m.f90 b/src/assert/fortran_stringify_integer_m.f90 deleted file mode 100644 index 2f5fc92..0000000 --- a/src/assert/fortran_stringify_integer_m.f90 +++ /dev/null @@ -1,16 +0,0 @@ -module fortran_stringify_integer_m - implicit none - -contains - - pure function fortran_stringify_integer(number) result(number_as_string) - integer, intent(in) :: number - integer, parameter :: max_len=128 - character(len=max_len) :: untrimmed_string - character(len=:), allocatable :: number_as_string - - write(untrimmed_string, '(i0)') number - number_as_string = trim(adjustl(untrimmed_string)) - end function - -end module diff --git a/src/assert_m.f90 b/src/assert_m.f90 index f9b75cb..b9a95e3 100644 --- a/src/assert_m.f90 +++ b/src/assert_m.f90 @@ -2,13 +2,5 @@ module assert_m !! Public interface use assert_subroutine_m ! DO NOT PLACE AN ONLY CLAUSE HERE! ! All public members of assert_subroutine_m are exported - - ! The function below is public only to support automated - ! invocation via `assert_macros.h`. For a more broadly useful - ! function to convert numeric data to string format, please - ! consider using the functions that can be accessed via the - ! `string_t` generic interface in the Julienne framework at - ! https://go.lbl.gov/julienne. - use fortran_stringify_integer_m, only : fortran_stringify_integer implicit none end module