Author: tim.bunce
Date: Fri Dec 5 05:15:58 2008
New Revision: 644
Modified:
trunk/lib/Devel/NYTProf/Data.pm
trunk/lib/Devel/NYTProf/SubInfo.pm
Log:
Move sub info and sub caller time mormalizatio for tests into new
normalize_for_test method.
Delete unused fid_sub_calls_map() and _migrate_sub_callers_from_eval_fids()
subs.
Move remove_internal_data_of() and make_filenames_relative() to end of
normalization steps.
Modified: trunk/lib/Devel/NYTProf/Data.pm
==============================================================================
--- trunk/lib/Devel/NYTProf/Data.pm (original)
+++ trunk/lib/Devel/NYTProf/Data.pm Fri Dec 5 05:15:58 2008
@@ -83,6 +83,7 @@
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
@@ -295,19 +296,6 @@
}
-sub fid_sub_calls_map {
- my $self = shift;
- my $sub_caller = $self->{sub_caller} || {};
- my $fid_sub_calls_map = {};
- while ( my ($subname, $fid_hash) = each %$sub_caller ) {
- for my $fid (keys %$fid_hash) {
- push @{ $fid_sub_calls_map->{$fid} }, $subname;
- }
- }
- return $fid_sub_calls_map;
-}
-
-
sub inc {
# XXX should return inc from profile data, when it's there
@@ -589,11 +577,6 @@
# normalize eval sequence numbers in 'file' names to 0
$fi->[0] =~ s/$eval_regex/(${1}eval 0)/g;
-
- # strip out internal details of library modules
- # (the definition of which is quite vague at the moment)
- $self->remove_internal_data_of($fi)
- if $fi->filename =~ $is_lib_regex;
}
# normalize line data
@@ -606,20 +589,8 @@
}
}
- # zero subroutine inclusive time
- my $sub_subinfo = $self->{sub_subinfo};
- for (values %$sub_subinfo) {
- $_->[4] = $_->[5] = $_->[9] = 0;
- }
-
- # zero per-call-location subroutine inclusive time
- # { 'pkg::sub' => { fid => { line => [ count, incl, excl, ucpu, scpu,
reci, recdepth ] } } }
- my $sub_caller = $self->{sub_caller} || {};
- for (map { values %$_ } map { values %$_ } values %$sub_caller) {
- $_->[1] = $_->[2] = $_->[3] = $_->[4] = $_->[5] = 0;
- }
-
- $self->make_filenames_relative($inc, '/.../');
+ # zero sub into and sub caller times
+ $_->normalize_for_test for values %{ $self->{sub_subinfo} };
for my $info ($self->{sub_subinfo}, $self->{sub_caller}) {
@@ -634,50 +605,18 @@
}
}
- return;
-}
+ # final cleanup, to be done last
+ for my $fi ($self->all_fileinfos) {
+ # strip out internal details of library modules
+ # (the definition of which is quite vague at the moment)
+ $self->remove_internal_data_of($fi)
+ if $fi->filename =~ $is_lib_regex;
+ }
-# not currently used, guts may be refactored into new methods later
-sub _migrate_sub_callers_from_eval_fids {
- my $self = shift;
+ $self->make_filenames_relative($inc, '/.../');
- # migrate sub calls made from evals to be calls from the base fid
- #
- # map of { eval_fid => base_fid, ... }
- my $eval_fid_map = $self->eval_fid_2_base_fid_map;
- # map of { fid => { subs called from fid... }, ... }
- my $fid_sub_calls_map = $self->fid_sub_calls_map;
- #
- while ( my ($eval_fid, $base_fid) = each %$eval_fid_map ) {
- my $subnames = $fid_sub_calls_map->{$eval_fid}
- or next; # no subs called from this eval fid
-
- # drill thru string-evals-within-string-evals
- $base_fid = $eval_fid_map->{$base_fid}
- while $eval_fid_map->{$base_fid};
-
- my $line_of_eval = $self->fileinfo_of($eval_fid)->eval_line;
- warn "Migrating sub calls from eval fid $eval_fid to fid $base_fid
line $line_of_eval: @$subnames\n"
- if $trace;
-
- my $sub_caller = $self->{sub_caller};
- for my $subname (@$subnames) {
-
- my $eval_calls = delete $sub_caller->{$subname}{$eval_fid}
- or die "panic";
- my $base_calls = $sub_caller->{$subname}{$base_fid} ||=
{};
-
- warn "merged $subname calls from fid $eval_fid to $base_fid\n"
- if $trace;
- while ( my ($line_in_eval, $eval_line_calls) =
each %$eval_calls ) {
- my $e = $eval_calls->{$line_in_eval};
- my $b = $base_calls->{$line_of_eval} ||= [ (0) x @$e ];
- $b->[$_] += $e->[$_] for ([EMAIL PROTECTED]);
- }
- }
- }
- $self->_clear_caches;
+ return;
}
Modified: trunk/lib/Devel/NYTProf/SubInfo.pm
==============================================================================
--- trunk/lib/Devel/NYTProf/SubInfo.pm (original)
+++ trunk/lib/Devel/NYTProf/SubInfo.pm Fri Dec 5 05:15:58 2008
@@ -9,6 +9,8 @@
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
);
use List::Util qw(sum min max);
@@ -110,6 +112,26 @@
push @callers, map { [$fid, $_, @{$lines->{$_}}] } keys %$lines;
}
return [EMAIL PROTECTED];
+}
+
+sub normalize_for_test {
+ my $self = shift;
+
+ # zero subroutine inclusive time
+ $self->[NYTP_SIi_INCL_RTIME] = 0;
+ $self->[NYTP_SIi_EXCL_RTIME] = 0;
+ $self->[NYTP_SIi_RECI_RTIME] = 0;
+
+ # zero per-call-location subroutine inclusive time
+ 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;
+ }
}
1;
--~--~---------~--~----~------------~-------~--~----~
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]
-~----------~----~----~----~------~----~------~--~---
