Author: tim.bunce
Date: Tue Dec 9 12:31:42 2008
New Revision: 648
Added:
trunk/t/test61-submerge.p
trunk/t/test61-submerge.rdt
Modified:
trunk/MANIFEST
trunk/NYTProf.xs
trunk/lib/Devel/NYTProf/Data.pm
trunk/lib/Devel/NYTProf/FileInfo.pm
trunk/lib/Devel/NYTProf/SubInfo.pm
Log:
Remove sub_callers element from profile data. Move data about callers to a
sub
into the sub_subinfo object for that sub.
(sub_caller data is currently regenerated for the dump used by tests.)
Merge anon subs defined on the same line of instances of the same string
eval.
Modified: trunk/MANIFEST
==============================================================================
--- trunk/MANIFEST (original)
+++ trunk/MANIFEST Tue Dec 9 12:31:42 2008
@@ -108,6 +108,8 @@
t/test50-disable.x
t/test60-subname.p
t/test60-subname.rdt
+t/test61-submerge.p
+t/test61-submerge.rdt
t/test70-subexcl.p
t/test80-recurs.p
t/test80-recurs.rdt
Modified: trunk/NYTProf.xs
==============================================================================
--- trunk/NYTProf.xs (original)
+++ trunk/NYTProf.xs Tue Dec 9 12:31:42 2008
@@ -2835,7 +2835,6 @@
AV* fid_block_time_av = NULL;
AV* fid_sub_time_av = NULL;
HV* sub_subinfo_hv = newHV();
- HV* sub_callers_hv = newHV();
SV *tmp_str_sv = newSVpvn("",0);
HV *file_info_stash = gv_stashpv("Devel::NYTProf::FileInfo",
GV_ADDWARN);
@@ -3247,14 +3246,11 @@
subinfo_av = lookup_subinfo_av(aTHX_ subname_sv,
sub_subinfo_hv);
- /* { 'pkg::sub' => { fid => { line => [ count, incl_time,
excl_time ] } } } */
- he = hv_fetch_ent(sub_callers_hv, subname_sv, 1, 0);
- sv = HeVAL(he);
+ /* { caller_fid => { caller_line => [ count, incl_time,
excl_time ] } } */
+ sv = *av_fetch(subinfo_av, NYTP_SIi_CALLED_BY, 1);
if (!SvROK(sv)) /* autoviv */
sv_setsv(sv, newRV_noinc((SV*)newHV()));
- sv_setsv(*av_fetch(subinfo_av, NYTP_SIi_CALLED_BY, 1), sv);
-
len = sprintf(text, "%u", fid);
sv = *hv_fetch((HV*)SvRV(sv), text, len, 1);
if (!SvROK(sv)) /* autoviv */
@@ -3267,8 +3263,9 @@
sv = *hv_fetch((HV*)SvRV(sv), text, len, 1);
if (!SvROK(sv)) /* autoviv */
sv_setsv(sv, newRV_noinc((SV*)newAV()));
- else warn("sub_caller info for %s %d:%d already
exists!",
- SvPV_nolen(subname_sv), fid, line);
+ else /* XXX the code below should accumulate instead
of set values */
+ warn("sub caller info for %s %d:%d already
exists!",
+ SvPV_nolen(subname_sv), fid, line);
sv = SvRV(sv);
sv_setuv(*av_fetch((AV *)sv, NYTP_SCi_CALL_COUNT, 1),
count);
sv_setnv(*av_fetch((AV *)sv, NYTP_SCi_INCL_RTIME, 1),
incl_time);
@@ -3487,7 +3484,6 @@
SvREFCNT_dec(fid_block_time_av);
SvREFCNT_dec(fid_sub_time_av);
SvREFCNT_dec(sub_subinfo_hv);
- SvREFCNT_dec(sub_callers_hv);
SvREFCNT_dec(tmp_str_sv);
return newHV(); /* dummy */
@@ -3540,7 +3536,6 @@
(void)hv_stores(profile_modes, "fid_sub_time", newSVpvf("sub"));
}
(void)hv_stores(profile_hv, "sub_subinfo",
newRV_noinc((SV*)sub_subinfo_hv));
- (void)hv_stores(profile_hv, "sub_caller",
newRV_noinc((SV*)sub_callers_hv));
(void)hv_stores(profile_hv, "profile_modes",
newRV_noinc((SV*)profile_modes));
return profile_hv;
}
Modified: trunk/lib/Devel/NYTProf/Data.pm
==============================================================================
--- trunk/lib/Devel/NYTProf/Data.pm (original)
+++ trunk/lib/Devel/NYTProf/Data.pm Tue Dec 9 12:31:42 2008
@@ -80,10 +80,8 @@
my $fid_fileinfo = $profile->{fid_fileinfo};
my $sub_subinfo = $profile->{sub_subinfo};
- my $sub_caller = $profile->{sub_caller};
#use Data::Dumper; warn Dumper($sub_subinfo);
- #use Data::Dumper; warn Dumper($sub_caller);
# add profile ref so fidinfo & subinfo objects
# XXX circular ref, add weaken
@@ -97,16 +95,15 @@
# XXX merge evals - should become a method optionally called here
# (which uses other methods to do the work and those methods
# should also be called by Devel::NYTProf::SubInfo::callers())
- my %anon_eval_subs_merged;
while (my ($subname, $subinfo) = each %$sub_subinfo) {
# add subname into sub_subinfo
- $subinfo->[6] = $subname;
+ $subinfo->[6] = $subname; # XXX breaks encapsulation
if ($subname =~ s/(::__ANON__\[\(\w*eval) \d+\)/$1 0)/) {
# sub names like "PPI::Node::__ANON__[(eval
286)[PPI/Node.pm:642]:4]"
# aren't very useful, so we merge them by changing the eval to
0
- my $oldname = $subinfo->[6];
+ my $oldname = $subinfo->subname;
delete $sub_subinfo->{$oldname}; # delete old name
if (my $newinfo = $sub_subinfo->{$subname}) {
$newinfo->merge_in($subinfo);
@@ -116,44 +113,9 @@
# is first to change, so just move ref to new name
$sub_subinfo->{$subname} = $subinfo;
- $subinfo->[6] = $subname;
+ $subinfo->[6] = $subname; # XXX breaks encapsulation
warn "renamed sub_info $oldname into $subname\n" if $trace;
}
-
- # delete sub_caller info and merge into new name
- my $old_caller_info = delete $sub_caller->{$oldname};
-
- # { 'pkg::sub' => { fid => { line => [ count, incl_time ] } }
} */
- if (my $newinfo = $sub_caller->{$subname}) {
-
- # iterate over old and merge info new
- while (my ($fid, $line_hash) = each %$old_caller_info) {
- my $new_line_hash = $newinfo->{$fid};
- if (!$new_line_hash) {
- $newinfo->{$fid} = $line_hash;
- warn "renamed sub_caller $oldname into $subname\n"
if $trace;
- next;
- }
- warn "merged sub_caller $oldname into $subname\n" if
$trace;
-
- # merge lines in %$line_hash into %$new_line_hash
- while (my ($line, $line_info) = each %$line_hash) {
- my $new_line_info = $new_line_hash->{$line};
- if (!$new_line_info) {
- $new_line_hash->{$line} = $line_info;
- next;
- }
-
- # merge @$line_info into @$new_line_info
- $new_line_info->[0] += $line_info->[0];
- $new_line_info->[1] += $line_info->[1];
- }
-
- }
- }
- else {
- $sub_caller->{$subname} = $old_caller_info;
- }
}
}
$profile->_clear_caches;
@@ -257,7 +219,7 @@
}
# check if already a file info object
- return $arg if ref $arg and $arg->isa('Devel::NYTProf::FileInfo');
+ return $arg if ref $arg and UNIVERSAL::can($arg,'fid') and
$arg->isa('Devel::NYTProf::FileInfo');
my $fid = $self->resolve_fid($arg);
if (not $fid) {
@@ -320,72 +282,9 @@
The default format is a Data::Dumper style whitespace-indented tree.
The types of data present can depend on the options used when profiling.
- {
- attribute => {
- basetime => 1207228764
- ticks_per_sec => 1000000
- xs_version => 1.13
- }
- fid_fileinfo => [
- 1: [
- 0: test01.p
- 1:
- 2:
- 3: 1
- 4: 0
- 5: 0
- 6: 0
- ]
- ]
- fid_line_time => [
- 1: [
- 2: [ 4e-06 2 ]
- 3: [ 1.2e-05 2 ]
- 7: [ 4.6e-05 4 ]
- 11: [ 2e-06 1 ]
- 16: [ 1.2e-05 1 ]
- ]
- ]
- sub_caller => {
- main::bar => {
- 1 => {
- 12 => 1 # main::bar was called by fid 1, line 12, 1 time.
- 16 => 1
- 3 => 2
- }
- }
- main::foo => {
- 1 => {
- 11 => 1
- }
- }
- }
- sub_subinfo => {
- main::bar => [ 1 6 8 762 2e-06 ]
- main::foo => [ 1 1 4 793 1.5e-06 ]
- }
- }
-
If C<separator> is true then instead of whitespace, each item of data is
indented with the I<path> through the structure with C<separator> used to
separarate the elements of the path.
-
- attribute basetime 1207228260
- attribute ticks_per_sec 1000000
- attribute xs_version 1.13
- fid_fileinfo 1 test01.p
- fid_line_time 1 2 [ 4e-06 2 ]
- fid_line_time 1 3 [ 1.1e-05 2 ]
- fid_line_time 1 7 [ 4.4e-05 4 ]
- fid_line_time 1 11 [ 2e-06 1 ]
- fid_line_time 1 16 [ 1e-05 1 ]
- sub_caller main::bar 1 12 1
- sub_caller main::bar 1 16 1
- sub_caller main::bar 1 3 2
- sub_caller main::foo 1 11 1
- sub_subinfo main::bar [ 1 6 8 762 2e-06 ]
- sub_subinfo main::foo [ 1 1 4 793 1.5e-06 ]
-
This format is especially useful for grep'ing and diff'ing.
=cut
@@ -403,7 +302,9 @@
my $startnode = { %$self, sub_caller => my $sub_caller = {} };
for my $si (values %{ $self->{sub_subinfo} }) {
my $sc = $si->callers or next;
- $sub_caller->{$si->subname} = $sc;
+ my $subname = $si->subname;
+ $subname = $subname->[0] if ref $subname;
+ $sub_caller->{$subname} = $sc;
}
$self->_clear_caches;
@@ -588,7 +489,7 @@
# zero sub into and sub caller times
$_->normalize_for_test for values %{ $self->{sub_subinfo} };
- for my $info ($self->{sub_subinfo}, $self->{sub_caller}) {
+ for my $info ($self->{sub_subinfo}) {
# normalize eval sequence numbers in sub names to 0
for my $subname (keys %$info) {
@@ -838,8 +739,8 @@
Returns a reference to a hash containing information about subroutine calls
made at individual lines within a source file. The $file
-argument can be an integer file id (fid) or a file path. Returns undef if
the
-profile contains no C<sub_caller> data for the $file.
+argument can be an integer file id (fid) or a file path. Returns undef if
+no subroutine calling information is available.
The keys of the returned hash are line numbers. The values are references
to
hashes with fully qualified subroutine names as keys. Each hash value is an
Modified: trunk/lib/Devel/NYTProf/FileInfo.pm
==============================================================================
--- trunk/lib/Devel/NYTProf/FileInfo.pm (original)
+++ trunk/lib/Devel/NYTProf/FileInfo.pm Tue Dec 9 12:31:42 2008
@@ -120,22 +120,6 @@
return $f->[0];
}
-sub delete_subs_called_info {
- my $self = shift;
- my $profile = $self->profile;
- my $sub_caller = $profile->{sub_caller}
- or return;
- my $fid = $self->fid;
- my $total_sub_calls = 0;
- # remove sub_caller info for calls made *from within* this file
- for my $sci (values %$sub_caller) {
- my $info = delete $sci->{$fid};
- # NYTP_SCi_CALL_COUNT
- $total_sub_calls += $_->[0] for values %$info;
- }
- $profile->{attribute}{total_sub_calls} -= $total_sub_calls;
- return;
-}
sub abs_filename {
my $self = shift;
Modified: trunk/lib/Devel/NYTProf/SubInfo.pm
==============================================================================
--- trunk/lib/Devel/NYTProf/SubInfo.pm (original)
+++ trunk/lib/Devel/NYTProf/SubInfo.pm Tue Dec 9 12:31:42 2008
@@ -9,6 +9,7 @@
NYTP_SIi_CALL_COUNT NYTP_SIi_INCL_RTIME NYTP_SIi_EXCL_RTIME
NYTP_SIi_SUB_NAME NYTP_SIi_PROFILE
NYTP_SIi_REC_DEPTH NYTP_SIi_RECI_RTIME NYTP_SIi_CALLED_BY
+
NYTP_SCi_INCL_RTIME NYTP_SCi_EXCL_RTIME
NYTP_SCi_INCL_UTIME NYTP_SCi_INCL_STIME NYTP_SCi_RECI_RTIME
);
@@ -16,15 +17,33 @@
use List::Util qw(sum min max);
sub fid { $_[0]->[NYTP_SIi_FID] || croak "No fid for $_[0][6]" }
+
sub first_line { shift->[NYTP_SIi_FIRST_LINE] }
+
sub last_line { shift->[NYTP_SIi_LAST_LINE] }
+
sub calls { shift->[NYTP_SIi_CALL_COUNT] }
+
sub incl_time { shift->[NYTP_SIi_INCL_RTIME] }
+
sub excl_time { shift->[NYTP_SIi_EXCL_RTIME] }
-sub subname { shift->[NYTP_SIi_SUB_NAME] }
+
+sub subname {
+ my $subname = shift->[NYTP_SIi_SUB_NAME];
+ return $subname if not ref $subname;
+ # the subname of a merged sub is a ref to an array of the merged
subnames
+ # XXX could be ref to an array of the merged subinfos
+ # XXX or better to add a separate accessor instead of abusing subname
like this
+ return $subname if not defined(my $join = shift);
+ return join $join, @$subname;
+}
+
sub profile { shift->[NYTP_SIi_PROFILE] }
+
sub package { (my $pkg = shift->subname) =~ s/^(.*)::.*/$1/; return
$pkg }
+
sub recur_max_depth { shift->[NYTP_SIi_REC_DEPTH] }
+
sub recur_incl_time { shift->[NYTP_SIi_RECI_RTIME] }
# { fid => { line => [ count, incl_time ] } }
@@ -55,22 +74,60 @@
}
# merge details of another sub into this one
-# there are few cases where this is sane thing to do
+# there are very few cases where this is sane thing to do
# it's meant for merging things like anon-subs in evals
# e.g., "PPI::Node::__ANON__[(eval 286)[PPI/Node.pm:642]:4]"
sub merge_in {
- my $self = shift;
+ my $self = shift;
my $new = shift;
- $self->[NYTP_SIi_FIRST_LINE] = min($self->[NYTP_SIi_FIRST_LINE],
$new->[NYTP_SIi_FIRST_LINE]);
- $self->[NYTP_SIi_LAST_LINE] = max($self->[NYTP_SIi_LAST_LINE],
$new->[NYTP_SIi_LAST_LINE]);
+
+ $self->[NYTP_SIi_FIRST_LINE] = min($self->[NYTP_SIi_FIRST_LINE],
$new->[NYTP_SIi_FIRST_LINE]);
+ $self->[NYTP_SIi_LAST_LINE] = max($self->[NYTP_SIi_LAST_LINE],
$new->[NYTP_SIi_LAST_LINE]);
$self->[NYTP_SIi_CALL_COUNT] += $new->[NYTP_SIi_CALL_COUNT];
$self->[NYTP_SIi_INCL_RTIME] += $new->[NYTP_SIi_INCL_RTIME];
$self->[NYTP_SIi_EXCL_RTIME] += $new->[NYTP_SIi_EXCL_RTIME];
- $self->[NYTP_SIi_SUB_NAME] = [ $self->[NYTP_SIi_SUB_NAME] ]
+ $self->[NYTP_SIi_SUB_NAME] = [ $self->[NYTP_SIi_SUB_NAME] ]
if not ref $self->[NYTP_SIi_SUB_NAME];
push @{$self->[NYTP_SIi_SUB_NAME]}, $new->[NYTP_SIi_SUB_NAME];
- $self->[NYTP_SIi_REC_DEPTH] = max($self->[NYTP_SIi_REC_DEPTH],
$new->[NYTP_SIi_REC_DEPTH]);
- $self->[9] = max($self->[NYTP_SIi_RECI_RTIME],
$new->[NYTP_SIi_RECI_RTIME]); # ug, plausible
+ $self->[NYTP_SIi_REC_DEPTH] = max($self->[NYTP_SIi_REC_DEPTH],
$new->[NYTP_SIi_REC_DEPTH]);
+ $self->[NYTP_SIi_RECI_RTIME] = max($self->[NYTP_SIi_RECI_RTIME],
$new->[NYTP_SIi_RECI_RTIME]); # ug, plausible
+
+ # { fid => { line => [ count, incl_time ] } }
+ my $dst_called_by = $self->[NYTP_SIi_CALLED_BY] ||= {};
+ my $src_called_by = $new ->[NYTP_SIi_CALLED_BY] || {};
+
+ my $trace = 0;
+ my $subname = $self->subname(' and ');
+
+ # iterate over src and merge into dst
+ while (my ($fid, $src_line_hash) = each %$src_called_by) {
+ my $dst_line_hash = $dst_called_by->{$fid};
+ if (!$dst_line_hash) {
+ $dst_called_by->{$fid} = $src_line_hash;
+ warn "renamed sub caller $self->[NYTP_SIi_SUB_NAME] into
$subname\n" if $trace;
+ next;
+ }
+ warn "merged sub caller $self->[NYTP_SIi_SUB_NAME] into
$subname\n" if $trace;
+
+ # merge lines in %$src_line_hash into %$dst_line_hash
+ while (my ($line, $src_line_info) = each %$src_line_hash) {
+ my $dst_line_info = $dst_line_hash->{$line};
+ if (!$dst_line_info) {
+ $dst_line_hash->{$line} = $src_line_info;
+ next;
+ }
+
+ # merge @$src_line_info into @$dst_line_info
+ $dst_line_info->[$_] += $src_line_info->[$_] for (
+ NYTP_SCi_INCL_RTIME, NYTP_SCi_EXCL_RTIME,
+ NYTP_SCi_INCL_UTIME, NYTP_SCi_INCL_STIME
+ );
+ # ug, we can't really combine recursive incl_time, but this is
better than undef
+ $dst_line_info->[NYTP_SCi_RECI_RTIME] =
max($dst_line_info->[NYTP_SCi_RECI_RTIME],
+
$src_line_info->[NYTP_SCi_RECI_RTIME]);
+ }
+ }
+
return;
}
@@ -122,15 +179,17 @@
$self->[NYTP_SIi_EXCL_RTIME] = 0;
$self->[NYTP_SIi_RECI_RTIME] = 0;
- # zero per-call-location subroutine inclusive time
+ my $subname = $self->subname(' and ');
+
+ # { fid => { line => [ count, incl, excl, ucpu, scpu, reci, recdepth ]
} }
my $callers = $self->callers || {};
- # $callers => { fid => { line => [ count, incl, excl, ucpu, scpu,
reci, recdepth ] } }
- for (map { values %$_ } values %$callers) {
- $_->[NYTP_SCi_INCL_RTIME] =
- $_->[NYTP_SCi_EXCL_RTIME] =
- $_->[NYTP_SCi_INCL_UTIME] =
- $_->[NYTP_SCi_INCL_STIME] =
- $_->[NYTP_SCi_RECI_RTIME] = 0;
+ # zero per-call-location subroutine inclusive time
+ for my $sc (map { values %$_ } values %$callers) {
+ $sc->[NYTP_SCi_INCL_RTIME] =
+ $sc->[NYTP_SCi_EXCL_RTIME] =
+ $sc->[NYTP_SCi_INCL_UTIME] =
+ $sc->[NYTP_SCi_INCL_STIME] =
+ $sc->[NYTP_SCi_RECI_RTIME] = 0;
}
}
Added: trunk/t/test61-submerge.p
==============================================================================
--- (empty file)
+++ trunk/t/test61-submerge.p Tue Dec 9 12:31:42 2008
@@ -0,0 +1,8 @@
+# test merging of sub info and sub callers
+# which is applied to, e.g., anon subs inside evals
+
+sub foo { print "foo @_\n" }
+
+my $code = 'sub { foo() }';
+
+eval($code)->() for 1..3;
Added: trunk/t/test61-submerge.rdt
==============================================================================
--- (empty file)
+++ trunk/t/test61-submerge.rdt Tue Dec 9 12:31:42 2008
@@ -0,0 +1,45 @@
+attribute application test61-submerge.p
+attribute basetime 0
+attribute clock_id 0
+attribute nv_size 0
+attribute perl_version 0
+attribute profiler_duration 0
+attribute profiler_end_time 0
+attribute profiler_start_time 0
+attribute ticks_per_sec 0
+attribute total_stmts_discounted 0
+attribute total_stmts_duration 0
+attribute total_stmts_measured 0
+attribute total_sub_calls 6
+attribute xs_version 0
+fid_block_time 1 4 [ 0 3 ]
+fid_block_time 1 6 [ 0 1 ]
+fid_block_time 1 8 0 0
+fid_block_time 1 8 1 2
+fid_block_time 1 8 2 1 [ 0 3 ]
+fid_block_time 1 8 2 2 [ 0 3 ]
+fid_fileinfo 1 [ /.../test61-submerge.p 1 2 0 0 ]
+fid_fileinfo 2 [ (eval 0)[test61-submerge.p:8] 1 8 2 2 0 0 ]
+fid_fileinfo 3 [ (eval 0)[test61-submerge.p:8] 1 8 3 2 0 0 ]
+fid_fileinfo 4 [ (eval 0)[test61-submerge.p:8] 1 8 4 2 0 0 ]
+fid_line_time 1 4 [ 0 3 ]
+fid_line_time 1 6 [ 0 1 ]
+fid_line_time 1 8 0 0
+fid_line_time 1 8 1 2
+fid_line_time 1 8 2 1 [ 0 3 ]
+fid_line_time 1 8 2 2 [ 0 3 ]
+fid_sub_time 1 4 [ 0 3 ]
+fid_sub_time 1 6 [ 0 1 ]
+fid_sub_time 1 8 0 0
+fid_sub_time 1 8 1 2
+fid_sub_time 1 8 2 1 [ 0 3 ]
+fid_sub_time 1 8 2 2 [ 0 3 ]
+profile_modes fid_block_time block
+profile_modes fid_line_time line
+profile_modes fid_sub_time sub
+sub_caller main::__ANON__[(eval 0)[test61-submerge.p:8]:1] 1 8
[ 1 0 0 0 0
0 0 ]
+sub_caller main::foo 2 1 [ 1 0 0 0 0 0 0 ]
+sub_caller main::foo 3 1 [ 1 0 0 0 0 0 0 ]
+sub_caller main::foo 4 1 [ 1 0 0 0 0 0 0 ]
+sub_subinfo main::__ANON__[(eval 0)[test61-submerge.p:8]:1] [ 3 1 1 3 0 0
0 0 ]
+sub_subinfo main::foo [ 1 4 4 3 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]
-~----------~----~----~----~------~----~------~--~---
