File:  [gforth] / gforth / assert.fs
Revision 1.1: download - view: text, annotated - select for diffs
Fri Jul 8 15:00:28 1994 UTC (25 years, 2 months ago) by anton
Branches: MAIN
CVS tags: HEAD
signals are now translated into THROWs
A number of bug fixes (make a diff of BUGS for details)
added assert.fs and debugging.fs
made .s nicer
keep names of included files (in loadfilename) and print them upon error

\ assertions

\ !! factor out line number printing, share with debugging.fs

variable assert-level \ all assertions above this level are turned off
1 assert-level !

: assertn ( n -- )
    assert-level @ >
    if
	POSTPONE (
    then ;

: assert0( ( -- )
    0 assertn ; immediate
: assert1( ( -- )
    1 assertn ; immediate
: assert2( ( -- )
    2 assertn ; immediate
: assert3( ( -- )
    3 assertn ; immediate
: assert( ( -- )
    POSTPONE assert1( ; immediate

: (endassert) ( flag -- )
    \ three inline arguments
    if
	r> 3 cells + >r EXIT
    else
	r>
	dup 2@ type ." :" cell+ cell+
	@ 0 .r ." : failed assertion"
	true abort" assertion failed" \ !! or use a new throw code?
    then ;

: ) ( -- )
    POSTPONE (endassert) loadfilename 2@ 2, loadline @ , ; immediate

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>