Author: tim.bunce
Date: Wed Apr 22 06:50:48 2009
New Revision: 741
Modified:
trunk/Changes
trunk/NYTProf.xs
trunk/bin/nytprofcg
trunk/lib/Devel/NYTProf.pm
trunk/t/test50-disable.rdt
trunk/t/test51-enable.p
trunk/t/test51-enable.rdt
trunk/t/test51-enable.t
trunk/t/test51-enable.x
trunk/t/test60-subname.rdt
Log:
Fixed call count for XSubs that was one too high.
Minor tweaks to bin/nytprofcg
Added more docs for disable_profile/enable_profile/finish_profile.
Extended tests for disable_profile/enable_profile/finish_profile.
Removed unused sub_xsubs_hv variable.
Avoid infinite loop in eval_outer_fid() when data is corrupt.
Modified: trunk/Changes
==============================================================================
--- trunk/Changes (original)
+++ trunk/Changes Wed Apr 22 06:50:48 2009
@@ -4,6 +4,13 @@
(As of $Date$ $Revision$)
+=head2 Changes in Devel::NYTProf 2.10 (svn rXXX) XXX
+
+ Fixed call count for XSubs that was one too high.
+
+ Added nytprofcg utility to generate callgrind data for
+ viewing via Kcachegrind, thanks to Chia-liang Kao.
+
=head2 Changes in Devel::NYTProf 2.09 (svn r733) 29th March 2009
Added support for modules using AutoLoader, e.g., POSIX & Storable,
Modified: trunk/NYTProf.xs
==============================================================================
--- trunk/NYTProf.xs (original)
+++ trunk/NYTProf.xs Wed Apr 22 06:50:48 2009
@@ -329,7 +329,6 @@
static OP *pp_entersub_profiler(pTHX);
static OP *pp_leaving_profiler(pTHX);
static HV *sub_callers_hv;
-static HV *sub_xsubs_hv; /* like PL_DBsub but for xsubs only */
static HV *pkg_fids_hv; /* currently just package names */
/* macros for outputing profile data */
@@ -1742,7 +1741,8 @@
cop = PL_curcop_nytprof;
last_executed_line = CopLINE(cop);
if (!last_executed_line) { /* i.e. finish_profile
called by END */
- if (op) /* should never happen */
+ /* XXX maybe code due to command line options, like -Mblib */
+ if (op)
warn("Unable to determine line number in %s",
OutCopFILE(cop));
last_executed_line = 1; /* don't want zero line
numbers in data */
}
@@ -2284,9 +2284,10 @@
HV *hv = newHV();
sv_setsv(sv_tmp, newRV_noinc((SV *)hv));
- if (is_xs) { /* create dummy item to hold flag to indicate xs
*/
+ if (is_xs) {
+ /* create dummy item with fid=0 & line=0 to act as flag to
indicate xs */
AV *av = new_sub_call_info_av(aTHX);
- /* flag to indicate xs */
+ av_store(av, NYTP_SCi_CALL_COUNT, newSVuv(0));
sv_setsv(*hv_fetch(hv, "0:0", 3, 1), newRV_noinc((SV
*)av));
if (cv && SvTYPE(cv) == SVt_PVCV) {
@@ -2452,6 +2453,12 @@
close_output_file(aTHX);
+ /* reset sub profiler data */
+ hv_clear(sub_callers_hv);
+ /* reset other state */
+ cumulative_overhead_ticks = 0;
+ cumulative_subr_secs = 0;
+
SETERRNO(saved_errno, 0);
}
@@ -2523,9 +2530,8 @@
#endif
/* create file id mapping hash */
- hashtable_memwidth = sizeof(Hash_entry*) * hashtable.size;
- hashtable.table = (Hash_entry**)safemalloc(hashtable_memwidth);
- memset(hashtable.table, 0, hashtable_memwidth);
+ hashtable.table = (Hash_entry**)safemalloc(sizeof(Hash_entry*) *
hashtable.size);
+ memset(hashtable.table, 0, sizeof(Hash_entry*) * hashtable.size);
open_output_file(aTHX_ PROF_output_file);
@@ -2562,8 +2568,6 @@
sub_callers_hv = newHV();
if (!pkg_fids_hv)
pkg_fids_hv = newHV();
- if (!sub_xsubs_hv)
- sub_xsubs_hv = newHV();
PL_ppaddr[OP_ENTERSUB] = pp_entersub_profiler;
if (!PL_checkav) PL_checkav = newAV();
@@ -3025,20 +3029,25 @@
unsigned int *eval_file_num_ptr,
unsigned int *eval_line_num_ptr
) {
+ unsigned int outer_fid;
AV *av;
SV *fid_info_rvav = *av_fetch(fid_fileinfo_av, fid, 1);
if (!SvROK(fid_info_rvav)) /* should never happen */
return 0;
av = (AV *)SvRV(fid_info_rvav);
- fid = (unsigned int)SvUV(*av_fetch(av,NYTP_FIDi_EVAL_FID,1));
- if (!fid)
+ outer_fid = (unsigned int)SvUV(*av_fetch(av,NYTP_FIDi_EVAL_FID,1));
+ if (!outer_fid)
return 0;
+ if (outer_fid == fid) {
+ warn("Possible corruption: eval_outer_fid of %d is %d!\n", fid,
outer_fid);
+ return 0;
+ }
if (eval_file_num_ptr)
- *eval_file_num_ptr = fid;
+ *eval_file_num_ptr = outer_fid;
if (eval_line_num_ptr)
*eval_line_num_ptr = (unsigned
int)SvUV(*av_fetch(av,NYTP_FIDi_EVAL_LINE,1));
if (recurse)
- eval_outer_fid(aTHX_ fid_fileinfo_av, fid, recurse,
eval_file_num_ptr, eval_line_num_ptr);
+ eval_outer_fid(aTHX_ fid_fileinfo_av, outer_fid, recurse,
eval_file_num_ptr, eval_line_num_ptr);
return 1;
}
Modified: trunk/bin/nytprofcg
==============================================================================
--- trunk/bin/nytprofcg (original)
+++ trunk/bin/nytprofcg Wed Apr 22 06:50:48 2009
@@ -1,10 +1,8 @@
#!/usr/bin/perl
##########################################################
## This script is part of the Devel::NYTProf distribution
-##
-## Copyright, contact and other information can be found
-## at the bottom of this file, or by going to:
-## http://search.cpan.org/~akaplan/Devel-NYTProf
+## Released under the same terms as Perl 5.8.0
+## See http://search.cpan.org/dist/Devel-NYTProf/
##
##########################################################
# $Id: /mirror/devel-nytprof/bin/nytprofhtml 13295
2009-04-06T20:34:49.946854Z tim.bunce $
@@ -16,27 +14,36 @@
my %opt = (
file => 'nytprof.out',
- out => 'nytprof',
+ out => 'nytprof.callgrind',
);
process_cli();
-print "Generating report...\n";
+print "Reading $opt{file} ...\n";
my $profile = Devel::NYTProf::Data->new( { filename => $opt{file},
quiet => 1 } );
-open my $fh, '>', $opt{out};
+print "Writing $opt{out} ...\n";
+
+# calltree format specification
+#
http://kcachegrind.sourceforge.net/cgi-bin/show.cgi/KcacheGrindCalltreeFormat
+
+open my $fh, '>', $opt{out}
+ or die "Can't write to $opt{out}: $!\n";
print $fh "events: Ticks".$/;
print $fh $/;
my %callmap;
+my $subname_subinfo_map = $profile->subname_subinfo_map;
+
+for my $sub (values %$subname_subinfo_map) {
-for my $sub (values %{ $profile->{sub_subinfo} }) {
my $callers = $sub->callers;
next unless ($callers && %$callers);
+
my $fi = eval { $sub->fileinfo };
print $fh 'fl='.( $fi ? $fi->filename : "Unknown").$/;
@@ -48,6 +55,7 @@
while ( my ( $fid, $fid_line_info ) = each %$callers ) {
for my $line ( keys %$fid_line_info ) {
my ( $count, $incl_time, $excl_time ) = @{
$fid_line_info->{$line} };
+
my @subnames = $profile->subname_at_file_line( $fid, $line );
ref $_ and $_ = sprintf "%s (merge of %d subs)", $_->[0],
scalar @$_
for @subnames;
@@ -86,41 +94,13 @@
}
sub process_cli {
- GetOptions( \%opt, qw/file|f=s delete|d out|o=s lib|l=s help|h open/ )
or exit 1;
+ GetOptions( \%opt, qw/file|f=s out|o=s help|h/ )
+ or exit 1;
if ( defined( $opt{help} ) ) {
- &usage;
+ usage();
exit 1;
}
-
- # handle file selection option
- if ( !-r $opt{file} ) {
- die "$0: Unable to access $opt{file}\n";
- }
-
- # handle handle output location
- if ( !-e $opt{out} ) {
-
- # will be created
- }
- elsif ( !-w $opt{out} ) {
- die "$0: Unable to write to output file `$opt{out}'\n";
- }
-
- # handle deleting old db's
- if ( defined( $opt{'delete'} ) ) {
- # XXX don't need to
- }
-
- # handle custom lib path
- if ( defined( $opt{lib} ) ) {
- if ( -d $opt{lib} ) {
- unshift( @INC, $opt{lib} );
- }
- else {
- die "$0: Specified lib directory `$opt{lib}' does not
exist.\n";
- }
- }
}
sub usage {
@@ -132,9 +112,9 @@
--delete, -d Delete the old output [uses --out]
--help, -h Print this message
-This script of part of the Devel::NYTProf package by Adam J Kaplan.
-Copyright 2008 Adam J Kaplan, http://search.cpan.org/~akaplan, Released
under
-the same terms as Perl itself.
+This script of part of the Devel::NYTProf distribution.
+Released under the same terms as Perl 5.8.0
+See http://search.cpan.org/dist/Devel-NYTProf/
END
}
Modified: trunk/lib/Devel/NYTProf.pm
==============================================================================
--- trunk/lib/Devel/NYTProf.pm (original)
+++ trunk/lib/Devel/NYTProf.pm Wed Apr 22 06:50:48 2009
@@ -421,19 +421,30 @@
Using the C<start=no> option lets you leave the profiler disabled initially
until you call DB::enable_profile() at the right moment.
-You can finish profiling completely by calling DB::finish_profile().
-This may be useful if perl is exiting abnormally, leaving the profile data
file
-in an incomplete state. You can use DB::enable_profile() after
-DB::finish_profile() to enable profiling again. If the filename is not
given,
-the current profile output file will be overwritten.
-
-=head2 Multiple Output Files
-
-You can pass a filename argument to DB::enable_profile() to make NYTProf
write
-future profile data to that file. The current output file, if any, is
closed.
-Any existing file with the new name will be deleted before being written
to.
-When combined with DB::disable_profile() this lets you profile individual
-sections of code.
+The profile output file can't be used until it's been properly completed
and
+closed. Calling DB::disable_profile() doesn't do that. To make a profile
file
+usable before the profiled application has completed you can call
+DB::finish_profile(). Alternatively you could call
DB::enable_profile($newfile).
+
+=head2 DB::disable_profile()
+
+Stops collection of profile data.
+
+Subroutine calls which were made while profiling was enabled and are still
on
+the call stack (have not yet exited) will still have their profile data
+collected when they exit.
+
+=head2 DB::enable_profile($newfile)
+
+Enables collection of profile data. If $newfile is true the profile data
will be
+written to $newfile (after completing and closing the previous file, if
any).
+If $newfile already exists it will be deleted first.
+
+=head2 DB::finish_profile()
+
+Calls DB::disable_profile(), then completes the profile data file by
writing
+subroutine profile data, and then closes the file. The in memory subroutine
+profile data is then discarded.
=head1 REPORTS
Modified: trunk/t/test50-disable.rdt
==============================================================================
--- trunk/t/test50-disable.rdt (original)
+++ trunk/t/test50-disable.rdt Wed Apr 22 06:50:48 2009
@@ -30,6 +30,6 @@
profile_modes fid_block_time block
profile_modes fid_line_time line
profile_modes fid_sub_time sub
-sub_subinfo DB::disable_profile [ undef 0 0 3 0 0 0 0 ]
+sub_subinfo DB::disable_profile [ undef 0 0 2 0 0 0 0 ]
sub_subinfo DB::disable_profile called_by 1 2 [ 1 0 0
0 0 0 0 ]
sub_subinfo DB::disable_profile called_by 1 6 [ 1 0 0
0 0 0 0 ]
Modified: trunk/t/test51-enable.p
==============================================================================
--- trunk/t/test51-enable.p (original)
+++ trunk/t/test51-enable.p Wed Apr 22 06:50:48 2009
@@ -1,20 +1,42 @@
# test using enable_profile() to write multiple profile files
-sub foo { 1 }
-foo();
+my $file_b = "nytprof-test51-b.out";
+my $file_c = "nytprof-test51-c.out";
+unlink $file_b, $file_c;
+
+eval "sub sub$_ { 1 }" for (1..10);
+
+sub1(); # profiled
DB::disable_profile();
-foo();
+
+sub2(); # not profiled
# switch to new file and (re)enable profiling
-DB::enable_profile("nytprof-test51-b.out");
-foo();
+# the new file includes accumulated fid and subs-called data
+DB::enable_profile($file_b);
+
+sub3(); # profiled
+
+DB::finish_profile();
+die "$file_b should exist" unless -s $file_b;
+
+sub4(); # not profiled
+
+# enable to new file
+DB::enable_profile($file_c);
+
+sub5(); # profiled but file will be overwritten by enable_profile() below
+
+DB::finish_profile();
+
+sub6(); # not profiled
+
+DB::enable_profile(); # enable to current file
+
+sub7(); # profiled
+
DB::finish_profile();
-# switch to new file while already enabled
-DB::enable_profile("nytprof-test51-c.out");
-foo();
# This can be removed once we have a better test harness
--f $_ or die "$_ should exist"
- for ("nytprof-test51-b.out", "nytprof-test51-c.out");
-BEGIN { unlink "nytprof-test51-b.out", "nytprof-test51-c.out" }
+-f $_ or die "$_ should exist" for ($file_b, $file_c);
Modified: trunk/t/test51-enable.rdt
==============================================================================
--- trunk/t/test51-enable.rdt (original)
+++ trunk/t/test51-enable.rdt Wed Apr 22 06:50:48 2009
@@ -14,20 +14,38 @@
attribute xs_version 0
fid_block_time 1 3 [ 0 1 ]
fid_block_time 1 4 [ 0 1 ]
+fid_block_time 1 5 [ 0 1 ]
+fid_block_time 1 7 0 0
+fid_block_time 1 7 1 2
+fid_block_time 1 7 2 1 [ 0 1 ]
+fid_block_time 1 9 [ 0 1 ]
fid_fileinfo 1 [ test51-enable.p 1 2 0 0 ]
-fid_fileinfo 1 sub main::BEGIN 20-20
-fid_fileinfo 1 sub main::foo 3-3
-fid_fileinfo 1 call 4 main::foo [ 1 0 0 0 0 0 0 ]
-fid_fileinfo 1 call 6 DB::disable_profile [ 1 0 0 0 0 0 0
]
+fid_fileinfo 1 call 9 main::sub1 [ 1 0 0 0 0 0 0 ]
+fid_fileinfo 1 call 11 DB::disable_profile [ 1 0 0 0 0 0 0
]
+fid_fileinfo 1 eval 7 [ 2 0 ]
+fid_fileinfo 2 [ (eval 0)[test51-enable.p:7] 1 7 2 2 0 0 ]
+fid_fileinfo 2 sub main::sub1 1-1
+fid_fileinfo 3 [ (eval 0)[test51-enable.p:7] 1 7 3 4 0 0 ]
+fid_fileinfo 3 sub main::sub9 1-1
fid_line_time 1 3 [ 0 1 ]
fid_line_time 1 4 [ 0 1 ]
+fid_line_time 1 5 [ 0 1 ]
+fid_line_time 1 7 0 0
+fid_line_time 1 7 1 2
+fid_line_time 1 7 2 1 [ 0 1 ]
+fid_line_time 1 9 [ 0 1 ]
fid_sub_time 1 3 [ 0 1 ]
fid_sub_time 1 4 [ 0 1 ]
+fid_sub_time 1 5 [ 0 1 ]
+fid_sub_time 1 7 0 0
+fid_sub_time 1 7 1 2
+fid_sub_time 1 7 2 1 [ 0 1 ]
+fid_sub_time 1 9 [ 0 1 ]
profile_modes fid_block_time block
profile_modes fid_line_time line
profile_modes fid_sub_time sub
-sub_subinfo DB::disable_profile [ undef 0 0 2 0 0 0 0 ]
-sub_subinfo DB::disable_profile called_by 1 6 [ 1 0 0
0 0 0 0 ]
-sub_subinfo main::BEGIN [ 1 20 20 0 0 0 0 0 ]
-sub_subinfo main::foo [ 1 3 3 1 0 0 0 0 ]
-sub_subinfo main::foo called_by 1 4 [ 1 0 0 0 0 0 0
]
+sub_subinfo DB::disable_profile [ undef 0 0 1 0 0 0 0 ]
+sub_subinfo DB::disable_profile called_by 1 11 [ 1 0 0
0 0 0 0 ]
+sub_subinfo main::sub1 [ 2 1 1 1 0 0 0 0 ]
+sub_subinfo main::sub1 called_by 1 9 [ 1 0 0 0 0 0 0
]
+sub_subinfo main::sub9 [ 3 1 1 0 0 0 0 0 ]
Modified: trunk/t/test51-enable.t
==============================================================================
--- trunk/t/test51-enable.t (original)
+++ trunk/t/test51-enable.t Wed Apr 22 06:50:48 2009
@@ -3,4 +3,42 @@
use lib qw(t/lib);
use NYTProfTest;
-run_test_group;
+run_test_group({
+ extra_test_count => 3,
+ extra_test_code => sub {
+ my ($profile, $env) = @_;
+
+ is_deeply(sub_calls($profile), {
+ 'main::sub1' => 1,
+ 'DB::disable_profile' => 1,
+ });
+
+ my $file_b = "nytprof-test51-b.out";
+ my $file_c = "nytprof-test51-c.out";
+
+ my $pb = Devel::NYTProf::Data->new( { filename => $file_b, quiet
=> 1 } );
+ is_deeply(sub_calls($pb), {
+ 'main::sub1' => 1,
+ 'main::sub3' => 1,
+ 'DB::disable_profile' => 1,
+ }, "$file_b sub calls");
+
+ my $pc = Devel::NYTProf::Data->new( { filename => $file_c, quiet
=> 1 } );
+ is_deeply(sub_calls($pc), {
+ 'main::sub7' => 1,
+ 'DB::finish_profile' => 1,
+ }, "$file_c sub calls");
+ },
+});
+
+sub sub_calls {
+ my ($profile) = @_;
+ my %sub_calls;
+ for my $si (values %{ $profile->subname_subinfo_map }) {
+ my $calls = $si->calls
+ or next;
+ $sub_calls{ $si->subname } = $calls;
+ }
+ print "sub_calls: { @{[ %sub_calls ]} }\n";
+ return \%sub_calls;
+}
Modified: trunk/t/test51-enable.x
==============================================================================
--- trunk/t/test51-enable.x (original)
+++ trunk/t/test51-enable.x Wed Apr 22 06:50:48 2009
@@ -3,21 +3,43 @@
# Format: time,calls,time/call,code
0,0,0,# test using enable_profile() to write multiple profile files
0,0,0,
-0,1,0,sub foo { 1 }
-0,1,0,foo();
+0,1,0,my $file_b = "nytprof-test51-b.out";
+0,1,0,my $file_c = "nytprof-test51-c.out";
+0,1,0,unlink $file_b, $file_c;
+0,0,0,
+0,2,0,eval "sub sub$_ { 1 }" for (1..10);
+0,0,0,
+0,1,0,sub1(); # profiled
0,0,0,
0,0,0,DB::disable_profile();
-0,0,0,foo();
+0,0,0,
+0,0,0,sub2(); # not profiled
0,0,0,
0,0,0,# switch to new file and (re)enable profiling
-0,0,0,DB::enable_profile("nytprof-test51-b.out");
-0,0,0,foo();
+0,0,0,# the new file includes accumulated fid and subs-called data
+0,0,0,DB::enable_profile($file_b);
+0,0,0,
+0,0,0,sub3(); # profiled
+0,0,0,
+0,0,0,DB::finish_profile();
+0,0,0,die "$file_b should exist" unless -s $file_b;
+0,0,0,
+0,0,0,sub4(); # not profiled
+0,0,0,
+0,0,0,# enable to new file
+0,0,0,DB::enable_profile($file_c);
+0,0,0,
+0,0,0,sub5(); # profiled but file will be overwritten by enable_profile()
below
+0,0,0,
+0,0,0,DB::finish_profile();
+0,0,0,
+0,0,0,sub6(); # not profiled
+0,0,0,
+0,0,0,DB::enable_profile(); # enable to current file
+0,0,0,
+0,0,0,sub7(); # profiled
+0,0,0,
0,0,0,DB::finish_profile();
-0,0,0,# switch to new file while already enabled
-0,0,0,DB::enable_profile("nytprof-test51-c.out");
-0,0,0,foo();
0,0,0,
0,0,0,# This can be removed once we have a better test harness
-0,0,0,-f $_ or die "$_ should exist"
-0,0,0,for ("nytprof-test51-b.out", "nytprof-test51-c.out");
-0,0,0,BEGIN { unlink "nytprof-test51-b.out", "nytprof-test51-c.out" }
+0,0,0,-f $_ or die "$_ should exist" for ($file_b, $file_c);
Modified: trunk/t/test60-subname.rdt
==============================================================================
--- trunk/t/test60-subname.rdt (original)
+++ trunk/t/test60-subname.rdt Wed Apr 22 06:50:48 2009
@@ -55,7 +55,7 @@
profile_modes fid_line_time line
profile_modes fid_sub_time sub
sub_subinfo Devel::NYTProf::Test::example_sub [ 2 13 13 0 0 0 0 0 ]
-sub_subinfo Devel::NYTProf::Test::example_xsub [ 2 0 0 6 0 0 0 0 ]
+sub_subinfo Devel::NYTProf::Test::example_xsub [ 2 0 0 5 0 0 0 0 ]
sub_subinfo Devel::NYTProf::Test::example_xsub called_by 1
5 [ 1 0 0 0 0 0
0 ]
sub_subinfo Devel::NYTProf::Test::example_xsub called_by 1
9 [ 1 0 0 0 0 0
0 ]
sub_subinfo Devel::NYTProf::Test::example_xsub called_by 1
12 [ 1 0 0 0 0
0 0 ]
--~--~---------~--~----~------------~-------~--~----~
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]
-~----------~----~----~----~------~----~------~--~---
