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