We've modifed the original "assert" mechanism to allow the optional
defining of an exception handling procedure. If this is not provided
the default handler, assert_proc, is called, which by default
generates the mishap as in the original. assert_proc is user
assignable.
Jon Rowe
-----------------------CUT HERE-----------------------------------------
;;; 10th Aug 1993
;;; JL Cunningham
;;; revised 24 Aug 93
;;; J Rowe
/* Provides some 'assert' syntax:
assert <expr> [else <stmt-seq>] [with_handler <expr>] endassert
If <expr> evaluates to false, the procedure assert_proc is run. By
default, this generates a mishap. assert_proc is user assignable.
The optional <stmt-seq> is evaluated to provide the list of culprits
(the 'INVOLVING' line). This list is passed as the single argument of
assert_proc. If there is no else clause, the empty list is passed.
The optional with_handler <expr> should evaluate to a procedure
which is run instead of assert_proc.
No code will be planted (and therefore no assertion checking done,
and the handler can't be called) if the variable -asserting- is
false when an assertion is compiled.
Examples:
assert true endassert; ;;; nothing happens
assert false endassert; ;;; assertion fails, generating a mishap
assert x < 3 else 'Bad News' endassert;
assert x < 3 else 'x out of bounds', [x = ^x] endassert;
Try this example:
;;; prints all the decimal digits
vars i;
for i from 0 to 10 do
assert i < 10 else 'i too large', [i = ^i] endassert;
i =>
endfor;
Try it after doing
false -> asserting;
Assertions are used during development as a sanity check, and
are particularly useful if Bad Things don't happen immediately
a calculation gets the wrong result. A final example, in which
a special handler is used that prints a warning message and
keeps the program running. (Whether or not this is strictly an
assertion is an exercise for the reader).
define risky_procedure(i, j);
lvars i, j;
assert i.isinteger and j.isinteger
else i, j
with_handler
procedure(x); lvars x;
warning( 'risky_procedure has bad args', x );
exitfrom(undef, risky_procedure)
endprocedure
endassert;
(i fi_+ j) fi_* (i fi_- j)
enddefine;
risky_procedure(5, 3)=>
risky_procedure(7, '')=> ;;;generates rubbish if -asserting- was false
See also lib slowprocs
*/
global vars asserting = true;
global vars assert_proc =
procedure culprits;
lvars culprits;
mishap('Assertion failed', culprits);
endprocedure;
global vars syntax (endassert with_handler);
define global syntax assert;
lvars lab = sysNEW_LABEL(), word;
dlocal pop_syntax_only = pop_syntax_only or not(asserting);
pop11_comp_expr_to([endassert else with_handler])->word;
sysIFSO(lab);
if word == "else" then
sysPUSHQ(popstackmark);
pop11_comp_stmnt_seq_to([endassert with_handler])->word;
sysCALLQ(sysconslist);
else
sysPUSHQ([]);
endif;
if word == "with_handler" then
pop11_comp_expr_to("endassert")->;
sysCALLS(undef);
else
sysCALLQ( assert_proc );
endif;
sysLABEL(lab);
enddefine;
;;;eof
|