Author: tim.bunce
Date: Sun Jun 7 11:50:01 2009
New Revision: 760
Modified:
trunk/NYTProf.xs
trunk/bin/nytprofhtml
trunk/lib/Devel/NYTProf/Constants.pm
trunk/t/ (props changed)
Log:
Give a hint to users when they get no source code for -e (and some other
cases).
Updated svn:ignore for t/ dir.
Added const_bits2names() to Devel::NYTProf::Constants to convert
flags to names. Not currently used.
Fixed undef warning when code has no packages.
Modified: trunk/NYTProf.xs
==============================================================================
--- trunk/NYTProf.xs (original)
+++ trunk/NYTProf.xs Sun Jun 7 11:50:01 2009
@@ -2885,12 +2885,17 @@
lines = av_len(src_av);
if (trace_level >= 4)
warn("fid %d has %ld src lines", e->id, (long)lines);
+ /* for perl 5.10.0 or 5.8.8 (or earlier) use_db_sub is needed to
get src */
+ if (0 == lines && !use_db_sub) { /* give a hint */
+ av_store(src_av, 1, newSVpv("# source not available, try using
use_db_sub=1 option.\n",0));
+ lines = 1;
+ }
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 */
+ * 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 */
Modified: trunk/bin/nytprofhtml
==============================================================================
--- trunk/bin/nytprofhtml (original)
+++ trunk/bin/nytprofhtml Sun Jun 7 11:50:01 2009
@@ -274,7 +274,7 @@
#
sub package_tables {
my ($profile) = @_;
- my $pkg_html;
+ my $pkg_html = "";
# XXX may not be appropriate if profiling wasn't continuous
my $profiler_duration = $profile->{attribute}{profiler_duration};
Modified: trunk/lib/Devel/NYTProf/Constants.pm
==============================================================================
--- trunk/lib/Devel/NYTProf/Constants.pm (original)
+++ trunk/lib/Devel/NYTProf/Constants.pm Sun Jun 7 11:50:01 2009
@@ -6,9 +6,38 @@
use base 'Exporter';
-my $symbol_table = do { no strict; \%{"Devel::NYTProf::Constants::"} };
+our @EXPORT_OK = qw(const_bits2names);
+
+my $const_bits2names_groups;
+
+do {
+ my $symbol_table = do { no strict; \%{"Devel::NYTProf::Constants::"} };
+ my %consts = map { $_ => $symbol_table->{$_}() } grep { /^NYTP_/ }
keys %$symbol_table;
+
+ push @EXPORT_OK, keys %consts;
+
+ for my $sym (keys %consts) {
+ $sym =~ /^(NYTP_[A-Z]+[a-z])_/ or next;
+ $const_bits2names_groups->{$1}{ $consts{$sym} } = $sym;
+ }
+};
+
+
+sub const_bits2names { # const_bits2names("NYTP_FIDf",$flags)
+ my ($group, $bits) = @_;
+ my $names = $const_bits2names_groups->{$group} or return;
+ my @names;
+ for my $bit (0..31) {
+ my $bitval = 1 << $bit;
+ push @names, $names->{$bitval}
+ if $bits & $bitval;
+ }
+ return @names if wantarray;
+ return join " | ", @names;
+}
+
+# warn scalar const_bits2names("NYTP_FIDf", NYTP_FIDf_SAVE_SRC|
NYTP_FIDf_IS_PMC);
-our @EXPORT_OK = grep { /^NYTP_/ } keys %$symbol_table;
#warn "Constants: ".join(" ", sort @EXPORT_OK);
--~--~---------~--~----~------------~-------~--~----~
You received this message because you are subscribed to the Google Groups
"Devel::NYTProf Dev" group.
To post to this group, send email to [email protected]
To unsubscribe from this group, send email to
[email protected]
For more options, visit this group at
http://groups.google.com/group/develnytprof-dev?hl=en
-~----------~----~----~----~------~----~------~--~---
