version 1.17, 2010/12/31 18:09:02
|
version 1.18, 2012/02/13 22:26:50
|
Line 23 variable assert-level ( -- a-addr ) \ gf
|
Line 23 variable assert-level ( -- a-addr ) \ gf
|
\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 |
Line 47 variable assert-level ( -- a-addr ) \ gf
|
Line 67 variable assert-level ( -- a-addr ) \ gf
|
\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 |
|