t/lib/dprof/V.pm

   1 package V;
   2
   3 use Getopt::Std 'getopts';
   4 getopts('vp:d:');
   5
   6 require Exporter;
   7 @ISA = 'Exporter';
   8
   9 @EXPORT = qw( dprofpp $opt_v $results $expected report @results );
  10 @EXPORT_OK = qw( notok ok $num );
  11
  12 $num = 0;
  13 $results = $expected = '';
  14 $perl = $opt_p || $^X;
  15 $dpp = $opt_d || '../utils/dprofpp';
  16
  17 print "\nperl: $perl\n" if $opt_v;
  18 if( ! -f $perl ){ die "Where's Perl?" }
  19 if( ! -f $dpp ){ die "Where's dprofpp?" }
  20
  21 sub dprofpp {
  22         my $switches = shift;
  23
  24         open( D, "$perl -I../lib $dpp $switches 2> err |" ) || warn "$0: Can't run. $!\n";
  25         @results = <D>;
  26         close D;
  27
  28         open( D, "<err" ) || warn "$0: Can't open: $!\n";
  29         @err = <D>;
  30         close D;
  31         push( @results, @err ) if @err;
  32
  33         $results = qq{@results};
  34         # ignore Loader (Dyna/Auto etc), leave newline
  35         $results =~ s/^\w+Loader::import//;
  36         $results =~ s/\n /\n/gm;
  37         $results;
  38 }
  39
  40 sub report {
  41         $num = shift;
  42         my $sub = shift;
  43         my $x;
  44
  45         $x = &$sub;
  46         $x ? &ok : &notok;
  47 }
  48
  49 sub ok {
  50         print "ok $num\n";
  51 }
  52
  53 sub notok {
  54         print "not ok $num\n";
  55         print "\nResult\n{$results}\n";
  56         print "Expected\n{$expected}\n";
  57 }
  58
  59 1;