Skip to content

Commit b6d5bc8

Browse files
authored
Merge pull request #63 from bonachea/simplify-macro
Simplify macro
2 parents 56ff714 + 253f497 commit b6d5bc8

File tree

5 files changed

+38
-33
lines changed

5 files changed

+38
-33
lines changed

.github/workflows/build.yml

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -180,3 +180,4 @@ jobs:
180180
run: |
181181
set -x
182182
( set +e ; fpm run --example false-assertion ${FPM_FLAGS} --flag "$FFLAGS" ; test $? = $ERROR_STOP_CODE )
183+
( set +e ; fpm run --example invoke-via-macro ${FPM_FLAGS} --flag "$FFLAGS" ; test $? = $ERROR_STOP_CODE )

include/assert_macros.h

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -21,8 +21,8 @@
2121
#endif
2222

2323
#if ASSERTIONS
24-
# define call_assert(assertion) call assert_always(assertion, "call_assert(" // CPP_STRINGIFY_SOURCE(assertion) // ") in file " // __FILE__ // ", line " // fortran_stringify_integer(__LINE__))
25-
# define call_assert_describe(assertion, description) call assert_always(assertion, description // " in file " // __FILE__ // ", line " // fortran_stringify_integer(__LINE__))
24+
# define call_assert(assertion) call assert_always(assertion, "call_assert(" // CPP_STRINGIFY_SOURCE(assertion) // ")", __FILE__, __LINE__)
25+
# define call_assert_describe(assertion, description) call assert_always(assertion, description, __FILE__, __LINE__)
2626
#else
2727
# define call_assert(assertion)
2828
# define call_assert_describe(assertion, description)

src/assert/assert_subroutine_m.F90

Lines changed: 35 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -87,38 +87,66 @@ pure subroutine assert(assertion, description)
8787

8888
end subroutine
8989

90-
pure subroutine assert_always(assertion, description)
90+
pure subroutine assert_always(assertion, description, file, line)
9191
!! Same as above but always enforces the assertion (regardless of ASSERTIONS)
9292
implicit none
9393
logical, intent(in) :: assertion
9494
character(len=*), intent(in) :: description
95+
character(len=*), intent(in), optional :: file
96+
integer, intent(in), optional :: line
9597
character(len=:), allocatable :: message
98+
character(len=:), allocatable :: location
9699
integer me
97100

98101
check_assertion: &
99102
if (.not. assertion) then
103+
! Avoid harmless warnings from Cray Fortran:
104+
allocate(character(len=0)::message)
105+
allocate(character(len=0)::location)
106+
107+
! format source location, if known
108+
location = ''
109+
if (present(file)) then
110+
location = ' at ' // file // ':'
111+
if (present(line)) then ! only print line number if file is also known
112+
block
113+
character(len=128) line_str
114+
write(line_str, '(i0)') line
115+
location = location // trim(adjustl(line_str))
116+
end block
117+
else
118+
location = location // '<unknown>'
119+
endif
120+
endif
100121

101122
#if ASSERT_MULTI_IMAGE
102123
# if ASSERT_PARALLEL_CALLBACKS
103-
me = assert_this_image()
124+
if (associated(assert_this_image)) then
125+
me = assert_this_image()
126+
else
127+
me = 0
128+
endif
104129
# else
105130
me = this_image()
106131
# endif
107132
block
108133
character(len=128) image_number
109134
write(image_number, *) me
110-
message = 'Assertion failure on image ' // trim(adjustl(image_number)) // ':' // description
135+
message = 'Assertion failure on image ' // trim(adjustl(image_number)) // location // ': ' // description
111136
end block
112137
#else
113-
message = 'Assertion failure: ' // description
138+
message = 'Assertion failure' // location // ': ' // description
114139
me = 0 ! avoid a harmless warning
115140
#endif
116141

117142
#if ASSERT_PARALLEL_CALLBACKS
118-
call assert_error_stop(message)
119-
#else
120-
error stop message, QUIET=.false.
143+
if (associated(assert_this_image)) then
144+
call assert_error_stop(message)
145+
else
146+
; ! deliberate fall-thru
147+
endif
121148
#endif
149+
error stop message, QUIET=.false.
122150

123151
end if check_assertion
124152

src/assert/fortran_stringify_integer_m.f90

Lines changed: 0 additions & 16 deletions
This file was deleted.

src/assert_m.f90

Lines changed: 0 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -2,13 +2,5 @@ module assert_m
22
!! Public interface
33
use assert_subroutine_m ! DO NOT PLACE AN ONLY CLAUSE HERE!
44
! All public members of assert_subroutine_m are exported
5-
6-
! The function below is public only to support automated
7-
! invocation via `assert_macros.h`. For a more broadly useful
8-
! function to convert numeric data to string format, please
9-
! consider using the functions that can be accessed via the
10-
! `string_t` generic interface in the Julienne framework at
11-
! https://go.lbl.gov/julienne.
12-
use fortran_stringify_integer_m, only : fortran_stringify_integer
135
implicit none
146
end module

0 commit comments

Comments
 (0)