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