Move the libgcc.a hack into a section for pre-1.6 NetBSD releases.
[p5sagit/p5-mst-13.2.git] / ext / Devel / DProf / DProf.t
CommitLineData
95667ae4 1#!perl
583a019e 2
95667ae4 3BEGIN {
4 chdir( 't' ) if -d 't';
20822f61 5 @INC = '../lib';
38080423 6 require './test.pl'; # for which_perl() etc
be3174d2 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 }
95667ae4 12}
583a019e 13
70b836b3 14END {
ef060a86 15 while(-e 'tmon.out' && unlink 'tmon.out') {}
16 while(-e 'err' && unlink 'err') {}
70b836b3 17}
18
583a019e 19use Benchmark qw( timediff timestr );
20use Getopt::Std 'getopts';
583a019e 21getopts('vI:p:');
22
23# -v Verbose
24# -I Add to @INC
25# -p Name of perl binary
26
ef060a86 27@tests = @ARGV ? @ARGV : sort (<lib/dprof/*_t>, <lib/dprof/*_v>); # glob-sort, for OS/2
583a019e 28
29$path_sep = $Config{path_sep} || ':';
583a019e 30$perl5lib = $opt_I || join( $path_sep, @INC );
38080423 31$perl = $opt_p || which_perl();
583a019e 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;
ef060a86 51 open( R, "$perl \"$opt_d\" $test |" ) || warn "$0: Can't run. $!\n";
583a019e 52 @results = <R>;
d1e4d418 53 close R or warn "Could not close: $!";
583a019e 54 my $t_total = timediff( new Benchmark, $t_start );
55
56 if( $opt_v ){
57 print "\n";
58 print @results
59 }
60
ef060a86 61 print '# ',timestr( $t_total, 'nop' ), "\n";
583a019e 62}
63
64
65sub verify {
66 my $test = shift;
67
d1ee8ea9 68 my $command = $perl.' "-I../lib" "-I./lib/dprof" '.$test;
69 $command .= ' -v' if $opt_v;
70 $command .= ' -p '. $perl;
71 system $command;
583a019e 72}
73
74
75$| = 1;
95667ae4 76print "1..18\n";
583a019e 77while( @tests ){
78 $test = shift @tests;
ef060a86 79 $test =~ s/\.$// if $^O eq 'VMS';
95667ae4 80 if( $test =~ /_t$/i ){
81 print "# $test" . '.' x (20 - length $test);
583a019e 82 profile $test;
83 }
84 else{
85 verify $test;
86 }
87}
9394203c 88
89unlink("tmon.out");