[gforth] / gforth / assert.fs  

gforth: gforth/assert.fs


1 : anton 1.1 \ assertions
2 :    
3 : anton 1.17 \ Copyright (C) 1995,1996,1997,1999,2002,2003,2007,2010 Free Software Foundation, Inc.
4 : anton 1.5
5 :     \ This file is part of Gforth.
6 :    
7 :     \ Gforth is free software; you can redistribute it and/or
8 :     \ modify it under the terms of the GNU General Public License
9 : anton 1.14 \ as published by the Free Software Foundation, either version 3
10 : anton 1.5 \ of the License, or (at your option) any later version.
11 :    
12 :     \ This program is distributed in the hope that it will be useful,
13 :     \ but WITHOUT ANY WARRANTY; without even the implied warranty of
14 :     \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 :     \ GNU General Public License for more details.
16 :    
17 :     \ You should have received a copy of the GNU General Public License
18 : anton 1.14 \ along with this program. If not, see http://www.gnu.org/licenses/.
19 : anton 1.5
20 :     require source.fs
21 : anton 1.1
22 : anton 1.4 variable assert-level ( -- a-addr ) \ gforth
23 : crook 1.8 \G All assertions above this level are turned off.
24 : anton 1.1 1 assert-level !
25 :    
26 : anton 1.4 : assertn ( n -- ) \ gforth assert-n
27 : anton 1.2 \ this is internal (it is not immediate)
28 : anton 1.1 assert-level @ >
29 :     if
30 :     POSTPONE (
31 :     then ;
32 :    
33 : anton 1.4 : assert0( ( -- ) \ gforth assert-zero
34 : crook 1.8 \G Important assertions that should always be turned on.
35 : anton 1.16 0 assertn ; immediate compile-only
36 : anton 1.4 : assert1( ( -- ) \ gforth assert-one
37 : crook 1.8 \G Normal assertions; turned on by default.
38 : anton 1.16 1 assertn ; immediate compile-only
39 : anton 1.4 : assert2( ( -- ) \ gforth assert-two
40 : crook 1.8 \G Debugging assertions.
41 : anton 1.16 2 assertn ; immediate compile-only
42 : anton 1.4 : assert3( ( -- ) \ gforth assert-three
43 : crook 1.8 \G Slow assertions that you may not want to turn on in normal debugging;
44 :     \G you would turn them on mainly for thorough checking.
45 : anton 1.16 3 assertn ; immediate compile-only
46 : anton 1.4 : assert( ( -- ) \ gforth
47 : crook 1.8 \G Equivalent to @code{assert1(}
48 : anton 1.16 POSTPONE assert1( ; immediate compile-only
49 : anton 1.1
50 : anton 1.11 : (end-assert) ( flag nfile nline -- ) \ gforth-internal
51 :     rot if
52 :     2drop
53 : anton 1.1 else
54 : anton 1.11 .sourcepos ." : failed assertion"
55 : anton 1.1 true abort" assertion failed" \ !! or use a new throw code?
56 :     then ;
57 :    
58 : anton 1.4 : ) ( -- ) \ gforth close-paren
59 : anton 1.11 \G End an assertion.
60 :     compile-sourcepos POSTPONE (end-assert) ; immediate

CVS Admin

Powered by ViewCVS 1.0-dev
(Powered by ViewCVS)

ViewCVS and CVS Help