Author: tim.bunce
Date: Mon Jan 5 15:05:37 2009
New Revision: 665
Added:
trunk/t/test51-enable.p
trunk/t/test51-enable.rdt
trunk/t/test51-enable.x
Modified:
trunk/Changes
trunk/MANIFEST
trunk/Makefile.PL
trunk/NYTProf.xs
trunk/bin/nytprofhtml
trunk/lib/Devel/NYTProf.pm
trunk/t/test50-disable.rdt
trunk/t/test50-disable.x
Log:
Implement DB::enable_profile($new_filename).
Increment the count of the statement containing DB::enable_profile().
Modified: trunk/Changes
==============================================================================
--- trunk/Changes (original)
+++ trunk/Changes Mon Jan 5 15:05:37 2009
@@ -15,6 +15,9 @@
Added savesrc=1 option to copy source code into the profile
so reports are not affected by changes to the source files.
+ Added ability for DB::enable_profile() to specify a new file
+ for profile data to be written to.
+
Reporting:
Time spent within nested string evals is accounted for.
Modified: trunk/MANIFEST
==============================================================================
--- trunk/MANIFEST (original)
+++ trunk/MANIFEST Mon Jan 5 15:05:37 2009
@@ -109,6 +109,9 @@
t/test50-disable.p
t/test50-disable.rdt
t/test50-disable.x
+t/test51-enable.p
+t/test51-enable.x
+t/test51-enable.rdt
t/test60-subname.p
t/test60-subname.rdt
t/test61-submerge.p
Modified: trunk/Makefile.PL
==============================================================================
--- trunk/Makefile.PL (original)
+++ trunk/Makefile.PL Mon Jan 5 15:05:37 2009
@@ -118,7 +118,7 @@
clean => { FILES => join " ",
"nytprof demo-out",
map { ("t/$_", "xt/$_") }
- qw(nytprof_t.out nytprof.out *.outdir test*.*.new auto)
+ qw(nytprof*.out *.outdir test*.*.new auto)
},
dist => {
DIST_DEFAULT => 'clean distcheck disttest tardist',
Modified: trunk/NYTProf.xs
==============================================================================
--- trunk/NYTProf.xs (original)
+++ trunk/NYTProf.xs Mon Jan 5 15:05:37 2009
@@ -282,7 +282,7 @@
static char *last_executed_fileptr;
static unsigned int last_block_line;
static unsigned int last_sub_line;
-static unsigned int is_profiling;
+static unsigned int is_profiling; /* disable_profile() &
enable_profile() */
static Pid_t last_pid;
static NV cumulative_overhead_ticks = 0.0;
static NV cumulative_subr_secs = 0.0;
@@ -298,7 +298,7 @@
static unsigned int read_int(void);
static SV *read_str(pTHX_ SV *sv);
static unsigned int get_file_id(pTHX_ char*, STRLEN, int created_via);
-static void DB_stmt(pTHX_ OP *op);
+static void DB_stmt(pTHX_ COP *cop, OP *op);
static void set_option(pTHX_ const char*, const char*);
static int enable_profile(pTHX_ char *file);
static int disable_profile(pTHX);
@@ -1606,13 +1606,12 @@
* Main statement profiling function. Called before each breakable
statement.
*/
static void
-DB_stmt(pTHX_ OP *op)
+DB_stmt(pTHX_ COP *cop, OP *op)
{
int saved_errno;
char *file;
unsigned int elapsed;
unsigned int overflow;
- COP *cop;
if (!is_profiling || !profile_stmts) {
return;
@@ -1649,7 +1648,8 @@
last_executed_line, elapsed, last_block_line,
last_sub_line);
}
- cop = PL_curcop_nytprof;
+ if (!cop)
+ cop = PL_curcop_nytprof;
if ( (last_executed_line = CopLINE(cop)) == 0 ) {
/* Might be a cop that has been optimised away. We can try to
find such a
* cop by searching through the optree starting from the sibling
of PL_curcop.
@@ -1732,7 +1732,7 @@
* (earlier than it would have been done)
* and switch back to measuring the 'calling' statement
*/
- DB_stmt(aTHX_ op);
+ DB_stmt(aTHX_ NULL, op);
/* output a 'discount' marker to indicate the next statement time
shouldn't
* increment the count (because the time is not for a new statement
but simply
@@ -2086,8 +2086,9 @@
dSP;
SV *sub_sv = *SP;
sub_call_start_t sub_call_start;
+ int profile_sub_call = (profile_subs && is_profiling);
- if (profile_subs && is_profiling) {
+ if (profile_sub_call) {
if (!profile_stmts)
reinit_if_forked(aTHX);
get_time_of_day(sub_call_start.sub_call_time);
@@ -2103,7 +2104,7 @@
*/
op = run_original_op(OP_ENTERSUB); /* may croak */
- if (profile_subs && is_profiling) {
+ if (profile_sub_call) {
int saved_errno = errno;
/* get line, file, and fid for statement *before* the call */
@@ -2273,7 +2274,7 @@
pp_stmt_profiler(pTHX) /* handles OP_DBSTATE,
OP_SETSTATE, etc */
{
OP *op = run_original_op(PL_op->op_type);
- DB_stmt(aTHX_ op);
+ DB_stmt(aTHX_ NULL, op);
return op;
}
@@ -2303,6 +2304,16 @@
/* enable the run-time aspects to profiling */
int prev_is_profiling = is_profiling;
+ if (!out) {
+ warn("enable_profile: NYTProf not active");
+ return 0;
+ }
+
+ if (trace_level)
+ warn("NYTProf enable_profile (previously %s) to %s",
+ prev_is_profiling ? "enabled" : "disabled",
+ (file && *file) ? file : PROF_output_file);
+
if (file && *file && strNE(file, PROF_output_file)) {
/* caller wants output to go to a new file */
close_output_file(aTHX);
@@ -2310,16 +2321,11 @@
open_output_file(aTHX_ PROF_output_file);
}
- if (!out) {
- warn("enable_profile: NYTProf not active");
- return 0;
- }
- if (trace_level)
- warn("NYTProf enable_profile%s", (prev_is_profiling)?" (already
enabled)":"");
- is_profiling = 1;
- last_executed_fileptr = NULL;
- if (use_db_sub)
+ last_executed_fileptr = NULL; /* discard cached OutCopFILE */
+ is_profiling = 1; /* enable NYTProf profilers */
+ if (use_db_sub) /* set PL_DBsingle if required */
sv_setiv(PL_DBsingle, 1);
+
return prev_is_profiling;
}
@@ -2336,7 +2342,8 @@
is_profiling = 0;
}
if (trace_level)
- warn("NYTProf disable_profile %d->%d", prev_is_profiling,
is_profiling);
+ warn("NYTProf disable_profile (previously %s)",
+ prev_is_profiling ? "enabled" : "disabled");
return prev_is_profiling;
}
@@ -2352,7 +2359,7 @@
/* write data for final statement, unless DB_leave has already */
if (!profile_leave || use_db_sub)
- DB_stmt(aTHX_ NULL);
+ DB_stmt(aTHX_ NULL, NULL);
disable_profile(aTHX);
@@ -3699,7 +3706,7 @@
/* this sub gets aliased as "DB::DB" by NYTProf.pm if use_db_sub is
true */
PERL_UNUSED_VAR(items);
if (use_db_sub)
- DB_stmt(aTHX_ PL_op);
+ DB_stmt(aTHX_ NULL, PL_op);
else if (1||trace_level)
warn("DB called needlessly");
@@ -3717,6 +3724,13 @@
enable_profile(char *file = NULL)
C_ARGS:
aTHX_ file
+ POSTCALL:
+ /* if profiler was previously disabled */
+ /* then arrange for the enable_profile call to be noted */
+ if (!RETVAL) {
+ DB_stmt(aTHX_ PL_curcop, PL_op);
+ }
+
int
disable_profile()
Modified: trunk/bin/nytprofhtml
==============================================================================
--- trunk/bin/nytprofhtml (original)
+++ trunk/bin/nytprofhtml Mon Jan 5 15:05:37 2009
@@ -759,12 +759,12 @@
print OUT qq{<tr class="index">};
print OUT determine_severity($filestats->{'calls'}, undef, 0,
- sprintf("%.1f%%", $filestats->{'calls'}/$allCalls*100)
+ ($allCalls) ? sprintf("%.1f%%",
$filestats->{'calls'}/$allCalls*100) : ''
);
$t_stmt_exec += $filestats->{'calls'};
print OUT determine_severity($filestats->{'time'}, $dev_time,
1,
- sprintf("%.1f%%", $filestats->{'time'}/$allTimes*100)
+ ($allTimes) ? sprintf("%.1f%%",
$filestats->{'time'}/$allTimes*100) : ''
);
$t_stmt_time += $filestats->{'time'};
Modified: trunk/lib/Devel/NYTProf.pm
==============================================================================
--- trunk/lib/Devel/NYTProf.pm (original)
+++ trunk/lib/Devel/NYTProf.pm Mon Jan 5 15:05:37 2009
@@ -414,15 +414,24 @@
=head1 RUN-TIME CONTROL OF PROFILING
-You can profile only parts of an application by calling
DB::enable_profile()
-and DB::disable_profile() at the appropriate moments.
+You can profile only parts of an application by calling
DB::disable_profile()
+to stop collecting profile data, and calling DB::enable_profile() to start
+collecting profile data.
-Using the C<start=no> option lets you leave the profiler disabled until the
-right moment, or circumstances, are reached.
+Using the C<start=no> option lets you leave the profiler disabled initially
+until you call DB::enable_profile() at the right moment.
You can finish profiling completely by calling DB::finish_profile().
This may be useful if perl is exiting abnormally, leaving the profile data
file
in an incomplete state,
+
+=head2 Multiple Output Files
+
+You can pass a filename argument to DB::enable_profile() to make NYTProf
write
+future profile data to that file. The current output file, if any, is
closed.
+Any existing file with the new name will be deleted before being written
to.
+When combined with DB::disable_profile() this lets you profile individual
+sections of code.
=head1 REPORTS
Modified: trunk/t/test50-disable.rdt
==============================================================================
--- trunk/t/test50-disable.rdt (original)
+++ trunk/t/test50-disable.rdt Mon Jan 5 15:05:37 2009
@@ -14,17 +14,22 @@
attribute xs_version 0
fid_block_time 1 1 [ 0 1 ]
fid_block_time 1 2 [ 0 1 ]
+fid_block_time 1 4 [ 0 1 ]
fid_block_time 1 5 [ 0 1 ]
fid_fileinfo 1 [ test50-disable.p 1 2 0 0 ]
-fid_fileinfo 1 call 4 DB::enable_profile [ 1 0 0 0 0 0 0
]
+fid_fileinfo 1 call 2 DB::disable_profile [ 1 0 0 0 0 0 0
]
+fid_fileinfo 1 call 6 DB::disable_profile [ 1 0 0 0 0 0 0
]
fid_line_time 1 1 [ 0 1 ]
fid_line_time 1 2 [ 0 1 ]
+fid_line_time 1 4 [ 0 1 ]
fid_line_time 1 5 [ 0 1 ]
fid_sub_time 1 1 [ 0 1 ]
fid_sub_time 1 2 [ 0 1 ]
+fid_sub_time 1 4 [ 0 1 ]
fid_sub_time 1 5 [ 0 1 ]
profile_modes fid_block_time block
profile_modes fid_line_time line
profile_modes fid_sub_time sub
-sub_subinfo DB::enable_profile [ undef 0 0 2 0 0 0 0 ]
-sub_subinfo DB::enable_profile called_by 1 4 [ 1 0 0
0 0 0 0 ]
+sub_subinfo DB::disable_profile [ undef 0 0 3 0 0 0 0 ]
+sub_subinfo DB::disable_profile called_by 1 2 [ 1 0 0
0 0 0 0 ]
+sub_subinfo DB::disable_profile called_by 1 6 [ 1 0 0
0 0 0 0 ]
Modified: trunk/t/test50-disable.x
==============================================================================
--- trunk/t/test50-disable.x (original)
+++ trunk/t/test50-disable.x Mon Jan 5 15:05:37 2009
@@ -4,7 +4,7 @@
0,1,0,1;
0,1,0,DB::disable_profile();
0,0,0,1;
-0,0,0,DB::enable_profile();
+0,1,0,DB::enable_profile();
0,1,0,1;
0,0,0,DB::disable_profile();
0,0,0,1; # finish with profile disabled
Added: trunk/t/test51-enable.p
==============================================================================
--- (empty file)
+++ trunk/t/test51-enable.p Mon Jan 5 15:05:37 2009
@@ -0,0 +1,20 @@
+# test using enable_profile() to write multiple profile files
+
+sub foo { 1 }
+foo();
+
+DB::disable_profile();
+foo();
+
+# switch to new file and (re)enable profiling
+DB::enable_profile("nytprof-test51-b.out");
+foo();
+
+# switch to new file while already enabled
+DB::enable_profile("nytprof-test51-c.out");
+foo();
+
+# This can be removed once we have a better test harness
+-f $_ or die "$_ should exist"
+ for ("nytprof-test51-b.out", "nytprof-test51-c.out");
+BEGIN { unlink "nytprof-test51-b.out", "nytprof-test51-c.out" }
Added: trunk/t/test51-enable.rdt
==============================================================================
--- (empty file)
+++ trunk/t/test51-enable.rdt Mon Jan 5 15:05:37 2009
@@ -0,0 +1,33 @@
+attribute application test51-enable.p
+attribute basetime 0
+attribute clock_id 0
+attribute nv_size 0
+attribute perl_version 0
+attribute profiler_duration 0
+attribute profiler_end_time 0
+attribute profiler_start_time 0
+attribute ticks_per_sec 0
+attribute total_stmts_discounted 0
+attribute total_stmts_duration 0
+attribute total_stmts_measured 0
+attribute total_sub_calls 0
+attribute xs_version 0
+fid_block_time 1 3 [ 0 1 ]
+fid_block_time 1 4 [ 0 1 ]
+fid_fileinfo 1 [ test51-enable.p 1 2 0 0 ]
+fid_fileinfo 1 sub main::BEGIN 20-20
+fid_fileinfo 1 sub main::foo 3-3
+fid_fileinfo 1 call 4 main::foo [ 1 0 0 0 0 0 0 ]
+fid_fileinfo 1 call 6 DB::disable_profile [ 1 0 0 0 0 0 0
]
+fid_line_time 1 3 [ 0 1 ]
+fid_line_time 1 4 [ 0 1 ]
+fid_sub_time 1 3 [ 0 1 ]
+fid_sub_time 1 4 [ 0 1 ]
+profile_modes fid_block_time block
+profile_modes fid_line_time line
+profile_modes fid_sub_time sub
+sub_subinfo DB::disable_profile [ undef 0 0 2 0 0 0 0 ]
+sub_subinfo DB::disable_profile called_by 1 6 [ 1 0 0
0 0 0 0 ]
+sub_subinfo main::BEGIN [ 1 20 20 0 0 0 0 0 ]
+sub_subinfo main::foo [ 1 3 3 1 0 0 0 0 ]
+sub_subinfo main::foo called_by 1 4 [ 1 0 0 0 0 0 0
]
Added: trunk/t/test51-enable.x
==============================================================================
--- (empty file)
+++ trunk/t/test51-enable.x Mon Jan 5 15:05:37 2009
@@ -0,0 +1,23 @@
+# Profile data generated by Devel::NYTProf::Reader
+# More information at http://search.cpan.org/dist/Devel-NYTProf/
+# Format: time,calls,time/call,code
+0,0,0,# test using enable_profile() to write multiple profile files
+0,0,0,
+0,1,0,sub foo { 1 }
+0,1,0,foo();
+0,0,0,
+0,0,0,DB::disable_profile();
+0,0,0,foo();
+0,0,0,
+0,0,0,# switch to new file and (re)enable profiling
+0,0,0,DB::enable_profile("nytprof-test51-b.out");
+0,0,0,foo();
+0,0,0,
+0,0,0,# switch to new file while already enabled
+0,0,0,DB::enable_profile("nytprof-test51-c.out");
+0,0,0,foo();
+0,0,0,
+0,0,0,# This can be removed once we have a better test harness
+0,0,0,-f $_ or die "$_ should exist"
+0,0,0,for ("nytprof-test51-b.out", "nytprof-test51-c.out");
+0,0,0,BEGIN { unlink "nytprof-test51-b.out", "nytprof-test51-c.out" }
--~--~---------~--~----~------------~-------~--~----~
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]
-~----------~----~----~----~------~----~------~--~---
