[Summary view] [Print] [Text view]

   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  
  14  sub assert {
  15      &panic("ASSERTION BOTCHED: $_[$[]",$@) unless eval $_[$[];
  16  } 
  17  
  18  sub 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  
  55  1;