Author: tim.bunce
Date: Thu Oct 16 05:51:04 2008
New Revision: 515
Modified:
trunk/Changes
trunk/bin/nytprofhtml
trunk/lib/Devel/NYTProf/Reader.pm
trunk/lib/Devel/NYTProf/Util.pm
Log:
No longer ignore files that don't have any perl statements profiled
but do have profiled xsubs. Fixes warnings about XSLoader.pm, for example.
Href for xsubs uses name of xsub as anchor (not used yet).
Modified: trunk/Changes
==============================================================================
--- trunk/Changes (original)
+++ trunk/Changes Thu Oct 16 05:51:04 2008
@@ -16,9 +16,10 @@
now recorded separately, along with the max recursion depth.
XS subs are now automatically associated with a source file that
- defines non-xsubs in the same package as the xsub.
+ defines normal subs in the same package.
- Global subroutine index pages no longer list subs that were never called.
+ The html global subroutine index pages no longer list subs that
+ were never called.
Removed use of vfscanf() to improve portability,
thanks to Jan Dubois.
Modified: trunk/bin/nytprofhtml
==============================================================================
--- trunk/bin/nytprofhtml (original)
+++ trunk/bin/nytprofhtml Thu Oct 16 05:51:04 2008
@@ -193,9 +193,11 @@
my ($pkg, $subr) = ($subname =~ /^(.*::)(.*?)$/) ? ($1, $2) : ('',
$subname);
$sub_links .= sprintf qq{<td class="sub_pkg">%s</td>}, $pkg;
- # remove own filename from eg __ANON__[(eval
3)[/long/path/name.pm:99]:53]
- # XXX doesn't work right because $filestr isn't full filename
+ # remove OWN filename from eg __ANON__[(eval
3)[/long/path/name.pm:99]:53]
+ # becomes __ANON__[(eval 3)[:99]:53]
+ # XXX doesn't always work right because $filestr isn't full
filename
$subr =~ s/\Q$filestr\E:(\d+)/:$1/g;
+ # remove @INC prefix from other paths
$subr =~ s/$inc_path_regex//; # for __ANON__[/very/long/path...]
my $first_line = $sub->first_line;
Modified: trunk/lib/Devel/NYTProf/Reader.pm
==============================================================================
--- trunk/lib/Devel/NYTProf/Reader.pm (original)
+++ trunk/lib/Devel/NYTProf/Reader.pm Thu Oct 16 05:51:04 2008
@@ -142,8 +142,7 @@
# (because the main use for .pmc's are related to perl6)
$filename .= "c" if $fid_fileinfo->[$fid]->is_pmc;
- my $lines_array = $fid_line_data->[$fid]
- or next; # ignore fid's with no lines executed
+ my $lines_array = $fid_line_data->[$fid] || [];
# convert any embedded eval line time arrays to hashes
for (@$lines_array) {
@@ -309,11 +308,13 @@
my %totalsAccum; # holds all line times. used to find
median
my %totalsByLine; # holds individual line stats
- my $runningTotalTime; # holds the running total
+ my $runningTotalTime = 0; # holds the running total
# (should equal sum of $totalsAccum)
- my $runningTotalCalls; # holds the running total number of
calls.
+ my $runningTotalCalls = 0; # holds the running total number of
calls.
+ # note that a file may have no source lines executed, so no keys
here
+ # (but is included because some xsubs in the package were executed)
foreach my $key (keys %{$data->{$filestr}}) {
my $a = $data->{$filestr}->{$key};
@@ -351,16 +352,15 @@
$self->{filestats}->{$filestr}->{'time'} = $runningTotalTime;
$self->{filestats}->{$filestr}->{'calls'} = $runningTotalCalls;
- $self->{filestats}->{$filestr}->{'time/call'} = eval {
$runningTotalTime / $runningTotalCalls };
- warn "Um, that's odd, the count of executed statements is zero
for '$filestr'\n"
- unless $runningTotalCalls;
+ $self->{filestats}->{$filestr}->{'time/call'} =
+ ($runningTotalCalls) ? $runningTotalTime / $runningTotalCalls:
0;
# Use Median Absolute Deviation Formula to get file deviations for
each of
# calls, time and time/call values
my %statistics = (
- 'calls' =>
calculate_median_absolute_deviation($totalsAccum{'calls'}),
- 'time' =>
calculate_median_absolute_deviation($totalsAccum{'time'}),
- 'time/call' =>
calculate_median_absolute_deviation($totalsAccum{'time/call'}),
+ 'calls' =>
calculate_median_absolute_deviation($totalsAccum{'calls'}||[]),
+ 'time' =>
calculate_median_absolute_deviation($totalsAccum{'time'}||[]),
+ 'time/call' =>
calculate_median_absolute_deviation($totalsAccum{'time/call'}||[]),
);
my $line_calls_hash = $profile->line_calls_for_file($filestr);
@@ -498,10 +498,16 @@
my ($file, $fid, $first, $last) =
$self->{profile}->file_line_range_of_sub($sub);
if (!$first) {
- return "" if defined $first; # is xs (first and least are 0)
- warn("No file line range data for sub '$sub'\n")
- unless our $href_for_sub_no_data_warn->{$sub}++; # warn
just once
- return "";
+ if (not defined $first) {
+ warn("No file line range data for sub '$sub'\n")
+ unless our $href_for_sub_no_data_warn->{$sub}++; # warn
just once
+ return "";
+ }
+ # probably xsub
+ # return no link if we don't have a file for this xsub
+ return "" unless $file;
+ # use sanitized subname as label
+ ($first = $sub) =~ s/\W/_/g;
}
my $stats = $self->get_file_stats(); # may be undef
Modified: trunk/lib/Devel/NYTProf/Util.pm
==============================================================================
--- trunk/lib/Devel/NYTProf/Util.pm (original)
+++ trunk/lib/Devel/NYTProf/Util.pm Thu Oct 16 05:51:04 2008
@@ -163,6 +163,7 @@
sub calculate_median_absolute_deviation {
my $values_ref = shift;
my ($ignore_zeros) = @_;
+ croak "No array ref given" unless ref $values_ref eq 'ARRAY';
my @values = ($ignore_zeros) ? grep {$_} @$values_ref : @$values_ref;
my $median_value = [sort { $a <=> $b } @values]->[EMAIL PROTECTED] / 2];
--~--~---------~--~----~------------~-------~--~----~
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]
-~----------~----~----~----~------~----~------~--~---
