Revision: 879 Author: tim.bunce Date: Sat Oct 24 08:56:24 2009 Log: Added forkdepth option, plus tests and docs.
http://code.google.com/p/perl-devel-nytprof/source/detail?r=879 Added: /trunk/t/60-forkdepth.t Modified: /trunk/Changes /trunk/MANIFEST /trunk/NYTProf.xs /trunk/lib/Devel/NYTProf.pm /trunk/t/22-readstream.t /trunk/t/lib/NYTProfTest.pm ======================================= --- /dev/null +++ /trunk/t/60-forkdepth.t Sat Oct 24 08:56:24 2009 @@ -0,0 +1,38 @@ +use Test::More; + +use strict; + +use lib qw(t/lib); +use NYTProfTest; + +plan skip_all => "doesn't work with fork() emulation" if (($^O eq "MSWin32") || ($^O eq 'VMS')); + +plan tests => 5; + +my $out = 'nytprof-forkdepth.out'; + +is run_forkdepth( 0 ), 1; +is run_forkdepth( 1 ), 2; +is run_forkdepth( 2 ), 3; +is run_forkdepth( -1 ), 3; +is run_forkdepth( undef), 3; + +exit 0; + +sub run_forkdepth { + my ($forkdepth) = @_; + + unlink $_ for glob("$out.*"); + + $ENV{NYTPROF} = "file=$out:addpid=1"; + $ENV{NYTPROF} .= ":forkdepth=$forkdepth" if defined $forkdepth; + + my $forkdepth_cmd = q{-d:NYTProf -e "fork and wait,exit 0; fork and wait"}; + run_perl_command($forkdepth_cmd); + + my @files = glob("$out.*"); + unlink $_ for @files; + + return scalar @files; +} + ======================================= --- /trunk/Changes Sat Oct 24 07:34:41 2009 +++ /trunk/Changes Sat Oct 24 08:56:24 2009 @@ -33,6 +33,9 @@ Can also do sigexit=TRAP,ABRT,SYS,... to hook specific signals. Thanks to Andrew Sterling Hanenkamp for the seed of this idea. + Added forkdepth=N option to enable profiling to be turned off after N + generations of fork(). + Added initial support for profiling PostgreSQL PL/Perl code via Devel::NYTProf::PgPLPerl module. ======================================= --- /trunk/MANIFEST Fri Oct 23 05:24:06 2009 +++ /trunk/MANIFEST Sat Oct 24 08:56:24 2009 @@ -51,6 +51,7 @@ t/30-util.t t/31-env.t t/50-errno.t +t/60-forkdepth.t t/80-version.t t/90-pod.t t/91-pod_coverage.t ======================================= --- /trunk/NYTProf.xs Fri Oct 23 09:17:34 2009 +++ /trunk/NYTProf.xs Sat Oct 24 08:56:24 2009 @@ -249,7 +249,9 @@ #define profile_slowops options[10].option_value { "slowops", 2 }, /* slow opcodes, typically system calls */ #define profile_findcaller options[11].option_value - { "findcaller", 0 } /* find sub caller instead of trusting outer */ + { "findcaller", 0 }, /* find sub caller instead of trusting outer */ +#define profile_forkdepth options[12].option_value + { "forkdepth", -1 } /* how many generations of kids to profile */ }; /* time tracking */ @@ -2015,7 +2017,7 @@ disable_profile(aTHX); croak("Failed to open output '%s': %s%s", filename, strerror(fopen_errno), hint); } - if (trace_level) + if (trace_level >= 1) logwarn("Opened %s\n", filename); output_header(aTHX); @@ -2050,7 +2052,7 @@ /* we're now the child process */ if (trace_level >= 1) - logwarn("New pid %d (was %d)\n", getpid(), last_pid); + logwarn("New pid %d (was %d) forkdepth %d\n", getpid(), last_pid, profile_forkdepth); /* reset state */ last_pid = getpid(); @@ -2060,14 +2062,23 @@ hv_clear(sub_callers_hv); if (out) { - /* any data that was unflushed in the parent when it forked - * is now duplicated unflushed in this child process. - * We need to be a little devious to prevent it getting flushed. + /* data that was unflushed in the parent when it forked + * is now duplicated unflushed in this child, + * so discard it when we close the inherited filehandle. */ - NYTP_close(out, 1); /* 1: discard output, to stop it being flushed to disk */ - - open_output_file(aTHX_ PROF_output_file); - } + NYTP_close(out, 1); + + if (profile_forkdepth == 0) { + /* user doesn't want this child profiled */ + disable_profile(aTHX); + } + else { + open_output_file(aTHX_ PROF_output_file); + } + } + + if (profile_forkdepth > 0) + --profile_forkdepth; return 1; /* have forked */ } ======================================= --- /trunk/lib/Devel/NYTProf.pm Fri Oct 23 05:24:06 2009 +++ /trunk/lib/Devel/NYTProf.pm Sat Oct 24 08:56:24 2009 @@ -468,6 +468,18 @@ sigexit=int,hup +=head2 forkdepth=N + +When a perl process that is being profiled executes a fork() the child process +is also profiled. The forkdepth option can be used to control this. If +forkdepth is zero then profiling will be disabled in the child process. + +If forkdepth is greater than zero then profiling will be enabled in the child +process and the forkdepth value in that process is decremented by one. + +If forkdepth is -1 (the default) then there's no limit on the number of +generations of children that are profiled. + =head1 RUN-TIME CONTROL OF PROFILING You can profile only parts of an application by calling DB::disable_profile() ======================================= --- /trunk/t/22-readstream.t Fri Oct 23 05:56:12 2009 +++ /trunk/t/22-readstream.t Sat Oct 24 08:56:24 2009 @@ -16,11 +16,7 @@ $ENV{NYTPROF} = "file=$out"; unlink $out; -use Config; -my $this_perl = $^X; -$this_perl .= $Config{_exe} if $^O ne 'VMS' and $this_perl !~ m/$Config{_exe}$/i; - -run_command($this_perl . q{ -d:NYTProf -e "sub A { };" -e "1;" -e "A()"}); +run_perl_command(q{-d:NYTProf -e "sub A { };" -e "1;" -e "A()"}); my %prof; my @seqn; ======================================= --- /trunk/t/lib/NYTProfTest.pm Thu Oct 22 09:05:10 2009 +++ /trunk/t/lib/NYTProfTest.pm Sat Oct 24 08:56:24 2009 @@ -15,6 +15,7 @@ our @EXPORT = qw( run_test_group run_command + run_perl_command do_foreach_env_combination profile_this_code ); @@ -26,6 +27,8 @@ my $tests_per_extn = {p => 1, rdt => 1, x => 3}; +my $this_perl = $^X; +$this_perl .= $Config{_exe} if $^O ne 'VMS' and $this_perl !~ m/$Config{_exe}$/i; my %opts = ( one => $ENV{NYTPROF_TEST_ONE}, @@ -292,6 +295,12 @@ if ($show_stdout) { warn $_ for @results } return $ok; } + + +sub run_perl_command { + my ($cmd, $show_stdout) = @_; + run_command("$this_perl $cmd", $show_stdout); +} sub profile { --~--~---------~--~----~------------~-------~--~----~ You've received this message because you are subscribed to the Devel::NYTProf Development User group. Group hosted at: http://groups.google.com/group/develnytprof-dev Project hosted at: http://perl-devel-nytprof.googlecode.com CPAN distribution: http://search.cpan.org/dist/Devel-NYTProf To post, email: [email protected] To unsubscribe, email: [email protected] -~----------~----~----~----~------~----~------~--~---
