I don't think trying to bracket the hires time with lores
[p5sagit/p5-mst-13.2.git] / lib / assert.pl
CommitLineData
f1ca563b 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 {
79072805 15 &panic("ASSERTION BOTCHED: $_[$[]",$@) unless eval $_[$[];
f1ca563b 16}
17
18sub panic {
748a9306 19 package DB;
20
f1ca563b 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
748a9306 29 local $_;
30 my $i;
31 my ($p,$f,$l,$s,$h,$a,@a,@frames);
f1ca563b 32 for ($i = 0; ($p,$f,$l,$s,$h,$w) = caller($i); $i++) {
748a9306 33 @a = @args;
f1ca563b 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) . ')' : '';
748a9306 47 push(@frames, "$w&$s$a from file $f line $l\n");
f1ca563b 48 }
748a9306 49 for ($i=0; $i <= $#frames; $i++) {
50 print $frames[$i];
f1ca563b 51 }
52 exit 1;
53}
54
551;