[gforth] / gforth / assert.fs

gforth: gforth/assert.fs

1 :	anton	1.1	\ assertions
2 :
3 :			\ !! factor out line number printing, share with debugging.fs
4 :
5 :	anton	1.3	variable assert-level ( -- a-addr ) \ new
6 :			\G all assertions above this level are turned off
7 :	anton	1.1	1 assert-level !
8 :
9 :	anton	1.3	: assertn ( n -- ) \ new
10 :	anton	1.2	\ this is internal (it is not immediate)
11 :	anton	1.1	assert-level @ >
12 :			if
13 :			POSTPONE (
14 :			then ;
15 :
16 :	anton	1.3	: assert0( ( -- ) \ new
17 :			\G important assertions that should always be turned on
18 :	anton	1.1	0 assertn ; immediate
19 :	anton	1.3	: assert1( ( -- ) \ new
20 :			\G normal assertions; turned on by default
21 :	anton	1.1	1 assertn ; immediate
22 :	anton	1.3	: assert2( ( -- ) \ new
23 :			\G debugging assertions
24 :	anton	1.1	2 assertn ; immediate
25 :	anton	1.3	: assert3( ( -- ) \ new
26 :			\G slow assertions that you may not want to turn on in normal debugging;
27 :			\G you would turn them on mainly for thorough checking
28 :	anton	1.1	3 assertn ; immediate
29 :	anton	1.3	: assert( ( -- ) \ new
30 :			\G equivalent to assert1(
31 :	anton	1.1	POSTPONE assert1( ; immediate
32 :
33 :	anton	1.3	: (endassert) ( flag -- ) \ new
34 :	anton	1.1	\ three inline arguments
35 :			if
36 :			r> 3 cells + >r EXIT
37 :			else
38 :			r>
39 :			dup 2@ type ." :" cell+ cell+
40 :			@ 0 .r ." : failed assertion"
41 :			true abort" assertion failed" \ !! or use a new throw code?
42 :			then ;
43 :
44 :	anton	1.3	: ) ( -- ) \ new
45 :	anton	1.1	POSTPONE (endassert) loadfilename 2@ 2, loadline @ , ; immediate