| \G All assertions above this level are turned off. |
\G All assertions above this level are turned off. |
| 1 assert-level ! |
1 assert-level ! |
| |
|
| |
: (end-assert) ( flag nfile nline -- ) \ gforth-internal |
| |
rot if |
| |
2drop |
| |
else |
| |
.sourcepos ." : failed assertion" |
| |
true abort" assertion failed" \ !! or use a new throw code? |
| |
then ; |
| |
|
| |
: assert) ( -- ) |
| |
compile-sourcepos POSTPONE (end-assert) ; |
| |
|
| |
6 Constant assert-canary |
| |
|
| : assertn ( n -- ) \ gforth assert-n |
: assertn ( n -- ) \ gforth assert-n |
| \ this is internal (it is not immediate) |
\ this is internal (it is not immediate) |
| assert-level @ > |
assert-level @ > |
| if |
if |
| POSTPONE ( |
POSTPONE ( |
| |
else |
| |
['] assert) assert-canary |
| then ; |
then ; |
| |
|
| |
: ) ( -- ) \ gforth close-paren |
| |
\G End an assertion. Generic end, can be used for other similar purposes |
| |
assert-canary <> abort" unmatched assertion" |
| |
execute ; immediate |
| |
|
| : assert0( ( -- ) \ gforth assert-zero |
: assert0( ( -- ) \ gforth assert-zero |
| \G Important assertions that should always be turned on. |
\G Important assertions that should always be turned on. |
| 0 assertn ; immediate compile-only |
0 assertn ; immediate compile-only |
| \G Equivalent to @code{assert1(} |
\G Equivalent to @code{assert1(} |
| POSTPONE assert1( ; immediate compile-only |
POSTPONE assert1( ; immediate compile-only |
| |
|
| : (end-assert) ( flag nfile nline -- ) \ gforth-internal |
|
| rot if |
|
| 2drop |
|
| else |
|
| .sourcepos ." : failed assertion" |
|
| true abort" assertion failed" \ !! or use a new throw code? |
|
| then ; |
|
| |
|
| : ) ( -- ) \ gforth close-paren |
|
| \G End an assertion. |
|
| compile-sourcepos POSTPONE (end-assert) ; immediate |
|
