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