Return to assert.fs CVS log

Up to [gforth] / gforth

Annotation of gforth/assert.fs, revision 1.3

1.1       anton       1: \ assertions
                      2: 
                      3: \ !! factor out line number printing, share with debugging.fs
                      4: 
1.3     ! anton       5: variable assert-level ( -- a-addr ) \ new
        !             6: \G all assertions above this level are turned off
1.1       anton       7: 1 assert-level !
                      8: 
1.3     ! anton       9: : assertn ( n -- ) \ new
1.2       anton      10:     \ this is internal (it is not immediate)
1.1       anton      11:     assert-level @ >
                     12:     if
                     13:        POSTPONE (
                     14:     then ;
                     15: 
1.3     ! anton      16: : assert0( ( -- ) \ new
        !            17:     \G important assertions that should always be turned on
1.1       anton      18:     0 assertn ; immediate
1.3     ! anton      19: : assert1( ( -- ) \ new
        !            20:     \G normal assertions; turned on by default
1.1       anton      21:     1 assertn ; immediate
1.3     ! anton      22: : assert2( ( -- ) \ new
        !            23:     \G debugging assertions
1.1       anton      24:     2 assertn ; immediate
1.3     ! anton      25: : 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
1.1       anton      28:     3 assertn ; immediate
1.3     ! anton      29: : assert( ( -- ) \ new
        !            30:     \G equivalent to assert1(
1.1       anton      31:     POSTPONE assert1( ; immediate
                     32: 
1.3     ! anton      33: : (endassert) ( flag -- ) \ new
1.1       anton      34:     \ 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: 
1.3     ! anton      44: : ) ( -- ) \ new
1.1       anton      45:     POSTPONE (endassert) loadfilename 2@ 2, loadline @ , ; immediate