Author: tim.bunce
Date: Sun Mar 8 12:10:07 2009
New Revision: 706
Modified:
trunk/Changes
trunk/NYTProf.xs
trunk/lib/Devel/NYTProf/Constants.pm
trunk/lib/Devel/NYTProf/FileInfo.pm
trunk/t/lib/NYTProfTest.pm
Log:
Fix savesrc by writing source at end of profile run
added a fid flag to indicate src is available,
and another to indicate src should be saved.
Modified: trunk/Changes
==============================================================================
--- trunk/Changes (original)
+++ trunk/Changes Sun Mar 8 12:10:07 2009
@@ -9,7 +9,9 @@
Fixed report filename generation to remove colons,
for Windows, reported by Adam Kennedy in rt bug #43798.
Fixed report filename generation to remove dots, for VMS.
+ Fixed savesrc which wasn't safe and reliable.
Added missing t/test22-strevala.t to MANIFEST.
+ Extended testing to exercise compress and savesrc options.
Ported to VMS, thanks to Peter (Stig) Edwards:
Modified: trunk/NYTProf.xs
==============================================================================
--- trunk/NYTProf.xs (original)
+++ trunk/NYTProf.xs Sun Mar 8 12:10:07 2009
@@ -30,6 +30,9 @@
#if !defined(OutCopFILE)
# define OutCopFILE CopFILE
#endif
+#ifndef gv_fetchfile_flags
+#define gv_fetchfile_flags(str, len, flags) gv_fetchfile(str)
+#endif
#ifndef OP_SETSTATE
#define OP_SETSTATE OP_NEXTSTATE
@@ -77,6 +80,8 @@
#define NYTP_FIDf_VIA_STMT 0x0002 /* fid first seen by stmt profiler
*/
#define NYTP_FIDf_VIA_SUB 0x0004 /* fid first seen by sub profiler
*/
#define NYTP_FIDf_IS_AUTOSPLIT 0x0008 /* fid is cone of the 'parent' fid
it was autosplit from */
+#define NYTP_FIDf_HAS_SRC 0x0010 /* src is available to profiler */
+#define NYTP_FIDf_SAVE_SRC 0x0020 /* src will be saved by profiler,
if NYTP_FIDf_HAS_SRC also set */
#define NYTP_TAG_ATTRIBUTE ':' /* :name=value\n */
#define NYTP_TAG_COMMENT '#' /* till newline */
@@ -310,6 +315,7 @@
static void open_output_file(pTHX_ char *);
static int reinit_if_forked(pTHX);
static void write_cached_fids(void);
+static void write_src_of_files(pTHX);
static void write_sub_line_ranges(pTHX);
static void write_sub_callers(pTHX);
static HV *load_profile_data_from_stream(SV* cb);
@@ -1249,58 +1255,39 @@
found->fid_flags |= NYTP_FIDf_IS_PMC;
found->fid_flags |= created_via; /* NYTP_FIDf_VIA_STMT or
NYTP_FIDf_VIA_SUB */
- emit_fid(found);
+ /* is source code available? */
+ /* source only available if PERLDB_LINE or PERLDB_SAVESRC is true */
+ /* which we set if savesrc option is enabled */
+ if ( (src_av = GvAV(gv_fetchfile_flags(found->key, found->key_len,
0))) )
+ found->fid_flags |= NYTP_FIDf_HAS_SRC;
/* if it's a string eval or a synthetic filename from CODE ref in @INC,
- * or the command line -e '...code...'
- * then think about writing out the source code */
+ * 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->key_len > 10 && found->key[9] == 'x' &&
strnEQ(found->key, "/loader/0x", 10))
|| (found->key_len == 1 && strnEQ(found->key, "-", 1))
|| (found->key_len == 2 && strnEQ(found->key, "-e", 2))
|| (profile_opts & NYTP_OPTf_SAVESRC)
) {
- /* source only available if PERLDB_LINE or PERLDB_SAVESRC is true
*/
-#ifdef gv_fetchfile_flags
- src_av = GvAV(gv_fetchfile_flags(found->key, found->key_len, 0));
-#else
- src_av = GvAV(gv_fetchfile(found->key));
-#endif
- if (!src_av && trace_level >= 3)
- warn("No source available for fid %d%s\n",
- found->id, use_db_sub ? "" : ", set use_db_sub=1 option");
+ found->fid_flags |= NYTP_FIDf_SAVE_SRC;
}
+ emit_fid(found);
+
if (trace_level >= 2) {
/* including last_executed_fid can be handy for tracking down how
* a file got loaded */
- warn("New fid %2u (after %2u:%-4u) %x e%u:%u %.*s %s%s\n",
+ warn("New fid %2u (after %2u:%-4u) %x e%u:%u %.*s %s %s,%s\n",
found->id, last_executed_fid, last_executed_line,
found->fid_flags, found->eval_fid, found->eval_line_num,
found->key_len, found->key, (found->key_abs) ?
found->key_abs : "",
- src_av ? ", with src" : ""
+ (found->fid_flags & NYTP_FIDf_HAS_SRC) ? "has src" : "no src",
+ (found->fid_flags & NYTP_FIDf_SAVE_SRC) ? "save src" : "won't
save"
);
}
- if (src_av) {
- I32 lines = av_len(src_av);
- int line;
- if (trace_level >= 4)
- warn("fid %d has %ld src lines", found->id, (long)lines);
- for (line = 1; line <= lines; ++line) { /* lines start at 1 */
- SV **svp = av_fetch(src_av, line, 0);
- STRLEN len = 0;
- char *src = (svp) ? SvPV(*svp, len) : "";
- /* outputting the tag and fid for each (non empty) line
- * is a little inefficient, but not enough to worry about */
- output_tag_int(NYTP_TAG_SRC_LINE, found->id);
- output_int(line);
- output_str(src, (I32)len); /* includes newline */
- if (trace_level >= 5)
- warn("fid %d src line %d: %s", found->id, line, src);
- }
- }
-
return found->id;
}
@@ -1919,6 +1906,7 @@
if (!out)
return;
+ write_src_of_files(aTHX);
write_sub_line_ranges(aTHX);
write_sub_callers(aTHX);
/* mark end of profile data for last_pid pid
@@ -2776,6 +2764,67 @@
}
+static void
+write_src_of_files(pTHX)
+{
+ Hash_entry *e;
+ int t_has_src = 0;
+ int t_save_src = 0;
+ int t_no_src = 0;
+ long t_lines = 0;
+
+ if (trace_level >= 1)
+ warn("writing file source code\n");
+
+ for (e = hashtable.first_inserted; e; e = (Hash_entry
*)e->next_inserted) {
+ I32 lines;
+ int line;
+ AV *src_av = GvAV(gv_fetchfile_flags(e->key, e->key_len, 0));
+
+ if ( !(e->fid_flags & NYTP_FIDf_HAS_SRC) ) {
+ ++t_no_src;
+ if (src_av) /* sanity check */
+ warn("fid %d has src but NYTP_FIDf_HAS_SRC not set!
(%.*s)",
+ e->id, e->key_len, e->key);
+ continue;
+ }
+ if (!src_av) { /* sanity check */
+ ++t_no_src;
+ warn("fid %d has no src but NYTP_FIDf_HAS_SRC is set! (%.*s)",
+ e->id, e->key_len, e->key);
+ continue;
+ }
+ ++t_has_src;
+
+ if ( !(e->fid_flags & NYTP_FIDf_SAVE_SRC) ) {
+ continue;
+ }
+ ++t_save_src;
+
+ lines = av_len(src_av);
+ if (trace_level >= 4)
+ warn("fid %d has %ld src lines", e->id, (long)lines);
+ for (line = 1; line <= lines; ++line) { /* lines start at 1 */
+ SV **svp = av_fetch(src_av, line, 0);
+ STRLEN len = 0;
+ char *src = (svp) ? SvPV(*svp, len) : "";
+ /* outputting the tag and fid for each (non empty) line
+ * is a little inefficient, but not enough to worry about */
+ output_tag_int(NYTP_TAG_SRC_LINE, e->id);
+ output_int(line);
+ output_str(src, (I32)len); /* includes newline */
+ if (trace_level >= 5)
+ warn("fid %d src line %d: %s", e->id, line, src);
+ ++t_lines;
+ }
+ }
+
+ if (trace_level >= 1)
+ warn("wrote %d source lines for %d files (%d skipped without
savesrc option, %d others had no source available)\n",
+ t_lines, t_save_src, t_has_src-t_save_src, t_no_src);
+}
+
+
/**
* Read an integer by decompressing the next 1 to 4 bytes of binary into a
32-
* bit integer. See output_int() for the compression details.
@@ -3724,7 +3773,13 @@
BOOT:
{
HV *stash = gv_stashpv("Devel::NYTProf::Constants", GV_ADDWARN);
- newCONSTSUB(stash, "NYTP_FIDf_IS_PMC", newSViv(NYTP_FIDf_IS_PMC));
+ /* NYTP_FIDf_* */
+ newCONSTSUB(stash, "NYTP_FIDf_IS_PMC",
newSViv(NYTP_FIDf_IS_PMC));
+ newCONSTSUB(stash, "NYTP_FIDf_VIA_STMT",
newSViv(NYTP_FIDf_VIA_STMT));
+ newCONSTSUB(stash, "NYTP_FIDf_VIA_SUB",
newSViv(NYTP_FIDf_VIA_SUB));
+ newCONSTSUB(stash, "NYTP_FIDf_IS_AUTOSPLIT",
newSViv(NYTP_FIDf_IS_AUTOSPLIT));
+ newCONSTSUB(stash, "NYTP_FIDf_HAS_SRC",
newSViv(NYTP_FIDf_HAS_SRC));
+ newCONSTSUB(stash, "NYTP_FIDf_SAVE_SRC",
newSViv(NYTP_FIDf_SAVE_SRC));
/* NYTP_FIDi_* */
newCONSTSUB(stash, "NYTP_FIDi_FILENAME", newSViv(NYTP_FIDi_FILENAME));
newCONSTSUB(stash, "NYTP_FIDi_EVAL_FID", newSViv(NYTP_FIDi_EVAL_FID));
Modified: trunk/lib/Devel/NYTProf/Constants.pm
==============================================================================
--- trunk/lib/Devel/NYTProf/Constants.pm (original)
+++ trunk/lib/Devel/NYTProf/Constants.pm Sun Mar 8 12:10:07 2009
@@ -10,4 +10,6 @@
our @EXPORT_OK = grep { /^NYTP_/ } keys %$symbol_table;
+#warn "Constants: ".join(" ", sort @EXPORT_OK);
+
1;
Modified: trunk/lib/Devel/NYTProf/FileInfo.pm
==============================================================================
--- trunk/lib/Devel/NYTProf/FileInfo.pm (original)
+++ trunk/lib/Devel/NYTProf/FileInfo.pm Sun Mar 8 12:10:07 2009
@@ -5,6 +5,8 @@
use Devel::NYTProf::Util qw(strip_prefix_from_paths);
use Devel::NYTProf::Constants qw(
+ NYTP_FIDf_HAS_SRC NYTP_FIDf_SAVE_SRC
+
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
NYTP_FIDi_EVAL_FI NYTP_FIDi_HAS_EVALS NYTP_FIDi_SUBS_DEFINED
NYTP_FIDi_SUBS_CALLED
@@ -173,6 +175,9 @@
# normalize eval sequence numbers in 'file' names to 0
$self->[NYTP_FIDi_FILENAME] =~ s/ \( ((?:re_)?) eval \s \d+ \)
/(${1}eval 0)/xg;
+
+ # normalize flags to avoid failures due to savesrc and perl version
+ $self->[NYTP_FIDi_FLAGS] &= ~(NYTP_FIDf_HAS_SRC|NYTP_FIDf_SAVE_SRC);
for my $sc (map { values %$_ } values %{ $self->sub_call_lines }) {
$sc->[NYTP_SCi_INCL_RTIME] =
Modified: trunk/t/lib/NYTProfTest.pm
==============================================================================
--- trunk/t/lib/NYTProfTest.pm (original)
+++ trunk/t/lib/NYTProfTest.pm Sun Mar 8 12:10:07 2009
@@ -140,6 +140,7 @@
}
}
+
sub run_test {
my ($test) = @_;
--~--~---------~--~----~------------~-------~--~----~
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]
-~----------~----~----~----~------~----~------~--~---
