Revision: 1188
Author: [email protected]
Date: Mon Apr 19 03:06:11 2010
Log: Added collapsing of 'uninteresting' sibling string evals.
Instead of deleting all the evals, one becomes a merge of the others.
http://code.google.com/p/perl-devel-nytprof/source/detail?r=1188
Modified:
/trunk/bin/nytprofhtml
/trunk/lib/Devel/NYTProf/Data.pm
/trunk/lib/Devel/NYTProf/FileInfo.pm
/trunk/lib/Devel/NYTProf/Reader.pm
/trunk/t/test09.p
/trunk/t/test09.rdt
/trunk/t/test09.x
=======================================
--- /trunk/bin/nytprofhtml Mon Apr 5 16:22:16 2010
+++ /trunk/bin/nytprofhtml Mon Apr 19 03:06:11 2010
@@ -121,15 +121,22 @@
subtitle => $subhead,
);
my $filename_escaped = _escape_html($fi->filename);
- my $intro = sprintf qq{<table class="file_summary">%s</table>},
- join "\n", map { sprintf q{<tr><td class="h">%s</td><td
align="left">%s</td></tr>}, @$_ }
- [ "Filename", $fi->is_file
- ? sprintf(q{<a href="file://%s">%s</a>},
$fi->filename, $filename_escaped)
- : $filename_escaped ],
- [ "Statements", sprintf "Executed %d statements in %s",
- $fi->sum_of_stmts_count,
fmt_time($fi->sum_of_stmts_time) ];
-
- return join "\n", $html_header, $page_header, q{<div
class="body_content"><br />}, $intro;
+ my @intro_rows = (
+ [ "Filename", $fi->is_file
+ ? sprintf(q{<a href="file://%s">%s</a>}, $fi->filename,
$filename_escaped)
+ : $filename_escaped ],
+ [ "Statements", sprintf "Executed %d statements in %s",
+ $fi->sum_of_stmts_count, fmt_time($fi->sum_of_stmts_time)
],
+ );
+ # XXX if string eval then add link to calling location
+
+ my $intro_table = join "\n", map {
+ sprintf q{<tr><td class="h">%s</td><td
align="left">%s</td></tr>}, @$_
+ } @intro_rows;
+
+ return join "\n", $html_header, $page_header,
+ q{<div class="body_content"><br />},
+ qq{<table class="file_summary">$intro_table</table>},
}
);
@@ -137,7 +144,22 @@
'taintmsg',
qq{<div class="warn_title">WARNING!</div>\n
<div class="warn">The source file used to generate this report was modified
-after the profiler database was generated. The database might be out of
sync, you should regenerate it. This page might not make any
sense!</div><br />\n}
+after the profiler data was generated.
+The data might be out of sync with the modified source code so you should
regenerate it.
+Meanwhile, the data on this page might not make much sense!</div><br />\n}
+);
+
+$reporter->set_param(
+ 'merged_fids',
+ sub {
+ my ($profile, $fi) = @_;
+ my $merged_fids = $fi->meta->{merged_fids};
+ return sprintf qq{<div class="warn_title">NOTE!</div>\n
+ <div class="warn">The data used to generate this report page
was merged from %d executions<br />
+ of the string eval on line %d of %s.<br />
+ If the text of those evals varied then this page might not
make much sense.</div><br />\n
+ }, 1+scalar @$merged_fids, $fi->eval_line, $fi->eval_fi->filename;
+ },
);
=======================================
--- /trunk/lib/Devel/NYTProf/Data.pm Sun Apr 18 09:17:15 2010
+++ /trunk/lib/Devel/NYTProf/Data.pm Mon Apr 19 03:06:11 2010
@@ -117,7 +117,7 @@
while ( my ($line, $siblings) = each %$line2fis) {
next if @$siblings == 1;
-next;
+
my @subs = map { values %{ $_->subs } } @$siblings;
my @calls = map { keys %{ $_->sub_call_lines } } @$siblings;
my @evals = map { $_->has_evals(0) } @$siblings;
@@ -127,12 +127,12 @@
warn "$msg\n" if $trace >= 3;
next if @subs; # ignore if the eval defines subs
- next if @calls; # ignore if the eval calls subs
next if @evals; # ignore if the eval has nested evals
+ next if @calls; # ignore if the eval calls subs XXX temp due
to opcodes
warn "$msg COLLAPSING\n" if $trace >= 0;
my $parent = $siblings->[0]->eval_fi;
- $parent->collapse_and_discard_evals(@$siblings);
+ $parent->collapse_sibling_evals(@$siblings);
}
}
=======================================
--- /trunk/lib/Devel/NYTProf/FileInfo.pm Sun Apr 18 09:17:15 2010
+++ /trunk/lib/Devel/NYTProf/FileInfo.pm Mon Apr 19 03:06:11 2010
@@ -44,7 +44,7 @@
return not ($self->is_fake or $self->is_eval);
}
-# general purpose hash - mainly a hack to help kill of Reader.pm
+# general purpose hash - mainly a hack to help kill off Reader.pm
sub meta { shift->[NYTP_FIDi_meta()] ||= {} }
# array of fileinfo's for each string eval in the file
@@ -81,14 +81,23 @@
warn "_delete_eval missed" if @$eval_fis == $count;
# XXX needs to update NYTP_FIDi_SUBS_DEFINED NYTP_FIDi_SUBS_CALLED
- # by moving relevant data up the the parent
+ # by moving relevant data up to the parent
return;
}
# return a ref to a hash of { subname => subinfo, ... }
-sub subs { shift->[NYTP_FIDi_SUBS_DEFINED()] }
+sub subs { shift->[NYTP_FIDi_SUBS_DEFINED()] } # deprecated
+
+# return subs defined as list of SubInfo objects
+# XXX add $include_evals arg?
+sub subs_defined {
+ return values %{ shift->[NYTP_FIDi_SUBS_DEFINED()] };
+}
+sub subs_defined_sorted {
+ return sort { $a->subname cmp $b->subname } shift->subs_defined;
+}
=head2 sub_call_lines
@@ -235,23 +244,48 @@
}
-sub collapse_and_discard_evals {
- my $self = shift;
-
- for my $eval_fi (@_) {
- die "Can't rollup_and_discard_evals into non-parent"
- if $eval_fi->eval_fi != $self;
- # XXX check if parent has already been collapsed
+sub collapse_sibling_evals {
+ my ($self, $survivor, @donors) = @_;
+
+ die "Can't collapse_sibling_evals of non-sibling evals"
+ if grep { $_->eval_fid != $survivor->eval_fid or
+ $_->eval_line != $survivor->eval_line
+ } @donors;
+
+ my $s_ltd = $survivor->line_time_data; # XXX line only
+ my $s_fid = $survivor->line_time_data; # XXX line only
+
+ for my $donor_fi (@donors) {
+ # copy data from donor to survivor then delete donor
# XXX doesn't update model to edit details for
# subs defines, subs called, or evals etc.
- my $line_time_data = $self->line_time_data; # XXX line only
- my $tld = $line_time_data->[$eval_fi->eval_line] ||= [];
- $tld->[0] += $eval_fi->sum_of_stmts_time(1);
-
- $self->_delete_eval($eval_fi);
- $eval_fi->_nullify;
+ # XXX nested evals not handled yet
+ warn "collapse_sibling_evals: nested evals not handled"
+ if $donor_fi->has_evals;
+
+ # XXX subs defined not handled yet
+ warn "collapse_sibling_evals: subs defined not handled"
+ if $donor_fi->subs_defined;
+
+ if (my $sub_call_lines = $donor_fi->sub_call_lines) {
+
+ }
+
+ # copy line time data
+ my $d_ltd = $donor_fi->line_time_data; # XXX line only
+ for my $line (0...@$d_ltd-1) {
+ my $d_tld_l = $d_ltd->[$line] or next;
+ my $s_tld_l = $s_ltd->[$line] ||= [];
+ $s_tld_l->[$_] += $d_tld_l->[$_] for (0...@$d_tld_l-1);
+ warn sprintf "%d:%d: @$s_tld_l from @$d_tld_l fid:%d\n",
+ $survivor->fid, $line, $donor_fi->fid if 0;
+ }
+
+ push @{ $survivor->meta->{merged_fids} }, $donor_fi->fid;
+ $self->_delete_eval($donor_fi);
+ $donor_fi->_nullify;
}
}
@@ -358,10 +392,8 @@
printf $fh "%s[ %s ]\n", $prefix, join(" ", map { defined($_) ?
$_ : 'undef' } @values);
if (not $opts->{skip_internal_details}) {
- my $subs = $self->subs;
- for my $subname (sort keys %$subs) {
- my $si = $subs->{$subname};
-
+
+ for my $si ($self->subs_defined_sorted) {
printf $fh "%s%s%s%s%s%s-%s\n",
$prefix, 'sub', $separator,
$si->subname(' and '), $separator,
=======================================
--- /trunk/lib/Devel/NYTProf/Reader.pm Sun Apr 18 09:58:54 2010
+++ /trunk/lib/Devel/NYTProf/Reader.pm Mon Apr 19 03:06:11 2010
@@ -69,6 +69,7 @@
],
dataend => '',
footer => '',
+ merged_fids => '',
taintmsg => "# WARNING!\n"
. "# The source file used in generating this report has been
modified\n"
. "# since generating the profiler database. It might be out
of sync\n",
@@ -185,6 +186,12 @@
}
foreach my $fi (@all_fileinfos) {
+
+ # we only generate line-level reports for evals
+ # for efficiency and because some data model editing only
+ # is only implemented for line-level data
+ next if $fi->is_eval and $LEVEL ne 'line';
+
my $meta = $fi->meta;
my $filestr = $fi->filename;
warn "$filestr $LEVEL\n" if $trace;
@@ -289,7 +296,6 @@
# localize header and footer for variable replacement
my $header = $self->get_param('header', [$profile, $fi,
$fname, $LEVEL]);
- my $taintmsg = $self->get_param('taintmsg', [$profile, $fi]);
my $datastart = $self->get_param('datastart', [$profile, $fi]);
my $dataend = $self->get_param('dataend', [$profile, $fi]);
my $FILE = $filestr;
@@ -305,7 +311,11 @@
# If we don't have savesrc for the file then we'll be reading the
current
# file contents which may have changed since the profile was run.
# In this case we need to warn the user as the report would be
garbled.
- print OUT $taintmsg if !$fi->has_savesrc and
$self->file_has_been_modified($filestr);
+ print OUT $self->get_param('taintmsg', [$profile, $fi])
+ if !$fi->has_savesrc and
$self->file_has_been_modified($filestr);
+
+ print OUT $self->get_param('merged_fids', [$profile, $fi])
+ if $fi->meta->{merged_fids};
print OUT $datastart;
=======================================
--- /trunk/t/test09.p Wed Jul 2 09:09:18 2008
+++ /trunk/t/test09.p Mon Apr 19 03:06:11 2010
@@ -5,7 +5,7 @@
}
sub bar {
- eval "3;";
+ eval "1 while (1..10_000)";
}
foo();
=======================================
--- /trunk/t/test09.rdt Mon Apr 5 16:22:16 2010
+++ /trunk/t/test09.rdt Mon Apr 19 03:06:11 2010
@@ -25,8 +25,6 @@
fid_block_time 4 1 [ 0 1 ]
fid_block_time 4 2 [ 0 1 ]
fid_block_time 4 3 [ 0 1 ]
-fid_block_time 5 1 [ 0 1 ]
-fid_block_time 6 1 [ 0 1 ]
fid_fileinfo 1 [ test09.p 1 2 0 0 ]
fid_fileinfo 1 sub main::BEGIN 0-0
fid_fileinfo 1 sub main::RUNTIME 1-1
@@ -36,14 +34,12 @@
fid_fileinfo 1 call 12 main::foo [ 1 0 0 0 0 0 0
main::RUNTIME ]
fid_fileinfo 1 call 13 main::bar [ 1 0 0 0 0 0 0
main::RUNTIME ]
fid_fileinfo 1 eval 2 [ 2 0 ]
-fid_fileinfo 1 eval 8 [ 3 0 ]
+fid_fileinfo 1 eval 8 [ 1 0 ]
fid_fileinfo 2 [ (eval 0)[test09.p:2] 1 2 2 2 0 0 ]
fid_fileinfo 2 call 3 main::bar [ 1 0 0 0 0 0 0
main::foo ]
fid_fileinfo 3 [ (eval 0)[test09.p:8] 1 8 3 2 0 0 ]
fid_fileinfo 4 [ (eval 0)[test09.p:2] 1 2 4 2 0 0 ]
fid_fileinfo 4 call 3 main::bar [ 1 0 0 0 0 0 0
main::foo ]
-fid_fileinfo 5 [ (eval 0)[test09.p:8] 1 8 5 2 0 0 ]
-fid_fileinfo 6 [ (eval 0)[test09.p:8] 1 8 6 2 0 0 ]
fid_line_time 1 2 [ 0 2 ]
fid_line_time 1 8 [ 0 3 ]
fid_line_time 1 11 [ 0 1 ]
@@ -52,12 +48,10 @@
fid_line_time 2 1 [ 0 1 ]
fid_line_time 2 2 [ 0 1 ]
fid_line_time 2 3 [ 0 1 ]
-fid_line_time 3 1 [ 0 1 ]
+fid_line_time 3 1 [ 0 3 ]
fid_line_time 4 1 [ 0 1 ]
fid_line_time 4 2 [ 0 1 ]
fid_line_time 4 3 [ 0 1 ]
-fid_line_time 5 1 [ 0 1 ]
-fid_line_time 6 1 [ 0 1 ]
fid_sub_time 1 2 [ 0 2 ]
fid_sub_time 1 8 [ 0 3 ]
fid_sub_time 1 11 [ 0 1 ]
@@ -70,8 +64,6 @@
fid_sub_time 4 1 [ 0 1 ]
fid_sub_time 4 2 [ 0 1 ]
fid_sub_time 4 3 [ 0 1 ]
-fid_sub_time 5 1 [ 0 1 ]
-fid_sub_time 6 1 [ 0 1 ]
profile_modes fid_block_time block
profile_modes fid_line_time line
profile_modes fid_sub_time sub
=======================================
--- /trunk/t/test09.x Wed Jul 9 12:54:59 2008
+++ /trunk/t/test09.x Mon Apr 19 03:06:11 2010
@@ -8,7 +8,7 @@
0,0,0,}
0,0,0,
0,0,0,sub bar {
-0,3,0,eval "3;";
+0,3,0,eval "1 while (1..10_000)";
0,0,0,}
0,0,0,
0,1,0,foo();
--
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]
