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