summaryrefslogtreecommitdiff
path: root/gnu/usr.bin/perl/t/lib/dprof.t
diff options
context:
space:
mode:
authorTodd C. Miller <millert@cvs.openbsd.org>2000-04-06 16:11:09 +0000
committerTodd C. Miller <millert@cvs.openbsd.org>2000-04-06 16:11:09 +0000
commite852ed17d905386f3bbad057fda2f07926227f89 (patch)
tree9c602984a369e27373c3cd3b71bd8c8e791393f2 /gnu/usr.bin/perl/t/lib/dprof.t
parent9cfdf10e50d1f9e72606c75c7b7a0e18940c80aa (diff)
virgin perl 5.6.0
Diffstat (limited to 'gnu/usr.bin/perl/t/lib/dprof.t')
-rw-r--r--gnu/usr.bin/perl/t/lib/dprof.t80
1 files changed, 80 insertions, 0 deletions
diff --git a/gnu/usr.bin/perl/t/lib/dprof.t b/gnu/usr.bin/perl/t/lib/dprof.t
new file mode 100644
index 00000000000..4d6f7823c3c
--- /dev/null
+++ b/gnu/usr.bin/perl/t/lib/dprof.t
@@ -0,0 +1,80 @@
+#!perl
+
+BEGIN {
+ chdir( 't' ) if -d 't';
+ unshift @INC, '../lib';
+}
+
+END {
+ unlink 'tmon.out', 'err';
+}
+
+use Benchmark qw( timediff timestr );
+use Getopt::Std 'getopts';
+use Config '%Config';
+getopts('vI:p:');
+
+# -v Verbose
+# -I Add to @INC
+# -p Name of perl binary
+
+@tests = @ARGV ? @ARGV : sort <lib/dprof/*_t lib/dprof/*_v>; # glob-sort, for OS/2
+
+$path_sep = $Config{path_sep} || ':';
+$perl5lib = $opt_I || join( $path_sep, @INC );
+$perl = $opt_p || $^X;
+
+if( $opt_v ){
+ print "tests: @tests\n";
+ print "perl: $perl\n";
+ print "perl5lib: $perl5lib\n";
+}
+if( $perl =~ m|^\./| ){
+ # turn ./perl into ../perl, because of chdir(t) above.
+ $perl = ".$perl";
+}
+if( ! -f $perl ){ die "Where's Perl?" }
+
+sub profile {
+ my $test = shift;
+ my @results;
+ local $ENV{PERL5LIB} = $perl5lib;
+ my $opt_d = '-d:DProf';
+
+ my $t_start = new Benchmark;
+ open( R, "$perl $opt_d $test |" ) || warn "$0: Can't run. $!\n";
+ @results = <R>;
+ close R;
+ my $t_total = timediff( new Benchmark, $t_start );
+
+ if( $opt_v ){
+ print "\n";
+ print @results
+ }
+
+ print timestr( $t_total, 'nop' ), "\n";
+}
+
+
+sub verify {
+ my $test = shift;
+
+ system $perl, '-I../lib', '-I./lib/dprof', $test,
+ $opt_v?'-v':'', '-p', $perl;
+}
+
+
+$| = 1;
+print "1..18\n";
+while( @tests ){
+ $test = shift @tests;
+ if( $test =~ /_t$/i ){
+ print "# $test" . '.' x (20 - length $test);
+ profile $test;
+ }
+ else{
+ verify $test;
+ }
+}
+
+unlink("tmon.out");