1# assert.pl
2# tchrist@convex.com (Tom Christiansen)
3#
4# Usage:
5#
6#     &assert('@x > @y');
7#     &assert('$var > 10', $var, $othervar, @various_info);
8#
9# That is, if the first expression evals false, we blow up.  The
10# rest of the args, if any, are nice to know because they will
11# be printed out by &panic, which is just the stack-backtrace
12# routine shamelessly borrowed from the perl debugger.
13
14sub assert {
15    &panic("ASSERTION BOTCHED: $_[0]",$@) unless eval $_[0];
16}
17
18sub panic {
19    package DB;
20
21    select(STDERR);
22
23    print "\npanic: @_\n";
24
25    exit 1 if $] <= 4.003;  # caller broken
26
27    # stack traceback gratefully borrowed from perl debugger
28
29    local $_;
30    my $i;
31    my ($p,$f,$l,$s,$h,$a,@a,@frames);
32    for ($i = 0; ($p,$f,$l,$s,$h,$w) = caller($i); $i++) {
33	@a = @args;
34	for (@a) {
35	    if (/^StB\000/ && length($_) == length($_main{'_main'})) {
36		$_ = sprintf("%s",$_);
37	    }
38	    else {
39		s/'/\\'/g;
40		s/([^\0]*)/'$1'/ unless /^-?[\d.]+$/;
41		s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg;
42		s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg;
43	    }
44	}
45	$w = $w ? '@ = ' : '$ = ';
46	$a = $h ? '(' . join(', ', @a) . ')' : '';
47	push(@frames, "$w&$s$a from file $f line $l\n");
48    }
49    for ($i=0; $i <= $#frames; $i++) {
50	print $frames[$i];
51    }
52    exit 1;
53}
54
551;
56