summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Devel/DProf/V.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Devel/DProf/V.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/Devel/DProf/V.pm63
1 files changed, 63 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/Devel/DProf/V.pm b/Master/tlpkg/tlperl/lib/Devel/DProf/V.pm
new file mode 100644
index 00000000000..e613f6f4410
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Devel/DProf/V.pm
@@ -0,0 +1,63 @@
+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';
+$dpp .= '.com' if $^O eq 'VMS';
+
+print "\nperl: $perl\n" if $opt_v;
+if( ! -f $perl ){ die "Where's Perl?" }
+if( ! -f $dpp ) {
+ ($dpp = $^X) =~ s@(^.*)[/|\\].*@$1/dprofpp@;
+ die "Where's dprofpp?" if( ! -f $dpp );
+}
+
+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 : &notok;
+}
+
+sub ok {
+ print "ok $num\n";
+}
+
+sub notok {
+ print "not ok $num\n";
+ print "\nResult\n{$results}\n";
+ print "Expected\n{$expected}\n";
+}
+
+1;