[perl-devel-nytprof] r888 committed - Add perldb=N option to force certain PL_perldb values...

[codesite...@google.com]

Revision: 888
Author: tim.bunce
Date: Wed Oct 28 06:19:29 2009
Log: Add perldb=N option to force certain PL_perldb values
(undocumented as it's just for testing/emergency use)
Added PL_perldb value as an attribute in the profile data file.

http://code.google.com/p/perl-devel-nytprof/source/detail?r=888

Modified:
/trunk/NYTProf.xs
/trunk/lib/Devel/NYTProf/Data.pm
/trunk/lib/Devel/NYTProf.pm

=======================================
--- /trunk/NYTProf.xs Wed Oct 28 05:00:38 2009
+++ /trunk/NYTProf.xs Wed Oct 28 06:19:29 2009
@@ -263,7 +263,9 @@
#define profile_findcaller options[11].option_value
{ "findcaller", 0 }, /* find sub caller
instead of trusting outer */
#define profile_forkdepth options[12].option_value
- { "forkdepth", -1 } /* how many generations
of kids to profile */
+ { "forkdepth", -1 }, /* how many generations
of kids to profile */
+#define opt_perldb options[13].option_value
+ { "perldb", 0 } /* force certain
PL_perldb value */
};

/* time tracking */
@@ -909,7 +911,8 @@
NYTP_printf(out, ":%s=%d.%d.%d\n", "perl_version", PERL_REVISION,
PERL_VERSION, PERL_SUBVERSION);
NYTP_printf(out, ":%s=%d\n", "clock_id", profile_clock);
NYTP_printf(out, ":%s=%u\n", "ticks_per_sec", ticks_per_sec);
- NYTP_printf(out, ":%s=%lu\n", "nv_size", (long unsigned
int)sizeof(NV));
+ NYTP_printf(out, ":%s=%d\n", "nv_size", (int)sizeof(NV));
+ NYTP_printf(out, ":%s=%lu\n", "PL_perldb", (long unsigned
int)PL_perldb);
/* $0 - application name */
sv = get_sv("0",GV_ADDWARN);
NYTP_printf(out, ":%s=%s\n", "application", SvPV_nolen(sv));
@@ -2970,6 +2973,8 @@
PL_perldb |= PERLDBf_LINE; /* line-by-line profiling via DB::DB
(if $DB::single true) */
PL_perldb |= PERLDBf_SINGLE; /* start (after BEGINs) with
single-step on XXX still needed? */
}
+ if (opt_perldb) /* not documented - for testing only */
+ PL_perldb = opt_perldb;

#ifdef HAS_CLOCK_GETTIME
if (profile_clock == -1) { /* auto select */
=======================================
--- /trunk/lib/Devel/NYTProf/Data.pm Thu Oct 22 09:24:17 2009
+++ /trunk/lib/Devel/NYTProf/Data.pm Wed Oct 28 06:19:29 2009
@@ -496,6 +496,10 @@
)) {
$attributes->{$attr} = 0;
}
+
+ for my $attr (qw(PL_perldb)) {
+ delete $attributes->{$attr};
+ }

# normalize line data
for my $level (qw(line block sub)) {
=======================================
--- /trunk/lib/Devel/NYTProf.pm Wed Oct 28 05:00:38 2009
+++ /trunk/lib/Devel/NYTProf.pm Wed Oct 28 06:19:29 2009
@@ -16,7 +16,7 @@
package # hide the package from the PAUSE indexer
DB;

-# Enable specific perl debugger flags.
+# Enable specific perl debugger flags (others may be set later).
# Set the flags that influence compilation ASAP so we get full details
# (sub line ranges etc) of modules loaded as a side effect of loading
# Devel::NYTProf::Core (ie XSLoader, strict, Exporter etc.)
@@ -25,12 +25,11 @@
| 0x100 # informative "file" names for evals
| 0x200; # informative names for anonymous subroutines

-# XXX hack, need better option handling
-my $use_db_sub = ($ENV{NYTPROF} && $ENV{NYTPROF} =~ m/\buse_db_sub=1\b/);
-
require Devel::NYTProf::Core; # loads XS and sets options

-if ($use_db_sub) { # install DB::DB sub
+# XXX hack, need better option handling e.g., add
DB::get_option('use_db_sub')
+my $use_db_sub = ($ENV{NYTPROF} && $ENV{NYTPROF} =~ m/\buse_db_sub=1\b/);
+if ($use_db_sub) { # install DB::DB sub
*DB = ($] < 5.008008)
? sub { goto &DB_profiler } # workaround bug in old perl
versions (slow)
: \&DB_profiler;