This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
integrate changes#6268..6282 from cfgperl branch
[perl5.git] / t / lib / dprof.t
CommitLineData
95667ae4 1#!perl
583a019e 2
95667ae4
GS
3BEGIN {
4 chdir( 't' ) if -d 't';
5 unshift @INC, '../lib';
335b95fc
GS
6 require Config; import Config;
7 if ($Config{'extensions'} !~ /\bDevel\/DProf\b/){
8 print "1..0 # Skip: Devel::DProf was not built\n";
9 exit 0;
10 }
95667ae4 11}
583a019e 12
70b836b3
JT
13END {
14 unlink 'tmon.out', 'err';
15}
16
583a019e
GS
17use Benchmark qw( timediff timestr );
18use Getopt::Std 'getopts';
583a019e
GS
19getopts('vI:p:');
20
21# -v Verbose
22# -I Add to @INC
23# -p Name of perl binary
24
95667ae4 25@tests = @ARGV ? @ARGV : sort <lib/dprof/*_t lib/dprof/*_v>; # glob-sort, for OS/2
583a019e
GS
26
27$path_sep = $Config{path_sep} || ':';
583a019e
GS
28$perl5lib = $opt_I || join( $path_sep, @INC );
29$perl = $opt_p || $^X;
30
31if( $opt_v ){
32 print "tests: @tests\n";
33 print "perl: $perl\n";
34 print "perl5lib: $perl5lib\n";
35}
36if( $perl =~ m|^\./| ){
37 # turn ./perl into ../perl, because of chdir(t) above.
38 $perl = ".$perl";
39}
40if( ! -f $perl ){ die "Where's Perl?" }
41
42sub profile {
43 my $test = shift;
44 my @results;
45 local $ENV{PERL5LIB} = $perl5lib;
46 my $opt_d = '-d:DProf';
47
48 my $t_start = new Benchmark;
49 open( R, "$perl $opt_d $test |" ) || warn "$0: Can't run. $!\n";
50 @results = <R>;
51 close R;
52 my $t_total = timediff( new Benchmark, $t_start );
53
54 if( $opt_v ){
55 print "\n";
56 print @results
57 }
58
59 print timestr( $t_total, 'nop' ), "\n";
60}
61
62
63sub verify {
64 my $test = shift;
65
95667ae4
GS
66 system $perl, '-I../lib', '-I./lib/dprof', $test,
67 $opt_v?'-v':'', '-p', $perl;
583a019e
GS
68}
69
70
71$| = 1;
95667ae4 72print "1..18\n";
583a019e
GS
73while( @tests ){
74 $test = shift @tests;
95667ae4
GS
75 if( $test =~ /_t$/i ){
76 print "# $test" . '.' x (20 - length $test);
583a019e
GS
77 profile $test;
78 }
79 else{
80 verify $test;
81 }
82}
9394203c
JH
83
84unlink("tmon.out");