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 $dpp .= '.com' if $^O eq 'VMS';
  17
  18 print "\nperl: $perl\n" if $opt_v;
  19 if( ! -f $perl ){ die "Where's Perl?" }
  20 if( ! -f $dpp ){ die "Where's dprofpp?" }
  21
  22 sub dprofpp {
  23         my $switches = shift;
  24
  25         open( D, "$perl \"-I../lib\" $dpp \"$switches\" 2> err |" ) || warn "$0: Can't run. $!\n";
  26         @results = <D>;
  27         close D;
  28
  29         open( D, "<err" ) || warn "$0: Can't open: $!\n";
  30         @err = <D>;
  31         close D;
  32         push( @results, @err ) if @err;
  33
  34         $results = qq{@results};
  35         # ignore Loader (Dyna/Auto etc), leave newline
  36         $results =~ s/^\w+Loader::import//;
  37         $results =~ s/\n /\n/gm;
  38         $results;
  39 }
  40
  41 sub report {
  42         $num = shift;
  43         my $sub = shift;
  44         my $x;
  45
  46         $x = &$sub;
  47         $x ? &ok : &notok;
  48 }
  49
  50 sub ok {
  51         print "ok $num\n";
  52 }
  53
  54 sub notok {
  55         print "not ok $num\n";
  56         print "\nResult\n{$results}\n";
  57         print "Expected\n{$expected}\n";
  58 }
  59
  60 1;