1#!perl 2 3BEGIN { 4 chdir( 't' ) if -d 't'; 5 @INC = '../lib'; 6 require './test.pl'; # for which_perl() etc 7 require Config; import Config; 8 if ($Config{'extensions'} !~ /\bDevel\/DProf\b/){ 9 print "1..0 # Skip: Devel::DProf was not built\n"; 10 exit 0; 11 } 12} 13 14END { 15 while(-e 'tmon.out' && unlink 'tmon.out') {} 16 while(-e 'err' && unlink 'err') {} 17} 18 19use Benchmark qw( timediff timestr ); 20use Getopt::Std 'getopts'; 21getopts('vI:p:'); 22 23# -v Verbose 24# -I Add to @INC 25# -p Name of perl binary 26 27@tests = @ARGV ? @ARGV : sort (<lib/dprof/*_t>, <lib/dprof/*_v>); # glob-sort, for OS/2 28 29$path_sep = $Config{path_sep} || ':'; 30$perl5lib = $opt_I || join( $path_sep, @INC ); 31$perl = $opt_p || which_perl(); 32 33if( $opt_v ){ 34 print "tests: @tests\n"; 35 print "perl: $perl\n"; 36 print "perl5lib: $perl5lib\n"; 37} 38if( $perl =~ m|^\./| ){ 39 # turn ./perl into ../perl, because of chdir(t) above. 40 $perl = ".$perl"; 41} 42if( ! -f $perl ){ die "Where's Perl?" } 43 44sub profile { 45 my $test = shift; 46 my @results; 47 local $ENV{PERL5LIB} = $perl5lib; 48 my $opt_d = '-d:DProf'; 49 50 my $t_start = new Benchmark; 51 open( R, "$perl \"$opt_d\" $test |" ) || warn "$0: Can't run. $!\n"; 52 @results = <R>; 53 close R or warn "Could not close: $!"; 54 my $t_total = timediff( new Benchmark, $t_start ); 55 56 if( $opt_v ){ 57 print "\n"; 58 print @results 59 } 60 61 print '# ' . timestr( $t_total, 'nop' ), "\n"; 62} 63 64 65sub verify { 66 my $test = shift; 67 68 my $command = $perl.' "-I../lib" "-I./lib/dprof" '.$test; 69 $command .= ' -v' if $opt_v; 70 $command .= ' -p '. $perl; 71 system $command; 72} 73 74 75$| = 1; 76print "1..20\n"; 77while( @tests ){ 78 $test = shift @tests; 79 $test =~ s/\.$// if $^O eq 'VMS'; 80 if( $test =~ /_t$/i ){ 81 print "# $test" . '.' x (20 - length $test); 82 profile $test; 83 } 84 else{ 85 verify $test; 86 } 87} 88 89unlink("tmon.out"); 90