Revision: 1252
Author: [email protected]
Date: Sun May 30 01:17:44 2010
Log: Move subs that were called but have no filename (eg xsubs in packages
that
don't have any profiled perl code) and assign them to fid 1 (typically the
main script).
http://code.google.com/p/perl-devel-nytprof/source/detail?r=1252
Modified:
/trunk/Changes
/trunk/NYTProf.xs
/trunk/demo/demo-code.pl
/trunk/lib/Devel/NYTProf/Data.pm
/trunk/lib/Devel/NYTProf/FileInfo.pm
/trunk/lib/Devel/NYTProf/SubInfo.pm
/trunk/t/44-model.t
/trunk/t/test13.rdt
/trunk/t/test50-disable.rdt
/trunk/t/test51-enable.rdt
/trunk/t/test62-subcaller1.rdt
=======================================
--- /trunk/Changes Thu May 27 06:24:46 2010
+++ /trunk/Changes Sun May 30 01:17:44 2010
@@ -26,8 +26,11 @@
Improved many sub-optimal behaviours related to string evals.
- Profile data that couldn't be associated with a specific line,
- such as calls made by perl to END blocks, is now shown in reports.
+ Subroutine calls that couldn't be associated with a specific line,
+ such as calls made by perl to END blocks, are now shown in reports.
+
+ Subroutine definitions that couldn't be associated with a specific file,
+ such as xsubs in packages with no perl source, are now shown in
reports.
Enabled savesrc=1 by default.
=======================================
--- /trunk/NYTProf.xs Fri May 28 02:46:39 2010
+++ /trunk/NYTProf.xs Sun May 30 01:17:44 2010
@@ -3568,6 +3568,7 @@
/* 0: fid - may be undef
* 1: start_line - may be undef if not known and not known to be xs
* 2: end_line - ditto
+ * typically due to an xsub that was called but exited via an
exception
*/
sv_setsv(*av_fetch(av, NYTP_SIi_SUB_NAME, 1),
newSVsv(subname_sv));
sv_setuv(*av_fetch(av, NYTP_SIi_CALL_COUNT, 1), 0); /* call
count */
=======================================
--- /trunk/demo/demo-code.pl Sun Dec 20 15:44:19 2009
+++ /trunk/demo/demo-code.pl Sun May 30 01:17:44 2010
@@ -1,4 +1,4 @@
-use strict;
+use strict 0.1; # use UNIVERSAL::VERSION
use Benchmark;
use File::Find;
=======================================
--- /trunk/lib/Devel/NYTProf/Data.pm Wed May 26 15:11:43 2010
+++ /trunk/lib/Devel/NYTProf/Data.pm Sun May 30 01:17:44 2010
@@ -91,8 +91,6 @@
my $fid_fileinfo = $profile->{fid_fileinfo};
my $sub_subinfo = $profile->{sub_subinfo};
- #warn _dumper($profile);
-
# add profile ref so fidinfo & subinfo objects
# XXX circular ref, add weaken
$_ and $_->[7] = $profile for @$fid_fileinfo;
@@ -102,6 +100,17 @@
(my $sub_class = $class) =~ s/\w+$/SubInfo/;
$_ and bless $_ => $sub_class for values %$sub_subinfo;
+
+ # find called subs that have no file for
+ my @homeless_subs = grep { $_->calls and not $_->fid }
values %$sub_subinfo;
+ if (@homeless_subs) { # give them a home...
+ # currently just the first existing fileinfo
+ # XXX ought to create a new dummy fileinfo for them
+ my $new_fi = $profile->fileinfo_of(1);
+ $_->alter_fileinfo(undef, $new_fi) for @homeless_subs;
+ }
+
+
# Where a given eval() has been invoked more than once
# rollup the corresponding fids if they're "uninteresting".
for my $fi ($profile->noneval_fileinfos) {
@@ -664,10 +673,10 @@
=head2 file_line_range_of_sub
- ($file, $fid, $first, $last) =
$profile->file_line_range_of_sub("main::foo");
-
-Returns the filename, fid, and first and last line numbers for the
specified
-subroutine (which must be fully qualified with a package name).
+ ($file, $fid, $first, $last, $fi) =
$profile->file_line_range_of_sub("main::foo");
+
+Returns the filename, fid, and first and last line numbers, and fileinfo
object
+for the specified subroutine (which must be fully qualified with a package
name).
Returns an empty list if the subroutine name is not in the profile data.
@@ -675,12 +684,11 @@
The $file returned is the source file that defined the subroutine.
-Where is a subroutine is defined within a string eval, for example, the fid
-will be the pseudo-fid for the eval, and the $file will be the filename
that
-executed the eval.
-
-Subroutines that are implemented in XS have a line range of 0,0 and
currently
-don't have an associated file.
+Subroutines that are implemented in XS have a line range of 0,0 and a
possibly
+unknown file (if NYTProf couldn't find a good match based on the package
name).
+
+Subroutines that were called but only returned via an exception may have a
line
+range of undef,undef if they're xsubs or were defined before NYTProf was
enabled.
=cut
=======================================
--- /trunk/lib/Devel/NYTProf/FileInfo.pm Wed May 26 15:11:43 2010
+++ /trunk/lib/Devel/NYTProf/FileInfo.pm Sun May 30 01:17:44 2010
@@ -24,6 +24,8 @@
NYTP_FIDi_cache => NYTP_FIDi_elements + 2,
};
+my $trace = (($ENV{NYTPROF}||'') =~ m/\b trace=(\d+) /x) && $1; # XXX a
hack
+
sub filename { shift->[NYTP_FIDi_FILENAME()] }
sub eval_fid { shift->[NYTP_FIDi_EVAL_FID()] }
sub eval_line { shift->[NYTP_FIDi_EVAL_LINE()] }
@@ -102,6 +104,16 @@
my ($self, $incl_nested_evals) = @_;
return sort { $a->subname cmp $b->subname }
$self->subs_defined($incl_nested_evals);
}
+
+sub _remove_sub_defined {
+ my ($self, $subinfo) = @_;
+ delete $self->[NYTP_FIDi_SUBS_DEFINED()]->{$subinfo->subname};
+}
+
+sub _add_new_sub_defined {
+ my ($self, $subinfo) = @_;
+ $self->[NYTP_FIDi_SUBS_DEFINED()]->{$subinfo->subname} = $subinfo
+}
=head2 sub_call_lines
=======================================
--- /trunk/lib/Devel/NYTProf/SubInfo.pm Mon May 3 13:49:06 2010
+++ /trunk/lib/Devel/NYTProf/SubInfo.pm Sun May 30 01:17:44 2010
@@ -17,7 +17,9 @@
NYTP_SCi_CALLING_SUB
);
-sub fid { $_[0]->[NYTP_SIi_FID] || croak "No fid for $_[0][6]" }
+my $trace = (($ENV{NYTPROF}||'') =~ m/\b trace=(\d+) /x) && $1; # XXX a
hack
+
+sub fid { shift->[NYTP_SIi_FID] || 0 }
sub first_line { shift->[NYTP_SIi_FIRST_LINE] }
@@ -136,8 +138,12 @@
sub alter_fileinfo {
my ($self, $remove_fi, $new_fi) = @_;
- my $remove_fid = $remove_fi->fid;
- my $new_fid = $new_fi->fid;
+ my $remove_fid = ($remove_fi) ? $remove_fi->fid : 0;
+ my $new_fid = ( $new_fi) ? $new_fi->fid : 0;
+
+ warn sprintf "Altering fileinfo of %s from %d to %d\n",
+ $self->subname, $remove_fid, $new_fid
+ if $trace;
# remove mentions of $remove_fid from called-by details
# { fid => { line => [ count, incl, excl, ... ] } }
@@ -157,6 +163,14 @@
}
}
}
+
+ if ($self->fid == $remove_fid) {
+ $self->[NYTP_SIi_FID] = $new_fid;
+ }
+
+ if ($remove_fi and $remove_fi->_remove_sub_defined($self)) {
+ $new_fi->_add_new_sub_defined($self);
+ }
}
@@ -187,7 +201,6 @@
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
=======================================
--- /trunk/t/44-model.t Thu Mar 11 03:02:29 2010
+++ /trunk/t/44-model.t Sun May 30 01:17:44 2010
@@ -26,9 +26,8 @@
isa_ok $profile, 'Devel::NYTProf::Data';
my $subs = $profile->subname_subinfo_map;
- my @tmp;
- @tmp = $profile->file_line_range_of_sub("UNIVERSAL::VERSION");
- is @tmp, 0, 'UNIVERSAL::VERSION should have no known file or line
range';
+ my ($filename, $fid, $first, $last) =
$profile->file_line_range_of_sub("UNIVERSAL::VERSION");
+ is "$first-$last", "0-0", 'UNIVERSAL::VERSION line range';
},
});
=======================================
--- /trunk/t/test13.rdt Wed Apr 21 04:41:03 2010
+++ /trunk/t/test13.rdt Sun May 30 01:17:44 2010
@@ -74,5 +74,5 @@
sub_subinfo main::foo called_by 1 13 [ 1 0 0 0 0 0 0
main::baz ]
sub_subinfo main::foo called_by 1 14 [ 1 0 0 0 0 0 0
main::baz ]
sub_subinfo main::foo called_by 2 1 [ 1 0 0 0 0 0 0
main::RUNTIME ]
-sub_subinfo main::x [ undef undef undef 1 0 0 0 0 ]
+sub_subinfo main::x [ 1 undef undef 1 0 0 0 0 ]
sub_subinfo main::x called_by 1 15 [ 1 0 0 0 0 0 0
main::baz ]
=======================================
--- /trunk/t/test50-disable.rdt Thu Dec 10 03:05:52 2009
+++ /trunk/t/test50-disable.rdt Sun May 30 01:17:44 2010
@@ -33,7 +33,7 @@
profile_modes fid_block_time block
profile_modes fid_line_time line
profile_modes fid_sub_time sub
-sub_subinfo DB::disable_profile [ undef 0 0 2 0 0 0 0 ]
+sub_subinfo DB::disable_profile [ 1 0 0 2 0 0 0 0 ]
sub_subinfo DB::disable_profile called_by 1 2 [ 1 0 0 0 0 0 0
main::RUNTIME ]
sub_subinfo DB::disable_profile called_by 1 6 [ 1 0 0 0 0 0 0
main::RUNTIME ]
sub_subinfo main::BEGIN [ 1 0 0 0 0 0 0 0 ]
=======================================
--- /trunk/t/test51-enable.rdt Thu May 27 02:43:13 2010
+++ /trunk/t/test51-enable.rdt Sun May 30 01:17:44 2010
@@ -46,7 +46,7 @@
profile_modes fid_block_time block
profile_modes fid_line_time line
profile_modes fid_sub_time sub
-sub_subinfo DB::disable_profile [ undef 0 0 1 0 0 0 0 ]
+sub_subinfo DB::disable_profile [ 1 0 0 1 0 0 0 0 ]
sub_subinfo DB::disable_profile called_by 1 18 [ 1 0 0 0 0 0 0
main::RUNTIME ]
sub_subinfo main::BEGIN [ 1 0 0 0 0 0 0 0 ]
sub_subinfo main::CORE:unlink [ 1 0 0 1 0 0 0 0 ]
=======================================
--- /trunk/t/test62-subcaller1.rdt Thu Dec 10 03:05:52 2009
+++ /trunk/t/test62-subcaller1.rdt Sun May 30 01:17:44 2010
@@ -121,7 +121,7 @@
profile_modes fid_line_time line
profile_modes fid_sub_time sub
sub_subinfo Devel::NYTProf::Test::example_sub [ 2 13 13 0 0 0 0 0 ]
-sub_subinfo Devel::NYTProf::Test::example_xsub [ undef undef undef 5 0 0 0
0 ]
+sub_subinfo Devel::NYTProf::Test::example_xsub [ 1 undef undef 5 0 0 0
0 ]
sub_subinfo Devel::NYTProf::Test::example_xsub called_by 1 17 [ 1 0 0 0 0
0 0 main::RUNTIME ]
sub_subinfo Devel::NYTProf::Test::example_xsub called_by 1 22 [ 1 0 0 0 0
0 0 main::RUNTIME ]
sub_subinfo Devel::NYTProf::Test::example_xsub called_by 1 26 [ 3 0 0 0 0
0 0 main::CORE:sort ]
--
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]
