[Date Prev] [Date Next] [Thread Prev] [Thread Next] Date Index Thread Index Search archive:
Date:Mon Aug 24 11:50:48 1993 
Subject:new version of assert 
From:jonr (Jonathan Rowe) 
Volume-ID:930824.02 


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