home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl560.zip / t / lib / dprof / V.pm
Text File  |  1999-07-20  |  1KB  |  60 lines
  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 : ¬ok;
  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;
  60.