home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 10 Tools
/
10-Tools.zip
/
perl560.zip
/
t
/
lib
/
dprof
/
V.pm
Wrap
Text File
|
1999-07-20
|
1KB
|
60 lines
package V;
use Getopt::Std 'getopts';
getopts('vp:d:');
require Exporter;
@ISA = 'Exporter';
@EXPORT = qw( dprofpp $opt_v $results $expected report @results );
@EXPORT_OK = qw( notok ok $num );
$num = 0;
$results = $expected = '';
$perl = $opt_p || $^X;
$dpp = $opt_d || '../utils/dprofpp';
print "\nperl: $perl\n" if $opt_v;
if( ! -f $perl ){ die "Where's Perl?" }
if( ! -f $dpp ){ die "Where's dprofpp?" }
sub dprofpp {
my $switches = shift;
open( D, "$perl -I../lib $dpp $switches 2> err |" ) || warn "$0: Can't run. $!\n";
@results = <D>;
close D;
open( D, "<err" ) || warn "$0: Can't open: $!\n";
@err = <D>;
close D;
push( @results, @err ) if @err;
$results = qq{@results};
# ignore Loader (Dyna/Auto etc), leave newline
$results =~ s/^\w+Loader::import//;
$results =~ s/\n /\n/gm;
$results;
}
sub report {
$num = shift;
my $sub = shift;
my $x;
$x = &$sub;
$x ? &ok : ¬ok;
}
sub ok {
print "ok $num\n";
}
sub notok {
print "not ok $num\n";
print "\nResult\n{$results}\n";
print "Expected\n{$expected}\n";
}
1;