Revision: 1201
Author: [email protected]
Date: Mon Apr 26 05:45:51 2010
Log: Added docs and tests for string eval collapsing.
Assorted related code polishing.
http://code.google.com/p/perl-devel-nytprof/source/detail?r=1201
Added:
/trunk/t/test24-strevalc.p
/trunk/t/test24-strevalc.rdt
/trunk/t/test24-strevalc.t
Modified:
/trunk/MANIFEST
/trunk/bin/nytprofhtml
/trunk/lib/Devel/NYTProf/Data.pm
/trunk/lib/Devel/NYTProf/FileInfo.pm
/trunk/lib/Devel/NYTProf.pm
=======================================
--- /dev/null
+++ /trunk/t/test24-strevalc.p Mon Apr 26 05:45:51 2010
@@ -0,0 +1,7 @@
+# test 'collapsing' of string evals
+my @src = (
+ (("1") x 2),
+ (("eval '1'") x 2),
+ (("sub { 1 }->()") x 2),
+);
+eval $_ for @src;
=======================================
--- /dev/null
+++ /trunk/t/test24-strevalc.rdt Mon Apr 26 05:45:51 2010
@@ -0,0 +1,61 @@
+attribute application test24-strevalc.p
+attribute basetime 0
+attribute clock_id 0
+attribute complete 1
+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 0
+attribute xs_version 0
+fid_block_time 1 2 [ 0 1 ]
+fid_block_time 1 7 [ 0 2 ]
+fid_block_time 2 1 [ 0 1 ]
+fid_block_time 4 1 [ 0 1 ]
+fid_block_time 5 1 [ 0 1 ]
+fid_block_time 6 1 [ 0 1 ]
+fid_block_time 7 1 [ 0 1 ]
+fid_block_time 8 2 [ 0 1 ]
+fid_block_time 9 2 [ 0 1 ]
+fid_fileinfo 1 [ test24-strevalc.p 1 2 0 0 ]
+fid_fileinfo 1 sub main::BEGIN 0-0
+fid_fileinfo 1 eval 7 [ count 5 nested 2 merged 1 ]
+fid_fileinfo 2 [ (eval 0)[test24-strevalc.p:7] 1 7 2 2 0 0 ]
+fid_fileinfo 4 [ (eval 0)[test24-strevalc.p:7] 1 7 4 2 0 0 ]
+fid_fileinfo 4 eval 1 [ count 1 nested 0 merged 0 ]
+fid_fileinfo 5 [ (eval 0)[(eval 0)[test24-strevalc.p:7]:1] 4 1 5 2 0 0
]
+fid_fileinfo 6 [ (eval 0)[test24-strevalc.p:7] 1 7 6 2 0 0 ]
+fid_fileinfo 6 eval 1 [ count 1 nested 0 merged 0 ]
+fid_fileinfo 7 [ (eval 0)[(eval 0)[test24-strevalc.p:7]:1] 6 1 7 2 0 0
]
+fid_fileinfo 8 [ (eval 0)[test24-strevalc.p:7] 1 7 8 2 0 0 ]
+fid_fileinfo 8 sub main::__ANON__[(eval 0)[test24-strevalc.p:7]:1]
1-1
+fid_fileinfo 9 [ (eval 0)[test24-strevalc.p:7] 1 7 9 2 0 0 ]
+fid_fileinfo 9 sub main::__ANON__[(eval 0)[test24-strevalc.p:7]:1]
1-1
+fid_line_time 1 2 [ 0 1 ]
+fid_line_time 1 7 [ 0 2 ]
+fid_line_time 2 1 [ 0 2 ]
+fid_line_time 4 1 [ 0 1 ]
+fid_line_time 5 1 [ 0 1 ]
+fid_line_time 6 1 [ 0 1 ]
+fid_line_time 7 1 [ 0 1 ]
+fid_line_time 8 2 [ 0 1 ]
+fid_line_time 9 2 [ 0 1 ]
+fid_sub_time 1 2 [ 0 1 ]
+fid_sub_time 1 7 [ 0 2 ]
+fid_sub_time 2 1 [ 0 1 ]
+fid_sub_time 4 1 [ 0 1 ]
+fid_sub_time 5 1 [ 0 1 ]
+fid_sub_time 6 1 [ 0 1 ]
+fid_sub_time 7 1 [ 0 1 ]
+fid_sub_time 8 2 [ 0 1 ]
+fid_sub_time 9 2 [ 0 1 ]
+profile_modes fid_block_time block
+profile_modes fid_line_time line
+profile_modes fid_sub_time sub
+sub_subinfo main::BEGIN [ 1 0 0 0 0 0 0 0 ]
+sub_subinfo main::__ANON__[(eval 0)[test24-strevalc.p:7]:1] [ 8 1 1 0 0 0
0 0 ]
=======================================
--- /dev/null
+++ /trunk/t/test24-strevalc.t Mon Apr 26 05:45:51 2010
@@ -0,0 +1,6 @@
+use strict;
+use Test::More;
+use lib qw(t/lib);
+use NYTProfTest;
+
+run_test_group;
=======================================
--- /trunk/MANIFEST Thu Mar 11 09:06:47 2010
+++ /trunk/MANIFEST Mon Apr 26 05:45:51 2010
@@ -147,6 +147,9 @@
t/test23-strevall.p
t/test23-strevall.rdt
t/test23-strevall.t
+t/test24-strevalc.p
+t/test24-strevalc.rdt
+t/test24-strevalc.t
t/test30-fork-0.p
t/test30-fork-0.rdt
t/test30-fork-0.t
=======================================
--- /trunk/bin/nytprofhtml Mon Apr 26 02:54:48 2010
+++ /trunk/bin/nytprofhtml Mon Apr 26 05:45:51 2010
@@ -58,10 +58,10 @@
'help|h' => sub { exit usage() },
'profself!' => sub {
# profile nytprofhtml itself
- my $profself = "nytprof-nytprofhtml.out";
+ our $profself = "nytprof-nytprofhtml.out";
$ENV{NYTPROF} .= ":file=$profself";
require Devel::NYTProf;
- END { warn "Profile of $0 written to $profself\n" if $profself; }
+ END { warn "Profile of $0 written to $profself\n" if our
$profself; }
},
) or do { exit usage(); };
@@ -171,12 +171,17 @@
sub {
my ($profile, $fi) = @_;
my $merged_fids = $fi->meta->{merged_fids};
- return sprintf qq{<div class="warn_title">NOTE!</div>\n
+ my $extra = '';
+ $extra = qq{
+ The source code shown below is the text of just one of the
calls to the eval.<br />\n
+ This report page might not make much sense because the
argument source code of those eval calls varied.<br />\n
+ } if $fi->meta->{merged_fids_src_varied};
+
+ return sprintf qq{<br /><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 />
- The source code shown below is the text of just one of the
calls to the eval.<br />\n
- If the argument source code of those eval calls varied then
this page might not make much sense.</div><br />\n
- }, 1+scalar @$merged_fids, $fi->eval_line, $fi->eval_fi->filename;
+ %s</div>
+ }, 1+scalar @$merged_fids, $fi->eval_line, $fi->eval_fi->filename,
$extra;
},
);
@@ -187,15 +192,16 @@
}
sub subroutine_table {
- my ($profile, $filestr, $max_subs, $sortby) = @_;
+ my ($profile, $fi, $max_subs, $sortby) = @_;
$sortby ||= 'excl_time';
- my $subs_in_file = ($filestr)
- ? $profile->subs_defined_in_file($filestr, 0)
+ my $subs_in_file = ($fi)
+ ? $profile->subs_defined_in_file($fi, 0)
: $profile->subname_subinfo_map;
return "" unless $subs_in_file && %$subs_in_file;
my $inc_path_regex = get_abs_paths_alternation_regex([$profile->inc],
qr/^|\[/);
+ my $filestr = ($fi) ? $fi->filename : undef;
# XXX slow - use Schwartzian transform or via XS or Sort::Key
my @subs =
@@ -203,7 +209,7 @@
values %$subs_in_file;
# in the overall summary, don't show subs that were never called
- @subs = grep { $_->calls > 0 } @subs if !$filestr;
+ @subs = grep { $_->calls > 0 } @subs if !$fi;
my $dev_incl_time = calc_mad_from_objects(\...@subs, 'incl_time', 1);
my $dev_excl_time = calc_mad_from_objects(\...@subs, 'excl_time', 1);
@@ -266,7 +272,7 @@
# remove OWN filename from eg __ANON__[(eval
3)[/long/path/name.pm:99]:53]
# becomes __ANON__[(eval 3)[:99]:53]
# XXX doesn't work right if $filestr isn't full filename
- $subr =~ s/\Q$filestr\E:(\d+)/:$1/g;
+ $subr =~ s/\Q$filestr\E:(\d+)/:$1/g if $filestr;
# remove @INC prefix from other paths
$subr =~ s/$inc_path_regex//; # for __ANON__[/very/long/path...]
@@ -311,7 +317,7 @@
my ($profile, $fi) = @_;
my $filestr = $fi->filename;
- my $sub_table = subroutine_table($profile, $filestr, undef, undef);
+ my $sub_table = subroutine_table($profile, $fi, undef, undef);
if ($sub_table) {
my $dot_file = html_safe_filename($filestr) . ".dot";
@@ -525,7 +531,7 @@
$ws ||= ($linesrc =~ m/^((?: |\s)+)/) ? $1 : '';
my @eval_fis = sort {
- $b->sum_of_stmts_time <=> $a->sum_of_stmts_time or
+ $b->sum_of_stmts_time(1) <=> $a->sum_of_stmts_time(1) or
$a->filename cmp $b->filename
} values %$evals_called;
@@ -537,7 +543,7 @@
my $merged_fids = $eval_fi->meta->{merged_fids};
if ($merged_fids) {
$extra .= sprintf " (data for these has been merged)";
- $what .= "s";
+ $what = sprintf "%d string evals", 1+scalar @$merged_fids;
}
my @nested_evals = $eval_fi->has_evals(1);
@@ -553,17 +559,16 @@
if (my @subs_defined = $eval_fi->subs_defined(1)) {
my $sub_count = @subs_defined;
my $call_count = sum map { $_->calls } @subs_defined;
- $extra .= sprintf ". Times include %d call%s to %d sub%s
defined herein.",
+ $extra .= sprintf ", times include %d call%s to %d sub%s
defined herein",
$call_count, ($call_count != 1) ? 's' : '',
$sub_count, ($sub_count != 1) ? 's' : ''
if $call_count;
}
my $link = sprintf(q{<a %s>%s</a>},
$reporter->href_for_file($eval_fi), $what);
- my $html = sprintf qq{%s# spent %s executing statements
in %s%s%s},
+ my $html = sprintf qq{%s# spent %s executing statements
in %s%s},
$ws, fmt_time($sum_of_stmts_time+$nest_eval_time, 5),
- ($merged_fids) ? sprintf("%d ",1+scalar
@$merged_fids) : '', $link,
- $extra;
+ $link, $extra;
$html;
} @eval_fis;
@@ -610,7 +615,7 @@
print $fh qq{<div class="body_content"><br />};
# Show top subs across all files
- print $fh subroutine_table($profile, 0, 0, $sortby);
+ print $fh subroutine_table($profile, undef, 0, $sortby);
my $footer = get_footer($profile);
print $fh "</div>$footer</body></html>";
@@ -665,7 +670,7 @@
# Show top subs across all files
my $max_subs = 15; # keep it less than a page so users can see the
file table
my $all_subs = keys %{$profile->{sub_subinfo}};
- print $fh subroutine_table($profile, 0, $max_subs, undef);
+ print $fh subroutine_table($profile, undef, $max_subs, undef);
if ($all_subs > $max_subs) {
print $fh sprintf qq{<div class="table_footer">
See <a href="%s">all %d subroutines</a>
=======================================
--- /trunk/lib/Devel/NYTProf/Data.pm Mon Apr 26 02:54:48 2010
+++ /trunk/lib/Devel/NYTProf/Data.pm Mon Apr 26 05:45:51 2010
@@ -134,48 +134,50 @@
next if @$siblings == 1;
- my @subs = map { $_->subs_defined } @$siblings;
- my @calls = map { keys %{ $_->sub_call_lines } } @$siblings;
- my @evals = map { $_->has_evals(0) } @$siblings;
- my $msg = sprintf "%d:%d: multiple evals (subs %d, calls %d,
evals %d, fids: %s)",
- $parent_fid, $line, scalar @subs, scalar @calls, scalar
@evals,
- join(", ", map { $_->fid } @$siblings);
- warn "$msg\n" if $trace >= 3;
-
- next if @subs; # ignore if the eval defines subs
- next if @evals; # ignore if the eval has nested evals
-
# compare src code of evals and collapse identical ones
- my %src_same;
+ my %src_keyed;
for my $fi (@$siblings) {
- my $srclines_array = $fi->srclines_array || [];
- my $src = join "\n", @$srclines_array;
- my $key = join ",", # XXX just a basic key
- scalar @$srclines_array, # number of lines
- length $src, # total length
- unpack("%32C*",$src); # 32-bit checksum
- push @{$src_same{$key}}, $fi;
+ my $key = $fi->src_digest;
+ # include extra info to segregate (especially when there's no
src)
+ $key .= ',evals' if $fi->has_evals;
+ $key .= ',subs' if $fi->subs_defined;
+ push @{$src_keyed{$key}}, $fi;
}
- warn sprintf "%s COLLAPSING (%d evals with %d distinct srcs)\n",
- $msg, scalar @$siblings, scalar keys %src_same
- if $trace >= 1;
-
- # if not 'too many' distinct eval source strings then collapse
- # the evals for each distinct source string
- if (values %src_same < 100) {
-
- for my $src_same_fis (values %src_same) {
- next if @$src_same_fis == 1; # unique src code
- warn "Collapsing identical evals: @{[ map { $_->fid }
@$src_same_fis ]}\n"
- if $trace >= 3;
- my $fi =
$parent_fi->collapse_sibling_evals(@$src_same_fis);
- @$src_same_fis = ( $fi ); # update list in-place
+ if ($trace >= 1) {
+ my @subs = map { $_->subs_defined } @$siblings;
+ my @evals = map { $_->has_evals(0) } @$siblings;
+ warn sprintf "%d:%d: sibling evals (subs %d, evals %d,
keys %d, fids: %s)",
+ $parent_fid, $line, scalar @subs, scalar @evals,
+ scalar keys %src_keyed,
+ join(", ", map { $_->fid } @$siblings);
+ }
+
+ # if 'too many' distinct eval source keys then simply collapse all
+ my $max_evals_siblings = $ENV{NYTPROF_MAX_EVAL_SIBLINGS} || 200;
+ if (values %src_keyed > $max_evals_siblings) {
+ $parent_fi->collapse_sibling_evals(@$siblings);
+ }
+ else {
+ # finnese: consider each distinct src in turn
+
+ while ( my ($key, $src_same_fis) = each %src_keyed ) {
+ next if @$src_same_fis == 1; # unique src key
+ my @fids = map { $_->fid } @$src_same_fis;
+
+ if (grep { $_->subs_defined } @$src_same_fis) {
+ warn "evals($key): collapsing skipped due to subs:
@fids\n" if $trace >= 3;
+ }
+ elsif (grep { $_->has_evals(0) } @$src_same_fis) {
+ warn "evals($key): collapsing skipped due to evals:
@fids\n" if $trace >= 3;
+ }
+ else {
+ warn "evals($key): collapsing identical: @fids\n" if
$trace >= 3;
+ my $fi =
$parent_fi->collapse_sibling_evals(@$src_same_fis);
+ @$src_same_fis = ( $fi ); # update list in-place
+ }
}
}
- else {
- $parent_fi->collapse_sibling_evals(@$siblings);
- }
}
}
@@ -190,28 +192,6 @@
return { %{ shift->{sub_subinfo} } }; # shallow copy
}
-# { pkgname => [ subinfo1, subinfo2, ... ], ... }
-# if merged is true then array contains a single 'merged' subinfo
-sub XXXpackage_subinfo_map {
- my $self = shift;
- my ($merged_subs, $nested_pkgs) = @_;
-
- my $all_subs = $self->subname_subinfo_map;
- my %pkg;
- while ( my ($name, $subinfo) = each %$all_subs ) {
- $name =~ s/^(.*::).*/$1/; # XXX $subinfo->package
- push @{ $pkg{$name} }, $subinfo;
- }
- if ($merged_subs) {
- while ( my ($pkg_name, $subinfos) = each %pkg ) {
- my $subinfo = shift(@$subinfos)->clone;
- $subinfo->merge_in($_) for @$subinfos;
- # replace the many with the one
- @$subinfos = ($subinfo);
- }
- }
- return \%pkg;
-}
# package_tree_subinfo_map is like package_subinfo_map but returns
# nested data instead of flattened.
@@ -642,7 +622,11 @@
sub subs_defined_in_file {
my ($self, $fid, $incl_lines) = @_;
- $fid = $self->resolve_fid($fid);
+
+ my $fi = $self->fileinfo_of($fid)
+ or return;
+
+ $fid = $fi->fid;
$incl_lines ||= 0;
$incl_lines = 0 if $fid == 0;
my $caches = $self->_caches;
@@ -650,8 +634,6 @@
my $cache_key = "subs_defined_in_file:$fid:$incl_lines";
return $caches->{$cache_key} if $caches->{$cache_key};
- my $fi = $self->fileinfo_of($fid)
- or return;
my %subs = map { $_->subname => $_ } $fi->subs_defined;
if ($incl_lines) { # add in the first-line-number keys
=======================================
--- /trunk/lib/Devel/NYTProf/FileInfo.pm Mon Apr 26 02:54:48 2010
+++ /trunk/lib/Devel/NYTProf/FileInfo.pm Mon Apr 26 05:45:51 2010
@@ -315,6 +315,9 @@
}
push @{ $survivor->meta->{merged_fids} }, $donor_fi->fid;
+ ++$survivor->meta->{merged_fids_src_varied}
+ if $donor_fi->src_digest ne $survivor->src_digest;
+
$self->_delete_eval($donor_fi);
$donor_fi->_nullify;
}
@@ -380,12 +383,25 @@
}
if ($self->flags & NYTP_FIDf_IS_FAKE) {
- my $fid = $self->fid;
- return [ "# fid$fid: NYTP_FIDf_IS_FAKE - e.g., unknown caller of
an eval.\n" ];
+ return [ "# NYTP_FIDf_IS_FAKE - e.g., unknown caller of an
eval.\n" ];
}
return undef;
}
+
+sub src_digest {
+ my $self = shift;
+ return $self->cache->{src_digest} ||= do {
+ my $srclines_array = $self->srclines_array || [];
+ my $src = join "\n", @$srclines_array;
+ my @key = (
+ scalar @$srclines_array, # number of lines
+ length $src, # total length
+ unpack("%32C*",$src), # 32-bit checksum
+ );
+ join ",", @key;
+ };
+}
sub normalize_for_test {
=======================================
--- /trunk/lib/Devel/NYTProf.pm Thu Apr 22 03:23:05 2010
+++ /trunk/lib/Devel/NYTProf.pm Mon Apr 26 05:45:51 2010
@@ -107,7 +107,7 @@
=item *
-Sub-microsecond (100ns) resolution on systems with clock_gettime()
+Sub-microsecond (100ns) resolution on supported systems
=item *
@@ -129,6 +129,10 @@
Generates richly annotated and cross-linked html reports
+=item *
+
+Captures source code, including string evals, for stable results
+
=item *
Trivial to use with mod_perl - add one line to httpd.conf
@@ -599,6 +603,66 @@
statement and the condition clause of some kinds of loops:
L<http://rt.perl.org/rt3/Ticket/Display.html?id=60954>
+=head2 eval $string
+
+Perl treats each execution of a string eval (C<eval $string;> not C<eval
{ ... }>)
+as a distinct file, so NYTProf does as well. The 'files' are given names
with
+this structure:
+
+ (eval $sequence)[$filename:$line]
+
+for example "C<(eval 93)[/foo/bar.pm:42]>" would be the name given to the
+93rd execution of a string eval by that process and, in this case, the 93rd
+eval happened to be one at line 42 of "/foo/bar.pm".
+
+Nested string evals can give rise to file names like
+
+ (eval 1047)[(eval 93)[/foo/bar.pm:42]:17]
+
+NYTProf currently edits the string eval names to 'normalize' the eval
sequence
+number to 0. This may change in future.
+
+=head3 Collapsing
+
+Some applications execute a great many string eval statements. If NYTProf
generated
+a report page for each one it would not only slow report generation but
also
+make the overall report less useful by scattering performance data too
widely.
+On the other hand, being able to see the actual source code executed by an
+eval, along with the timing details, is often very useful.
+
+To try to balance these conflicting needs, NYTProf currently I<collapses
+uninteresting string eval siblings>.
+
+What does that mean? Well, for each source code line that executed any
string
+evals NYTProf first gathers the corresponding eval 'files' (the siblings)
into groups.
+Lines containing a string eval statement that only executes once aren't
affected.
+The groups are keyed by source code (if available) and whether any
subroutines
+were defined or any nested string evals were executed.
+
+Then, for each of those groups of siblings, NYTProf will 'collapse' a group
+that shares the same source code and doesn't define any subs or execute any
+string evals. Collapsing means to pick one sibling as the survivor and
merge
+and delete all the data from the others into it.
+
+If there are a large number of sibling groups then the data for all of
them are
+collapsed into one regardless.
+
+The report annotations will indicate when evals have been collapsed
together.
+
+=head3 Timing
+
+Care should be taken when interpreting the report annotations associated
with a
+string eval statement. Normally the report annotations embedded into the
+source code related to timings from the I<subroutine> profiler. This isn't
+(currently) true of annotations for string eval statements. This makes a
+significant different if the eval defines any subroutines that get called
I<after>
+the eval has returned. Because the time shown for a string eval is based
on the
+I<statement> times it will include time spent executing statements within
the
+subs defined by the eval.
+
+In future NYTProf may involve the subroutine profiler in timings evals and
so
+be able to avoid this issue.
+
=head2 Calls from XSUBs and Opcodes
Calls record the current filename and line number of the perl code at the
time
--
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]
