Revision: 1290
Author: [email protected]
Date: Tue Jun 8 15:30:13 2010
Log: Don't write a fake src line for "perl -e '...'" and "perl -" when src
isn't available.
Mark them as NYTP_FIDf_IS_EVAL (but without an eval_fid).
Tweak Reader to generate a useful message instead of "Unable to open -e"
http://code.google.com/p/perl-devel-nytprof/source/detail?r=1290
Modified:
/trunk/NYTProf.xs
/trunk/lib/Devel/NYTProf/FileInfo.pm
/trunk/lib/Devel/NYTProf/Reader.pm
/trunk/t/22-readstream.t
=======================================
--- /trunk/NYTProf.xs Tue Jun 8 03:10:39 2010
+++ /trunk/NYTProf.xs Tue Jun 8 15:30:13 2010
@@ -974,15 +974,18 @@
if (av_len(src_av) > -1)
found->fid_flags |= NYTP_FIDf_HAS_SRC;
+ /* flag "perl -e '...'" and "perl -" as string evals */
+ if (found->key[0] == '-' && (found->key_len == 1 ||
+ (found->key[1] == 'e' && found->key_len ==
2)))
+ found->fid_flags |= NYTP_FIDf_IS_EVAL;
+
/* if it's a string eval or a synthetic filename from CODE ref in @INC,
- * or the command line -e '...code...'
* then we'd like to save the src (NYTP_FIDf_HAS_SRC) if it's available
*/
if (found->eval_fid
+ || (found->fid_flags & NYTP_FIDf_IS_EVAL)
|| (profile_opts & NYTP_OPTf_SAVESRC)
|| (found->key_len > 10 && found->key[9] == 'x' &&
strnEQ(found->key, "/loader/0x", 10))
- || (found->key[0] == '-' && (found->key_len == 1 ||
- (found->key[1] == 'e' && found->key_len ==
2)))
) {
found->fid_flags |= NYTP_FIDf_SAVE_SRC;
}
@@ -3391,16 +3394,6 @@
if (trace_level >= 4)
logwarn("fid %d has %ld src lines for %.*s\n",
e->id, (long)lines, e->key_len, e->key);
- /* for perl 5.10.0 or 5.8.8 (or earlier) use_db_sub is needed to
get src */
- /* give a hint for the common case */
- if (lines <= 0 && !opt_use_db_sub
- && ( e->key[0] == '-'
- && ( e->key_len == 1
- || ( e->key[1] == 'e' && e->key_len == 2 ) ) )
- ) {
- av_store(src_av, 1, newSVpvf("# fid%d: source not available,
try using use_db_sub=1 option.\n",e->id));
- lines = 1;
- }
for (line = 1; line <= lines; ++line) { /* lines start at 1 */
SV **svp = av_fetch(src_av, line, 0);
STRLEN len = 0;
=======================================
--- /trunk/lib/Devel/NYTProf/FileInfo.pm Mon Jun 7 09:41:57 2010
+++ /trunk/lib/Devel/NYTProf/FileInfo.pm Tue Jun 8 15:30:13 2010
@@ -9,6 +9,7 @@
use Devel::NYTProf::Constants qw(
NYTP_FIDf_HAS_SRC NYTP_FIDf_SAVE_SRC NYTP_FIDf_IS_FAKE NYTP_FIDf_IS_PMC
+ NYTP_FIDf_IS_EVAL
NYTP_FIDi_FILENAME NYTP_FIDi_EVAL_FID NYTP_FIDi_EVAL_LINE NYTP_FIDi_FID
NYTP_FIDi_FLAGS NYTP_FIDi_FILESIZE NYTP_FIDi_FILEMTIME
NYTP_FIDi_PROFILE
@@ -33,16 +34,17 @@
sub size { shift->[NYTP_FIDi_FILESIZE()] }
sub mtime { shift->[NYTP_FIDi_FILEMTIME()] }
sub profile { shift->[NYTP_FIDi_PROFILE()] }
+sub flags { shift->[NYTP_FIDi_FLAGS()] }
# if an eval then return fileinfo obj for the fid that executed the eval
sub eval_fi { shift->[NYTP_FIDi_EVAL_FI()] }
+# is_eval is true only for simple string evals (doesn't consider
NYTP_FIDf_IS_EVAL)
sub is_eval { shift->[NYTP_FIDi_EVAL_FI()] ? 1 : 0 }
-sub flags { shift->[NYTP_FIDi_FLAGS()] }
sub is_fake { shift->flags & NYTP_FIDf_IS_FAKE }
sub is_file {
my $self = shift;
- return not ($self->is_fake or $self->is_eval);
+ return not ($self->is_fake or $self->is_eval or $self->flags &
NYTP_FIDf_IS_EVAL());
}
# general purpose hash - mainly a hack to help kill off Reader.pm
=======================================
--- /trunk/lib/Devel/NYTProf/Reader.pm Tue Jun 8 15:07:14 2010
+++ /trunk/lib/Devel/NYTProf/Reader.pm Tue Jun 8 15:30:13 2010
@@ -358,6 +358,9 @@
# code returned by a CODE ref in @INC
$msg = "No source code available for 'file' loaded via
CODE reference in \...@inc.\nsee savesrc option in documentation.",
}
+ elsif (not $fi->is_file) {
+ $msg = "No source code available for
non-file '$filestr'.\nSee savesrc option in documentation.",
+ }
else {
# the report will not be complete, but this doesn't need
to be fatal
=======================================
--- /trunk/t/22-readstream.t Tue Jun 1 15:45:14 2010
+++ /trunk/t/22-readstream.t Tue Jun 8 15:30:13 2010
@@ -9,6 +9,8 @@
use Devel::NYTProf::ReadStream qw(for_chunks);
+my $pre589 = ($] < 5.008009 or $] eq "5.010000");
+
(my $base = __FILE__) =~ s/\.t$//;
# generate an nytprof out file
@@ -41,14 +43,20 @@
is_deeply $prof{VERSION}, [ [ 4, 0 ] ];
# check for expected tags
-# (but not START_DEFLATE as that'll be missing if there's no zlib)
+# but not START_DEFLATE as that'll be missing if there's no zlib
+# and not SRC_LINE as old perl's
for my $tag (qw(
- COMMENT ATTRIBUTE DISCOUNT SRC_LINE TIME_BLOCK
+ COMMENT ATTRIBUTE DISCOUNT TIME_BLOCK
SUB_INFO SUB_CALLERS
PID_START PID_END NEW_FID
)) {
is ref $prof{$tag}[0], 'ARRAY', $tag;
}
+
+SKIP: {
+ skip 'needs perl >= 5.8.9 or >= 5.10.1', 1 if $pre589;
+ is ref $prof{SRC_LINE}[0], 'ARRAY', 'SRC_LINE';
+}
# check some attributes
my %attr = map { $_->[0] => $_->[1] } @{ $prof{ATTRIBUTE} };
--
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]
