From 39bf20246c20bfacb8ff52f4139952279feea999 Mon Sep 17 00:00:00 2001 From: Dan Bonachea Date: Mon, 30 Jun 2025 14:10:32 -0700 Subject: [PATCH 1/5] assert_always: Add optional arguments for file and line --- src/assert/assert_subroutine_m.F90 | 27 ++++++++++++++++++++++++--- 1 file changed, 24 insertions(+), 3 deletions(-) diff --git a/src/assert/assert_subroutine_m.F90 b/src/assert/assert_subroutine_m.F90 index 8fd0a68..c7b400c 100644 --- a/src/assert/assert_subroutine_m.F90 +++ b/src/assert/assert_subroutine_m.F90 @@ -87,16 +87,37 @@ 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 @@ -107,10 +128,10 @@ pure subroutine assert_always(assertion, description) 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 From cb3669aec24ab509bb6d3514fe12998e24b0773e Mon Sep 17 00:00:00 2001 From: Dan Bonachea Date: Mon, 30 Jun 2025 14:10:57 -0700 Subject: [PATCH 2/5] Simplify macros to use new optional arguments for passing location --- include/assert_macros.h | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) 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) From 4509eafdc5cfeaa17eee07bf46c16230d5fb2dda Mon Sep 17 00:00:00 2001 From: Dan Bonachea Date: Mon, 30 Jun 2025 14:11:46 -0700 Subject: [PATCH 3/5] Remove dead code fortran_stringify_integer_m in no longer used --- src/assert/fortran_stringify_integer_m.f90 | 16 ---------------- src/assert_m.f90 | 8 -------- 2 files changed, 24 deletions(-) delete mode 100644 src/assert/fortran_stringify_integer_m.f90 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 From b69386c65db4f46989792a219f53923b9320f7b9 Mon Sep 17 00:00:00 2001 From: Dan Bonachea Date: Mon, 30 Jun 2025 14:21:01 -0700 Subject: [PATCH 4/5] ASSERT_PARALLEL_CALLBACKS: Deploy more safety Previously with ASSERT_PARALLEL_CALLBACKS feature, we would crash if an assertion failed before the procedure pointers were set. Ensure reasonable behavior for that corner-case. --- src/assert/assert_subroutine_m.F90 | 15 +++++++++++---- 1 file changed, 11 insertions(+), 4 deletions(-) diff --git a/src/assert/assert_subroutine_m.F90 b/src/assert/assert_subroutine_m.F90 index c7b400c..81edb3b 100644 --- a/src/assert/assert_subroutine_m.F90 +++ b/src/assert/assert_subroutine_m.F90 @@ -121,7 +121,11 @@ pure subroutine assert_always(assertion, description, file, line) #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 @@ -136,10 +140,13 @@ pure subroutine assert_always(assertion, description, file, line) #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 From 253f4973cff18528d82a4ebf83c3129496a64a28 Mon Sep 17 00:00:00 2001 From: Dan Bonachea Date: Mon, 30 Jun 2025 14:26:59 -0700 Subject: [PATCH 5/5] CI: Add invoke-via-macro under ASSERT_PARALLEL_CALLBACKS --- .github/workflows/build.yml | 1 + 1 file changed, 1 insertion(+) 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 )