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; --~--~---------~--~----~------------~-------~--~----~ 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] -~----------~----~----~----~------~----~------~--~---
