r60259 - in /trunk/libdevel-nytprof-perl: ./ bin/ debian/ demo/ lib/Devel/ lib/Devel/NYTProf/ t/
gregoa at users.alioth.debian.org
gregoa at users.alioth.debian.org
Mon Jul 12 15:49:23 UTC 2010
Author: gregoa
Date: Mon Jul 12 15:49:16 2010
New Revision: 60259
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=60259
Log:
New upstream release.
Modified:
trunk/libdevel-nytprof-perl/Changes
trunk/libdevel-nytprof-perl/FileHandle.h
trunk/libdevel-nytprof-perl/FileHandle.xs
trunk/libdevel-nytprof-perl/HACKING
trunk/libdevel-nytprof-perl/META.yml
trunk/libdevel-nytprof-perl/NYTProf.xs
trunk/libdevel-nytprof-perl/bin/nytprofhtml
trunk/libdevel-nytprof-perl/bin/nytprofmerge
trunk/libdevel-nytprof-perl/debian/changelog
trunk/libdevel-nytprof-perl/demo/demo-code.pl
trunk/libdevel-nytprof-perl/lib/Devel/NYTProf.pm
trunk/libdevel-nytprof-perl/lib/Devel/NYTProf/Core.pm
trunk/libdevel-nytprof-perl/lib/Devel/NYTProf/Data.pm
trunk/libdevel-nytprof-perl/lib/Devel/NYTProf/FileInfo.pm
trunk/libdevel-nytprof-perl/lib/Devel/NYTProf/Reader.pm
trunk/libdevel-nytprof-perl/t/test14.pm
trunk/libdevel-nytprof-perl/t/test14.rdt
trunk/libdevel-nytprof-perl/t/test18-goto2.pm
Modified: trunk/libdevel-nytprof-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-nytprof-perl/Changes?rev=60259&op=diff
==============================================================================
--- trunk/libdevel-nytprof-perl/Changes (original)
+++ trunk/libdevel-nytprof-perl/Changes Mon Jul 12 15:49:16 2010
@@ -2,15 +2,18 @@
Changes - List of significant changes to Devel::NYTProf
-(As of $Date: 2010-06-19 19:56:26 +0100 (Sat, 19 Jun 2010) $ $Revision: 1316 $)
+(As of $Date: 2010-07-09 14:06:43 +0100 (Fri, 09 Jul 2010) $ $Revision: 1332 $)
=cut
-TODO soonish
-
-subroutine profiler docs need update
-add u key to treemap to trigger moving 'up' a level
-add "calls N subs" to treemap mouseover box
+=head2 Changes in Devel::NYTProf 4.04 (svn 1332) 9th July 2010
+
+ Profile now reports presence of the slow regex match vars ($& $' $`).
+ The (cumulative inclusive) recursion time measured for subs that are involved
+ in recursion is now reported as 'recursion: ... sum of overlapping time'.
+ Trace log messages are now flushed immediately.
+ Reduced risk of crashes in embedded applications that don't handle PL_endav
+ carefully, like current versions of mod_perl.
=head2 Changes in Devel::NYTProf 4.03 (svn 1316) 19th June 2010
@@ -152,7 +155,7 @@
perl opcodes (e.g., system calls and regexs). They're treated like xsubs.
slowops=0 disables profiling of 'slowops'
slowops=1 puts timings into one package ("CORE::", eg CORE::sleep)
- slowops=2 (the defaut) puts timings into into the package that made the
+ slowops=2 (the default) puts timings into into the package that made the
call, e.g., "Foo::CORE:sleep" (note the single colon).
Added sigexit=1 option to enable a useable profile when the process
@@ -212,7 +215,7 @@
http://code.google.com/p/perl-devel-nytprof/issues/detail?id=15
Fixed to use correct scripts during test and so avoid permissions
issues, thanks to David Golden.
- Fixed suprious "Unable to determine line number" warnings
+ Fixed spurious "Unable to determine line number" warnings
when using options like -p, -n, -Mfoo.
Changed enable_profile() to discard the time spent since
Modified: trunk/libdevel-nytprof-perl/FileHandle.h
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-nytprof-perl/FileHandle.h?rev=60259&op=diff
==============================================================================
--- trunk/libdevel-nytprof-perl/FileHandle.h (original)
+++ trunk/libdevel-nytprof-perl/FileHandle.h Mon Jul 12 15:49:16 2010
@@ -58,6 +58,7 @@
#define NYTP_TAG_STRING '\''
#define NYTP_TAG_STRING_UTF8 '"'
#define NYTP_TAG_START_DEFLATE 'z'
+/* also add new items to nytp_tax_index below */
typedef enum {
nytp_no_tag,
@@ -95,6 +96,7 @@
unsigned int ppid, NV time_of_day);
size_t NYTP_write_process_end(NYTP_file ofile, unsigned int pid,
NV time_of_day);
+size_t NYTP_write_sawampersand(NYTP_file ofile, unsigned int fid, unsigned int line);
size_t NYTP_write_new_fid(NYTP_file ofile, unsigned int id,
unsigned int eval_fid, unsigned int eval_line_num,
unsigned int flags, unsigned int size,
Modified: trunk/libdevel-nytprof-perl/FileHandle.xs
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-nytprof-perl/FileHandle.xs?rev=60259&op=diff
==============================================================================
--- trunk/libdevel-nytprof-perl/FileHandle.xs (original)
+++ trunk/libdevel-nytprof-perl/FileHandle.xs Mon Jul 12 15:49:16 2010
@@ -888,6 +888,23 @@
}
size_t
+NYTP_write_sawampersand(NYTP_file ofile, unsigned int fid, unsigned int line)
+{
+ size_t total;
+ size_t retval;
+
+ total += retval = NYTP_write_attribute_unsigned(ofile, STR_WITH_LEN("sawampersand_fid"), fid);
+ if (retval < 1)
+ return retval;
+
+ total += retval = NYTP_write_attribute_unsigned(ofile, STR_WITH_LEN("sawampersand_line"), line);
+ if (retval < 1)
+ return retval;
+
+ return total;
+}
+
+size_t
NYTP_write_new_fid(NYTP_file ofile, unsigned int id, unsigned int eval_fid,
unsigned int eval_line_num, unsigned int flags,
unsigned int size, unsigned int mtime,
Modified: trunk/libdevel-nytprof-perl/HACKING
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-nytprof-perl/HACKING?rev=60259&op=diff
==============================================================================
--- trunk/libdevel-nytprof-perl/HACKING (original)
+++ trunk/libdevel-nytprof-perl/HACKING Mon Jul 12 15:49:16 2010
@@ -1,5 +1,5 @@
# vim: ts=8 sw=2 sts=0 noexpandtab:
-# $Id: HACKING 1279 2010-06-07 15:37:11Z tim.bunce at gmail.com $
+# $Id: HACKING 1329 2010-07-08 14:10:06Z tim.bunce at gmail.com $
HACKING Devel::NYTProf
======================
@@ -133,26 +133,13 @@
*** For core only
+See MemoryProfiling.pod file
+
Store raw NYTPROF option string in the data file.
Include parsed version in report index page.
Add actual size and mtime of fid to data file. (Already in data file as zero,
just needs the stat() call.) Don't alter errno.
-
-Generalize the concepts of clocks. Have a structure defining a 'clock' with
-pointers to functions to get the time, subtract times to get ticks, return
-the resolution etc. Give them names and attributes (cpu, realtime etc).
-User could then pick a clock by name. By default we'd pick the best available
-realtime clock (or best available cputime clock if usecputime=1 option set).
-
-[Conjectural terminology: "clock" means some measuring mechanism, like
-get_clock(), times(), getrusage(), that may yield multiple pieces of
-information, and "measure" is one specific item.
-Clock "time"=times(), measures: "time.user", "time.user+sys" etc
-Clock "clock"=clock_gettime(), measures: "clock.realtime", "clock.monotonic" etc
-Clock "rusage"=getrusage(), measures: "rusage.majflt", "rusage.nvcsw" etc
-Clock "memory" measures: "memory.bytes", "mem.allocs" etc
-]
Add help option which would print a summary of the options and exit.
Could also print list of available clocks for the clock=N option
@@ -177,14 +164,6 @@
entered (for the first time, to make it cheap) check if the sub name matches
the regex. If it does then save the current $DB::profile value and set a new one.
When the sub exits restore the previous $DB::profile value.
-
-Could optionally track resource usage per sub. Data sources could be perl sv
-arenas (clone visit() function from sv.c) to measure number of SVs & total SV
-memory, plus getrusage()). Abstract those into a structure with functions to
-subtract the difference. Then use the same logic to get inclusive and exclusive
-values as we use for inclusive and exclusive subroutine times.
-Also possibly track the memory allocated to lexical pad SVs
-(for given sub at given depth).
Work around OP_UNSTACK bug (http://rt.perl.org/rt3/Ticket/Display.html?id=60954)
while ( foo() ) { # all calls to foo should be from here
@@ -346,9 +325,6 @@
'self-contained' and can be archived and thrown around as a tarball/zip and
still used for further analysis.
-The pseudo-sub "main::BEGIN" doesn't appear to be 'called' in NYTProf data.
-Perhaps it should.
-
To stress-test NYTProf using perl's own test suite, set env vars:
NYTPROF='file=/tmp/nytprof.out:addpid=1:nameanonsubs=0:nameevals=0'
PERL5OPT='-d:NYTProf'
@@ -387,14 +363,6 @@
Option to add sub call and return events into the data file as they happen.
Would enable a dprofpp -T like output. See https://rt.cpan.org/Ticket/Display.html?id=50766
-For eval fid reports:
-- Add links to 'sibling' evals
-- Add eval information (evals and time) to file summary header
-
-Fix inconsistency in results of href_for_*() subs
-
-Make generation of call graph .dot files optional and/or optimize to make faster
-
String evals could/should be tied into the subroutine profiler.
That would give inclusive timings which we don't have at the moment.
The evals appear in the html report as if they're calls but the timings are
@@ -414,19 +382,10 @@
xs calling optimization) it'll be the most recent sub entry that was recorded.
Generate extra report pages for xsubs in packages that don't have source code.
-
-USE_SITECUSTOMIZE causes two "Unable to determine line number" warnings at start of
-every program:
- (-e:0) nextstate
- Unable to determine line number in -e
- (-e:0) gvsv(main::!)
- (-e:0) nextstate
- Unable to determine line number in -e
- (-e:0) const(PV("/usr/local/perl512-dev/lib/site_perl/5.12.0/sitecustomize.pl"\0))
-because it unshifts some code onto PL_preambleav (like -M/-V etc):
-"BEGIN { do {local $!; -f '%s/sitecustomize.pl'} && do '%s/sitecustomize.pl' }"
-which toke.c then concats into PL_linestr in the 'PL_preambled' block
-(where PL_perldb, PL_minus_E, PL_minus_n, PL_minus_p are handled).
-Would be nice to find a way to silence the warnings in this case.
-Even better if the profiler could know it was profiling preamble code.
-I can't see an obvious way but I'm fairly clueless re toke.c
+They're currently all dumped into the 'main' file.
+
+Docs describing how the subroutine profiler works need updating.
+Add 'u' key to treemap to trigger moving 'up' a level.
+Add "calls N subs" to treemap mouseover box
+Upgrade treemap to JIT version 2 (which has transition animations).
+
Modified: trunk/libdevel-nytprof-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-nytprof-perl/META.yml?rev=60259&op=diff
==============================================================================
--- trunk/libdevel-nytprof-perl/META.yml (original)
+++ trunk/libdevel-nytprof-perl/META.yml Mon Jul 12 15:49:16 2010
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: Devel-NYTProf
-version: 4.03
+version: 4.04
abstract: Powerful fast feature-rich perl source code profiler
author:
- Adam Kaplan <akaplan at cpan.org>, Tim Bunce <timb at cpan.org>
Modified: trunk/libdevel-nytprof-perl/NYTProf.xs
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-nytprof-perl/NYTProf.xs?rev=60259&op=diff
==============================================================================
--- trunk/libdevel-nytprof-perl/NYTProf.xs (original)
+++ trunk/libdevel-nytprof-perl/NYTProf.xs Mon Jul 12 15:49:16 2010
@@ -13,7 +13,7 @@
* Steve Peters, steve at fisharerojo.org
*
* ************************************************************************
- * $Id: NYTProf.xs 1290 2010-06-08 22:30:13Z tim.bunce at gmail.com $
+ * $Id: NYTProf.xs 1323 2010-07-07 17:05:28Z tim.bunce at gmail.com $
* ************************************************************************
*/
#ifndef WIN32
@@ -329,6 +329,7 @@
static char *last_executed_fileptr;
static unsigned int last_block_line;
static unsigned int last_sub_line;
+static bool last_sawampersand;
static unsigned int is_profiling; /* disable_profile() & enable_profile() */
static Pid_t last_pid;
static NV cumulative_overhead_ticks = 0.0;
@@ -374,6 +375,15 @@
static HV *sub_callers_hv;
static HV *pkg_fids_hv; /* currently just package names */
+#define CHECK_SAWAMPERSAND(fid,line) STMT_START { \
+ if (PL_sawampersand != last_sawampersand) { \
+ if (trace_level >= 1) \
+ logwarn("Slow regex match variable seen (first noted at %u:%u)\n", fid, line); \
+ NYTP_write_sawampersand(out, fid, line); \
+ last_sawampersand = PL_sawampersand; \
+ } \
+} STMT_END
+
/* macros for outputing profile data */
#ifndef HAS_GETPPID
#define getppid() 0
@@ -392,6 +402,11 @@
if (!logfh)
logfh = stderr;
vfprintf(logfh, pat, args);
+ /* Flush to ensure the log message gets pushed out to the kernel.
+ * This flush will be expensive but is needed to ensure the log has recent info
+ * if there's a core dump. Could add an option to disable flushing if needed.
+ */
+ fflush(logfh);
va_end(args);
}
@@ -1370,6 +1385,8 @@
logwarn("profile time overflow of %ld seconds discarded!\n", overflow);
reinit_if_forked(aTHX);
+
+ CHECK_SAWAMPERSAND(last_executed_fid, last_executed_line);
if (last_executed_fid) {
if (profile_blocks)
@@ -2416,8 +2433,10 @@
return run_original_op(op_type);
}
- if (!profile_stmts)
+ if (!profile_stmts) {
reinit_if_forked(aTHX);
+ CHECK_SAWAMPERSAND(last_executed_fid, last_executed_line);
+ }
if (trace_level >= 99) {
logwarn("profiling a call [op %ld, %s, seix %d]\n",
@@ -2950,6 +2969,12 @@
if (!PL_checkav) PL_checkav = newAV();
if (!PL_initav) PL_initav = newAV();
if (!PL_endav) PL_endav = newAV();
+ /* pre-extend PL_endav to reduce the chance of DB::_END realloc'ing
+ * it while END blocks are executed (which could upset some embedded
+ * applications that don't handle PL_endav carefully, like mod_perl)
+ */
+ av_extend(PL_endav, av_len(PL_endav)+30);
+
if (profile_start == NYTP_START_BEGIN) {
enable_profile(aTHX_ NULL);
} else {
@@ -3202,7 +3227,7 @@
}
if (trace_level >= 1)
- logwarn("~ writing sub line ranges of %ld subs\n", HvKEYS(hv));
+ logwarn("~ writing sub line ranges of %ld subs\n", (long)HvKEYS(hv));
/* Iterate over PL_DBsub writing out fid and source line range of subs.
* If filename is missing (i.e., because it's an xsub so has no source file)
@@ -3259,7 +3284,7 @@
if (!sub_callers_hv)
return;
if (trace_level >= 1)
- logwarn("~ writing sub callers for %ld subs\n", HvKEYS(sub_callers_hv));
+ logwarn("~ writing sub callers for %ld subs\n", (long)HvKEYS(sub_callers_hv));
hv_iterinit(sub_callers_hv);
while (NULL != (fid_line_rvhv = hv_iternextsv(sub_callers_hv, &called_subname, &called_subname_len))) {
@@ -4947,6 +4972,7 @@
av_unshift(PL_endav, 1); /* we want to be first */
av_store(PL_endav, 0, SvREFCNT_inc(enable_profile_sv));
}
+ av_extend(PL_endav, av_len(PL_endav)+20); /* see PL_endav in init_profiler() */
if (trace_level >= 1)
logwarn("~ INIT done\n");
Modified: trunk/libdevel-nytprof-perl/bin/nytprofhtml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-nytprof-perl/bin/nytprofhtml?rev=60259&op=diff
==============================================================================
--- trunk/libdevel-nytprof-perl/bin/nytprofhtml (original)
+++ trunk/libdevel-nytprof-perl/bin/nytprofhtml Mon Jul 12 15:49:16 2010
@@ -7,7 +7,7 @@
## http://search.cpan.org/~akaplan/Devel-NYTProf
##
##########################################################
-# $Id: nytprofhtml 1316 2010-06-19 18:56:26Z tim.bunce at gmail.com $
+# $Id: nytprofhtml 1329 2010-07-08 14:10:06Z tim.bunce at gmail.com $
###########################################################
use warnings;
use strict;
@@ -43,7 +43,7 @@
my $json_any = eval { require JSON::Any; JSON::Any->import; JSON::Any->new }
or warn "Can't load JSON::Any module - HTML visualizations skipped.\n";
-our $VERSION = '4.03';
+our $VERSION = '4.04';
if ($VERSION != $Devel::NYTProf::Core::VERSION) {
die "$0 version '$VERSION' doesn't match version '$Devel::NYTProf::Core::VERSION' of $INC{'Devel/NYTProf/Core.pm'}\n";
@@ -184,11 +184,36 @@
$reporter->set_param(
'taintmsg',
- qq{<div class="warn_title">WARNING!</div>\n
+ qq{<br /><div class="warn_title">WARNING!</div>\n
<div class="warn">The source file used to generate this report was modified
after the profiler data was generated.
The data might be out of sync with the modified source code so you should regenerate it.
-Meanwhile, the data on this page might not make much sense!</div><br />\n}
+Meanwhile, the data on this page might not make much sense!</div>\n}
+);
+
+$reporter->set_param(
+ 'sawampersand',
+ sub {
+ my ($profile, $fi) = @_;
+ my $line = $profile->{attribute}{sawampersand_line};
+ return qq{<br /><div class="warn_title">NOTE!</div>\n
+<div class="warn"><p>While profiling this file Perl noted the use of one or more special
+variables that impact the performance of <i>all</i> regular expressions in the program.</p>
+
+<p>Use of the "<tt>\$`</tt>", "<tt>\$&</tt>", and "<tt>\$'</tt>" variables should be replaced with faster alternatives.
+See the WARNING at the end of the <a href="http://perldoc.perl.org/perlre.html#Capture-buffers">
+Capture Buffers section of the perlre documentation</a>.</p>
+
+<p>The use is detected by perl at compile time but by NYTProf during execution.
+NYTProf first noted it when executing <a href="#$line">line $line</a>.
+That was probably the first statement executed by the program after perl
+compiled the code containing the variables.
+If the variables can't be found by studying the source code, try using the
+<a href="http://search.cpan.org/perldoc?Devel::FindAmpersand">Devel::FindAmpersand</a>
+module.</p>
+
+</div>\n}
+ }
);
$reporter->set_param(
@@ -571,7 +596,7 @@
$html .= sprintf qq{, avg %s/call}, fmt_time(($incl_time+$reci_time) / $count),
if $count > 1;
if ($rec_depth) {
- $html .= sprintf qq{, recursion: max depth %d, time %s},
+ $html .= sprintf qq{, recursion: max depth %d, sum of overlapping time %s},
$rec_depth, fmt_time($reci_time);
}
$html;
@@ -1271,6 +1296,8 @@
my $allTimes = $profile->{attribute}{total_stmts_duration};
my $allCalls = $profile->{attribute}{total_stmts_measured}
- $profile->{attribute}{total_stmts_discounted};
+ # file in which sawampersand was noted during profiling
+ my $sawampersand_fi = $profile->fileinfo_of($profile->{attribute}{sawampersand_fid}, 1);
my (@t_stmt_exec, @t_stmt_time);
my @fis = $profile->noneval_fileinfos;
@@ -1280,16 +1307,17 @@
foreach my $fi (@fis) {
my $meta = $fi->meta;
+ my $fid = $fi->fid;
my @extra;
+ my $css_class = 'index';
# The stats in this table include rolled up sums of nested evals.
- my @has_evals = $fi->has_evals(1);
my ($eval_stmts, $eval_time) = (0,0);
- if (@has_evals) {
+ if (my @has_evals = $fi->has_evals(1)) {
my $n_evals = scalar @has_evals;
my $msg = sprintf "including %d string eval%s", $n_evals, ($n_evals>1) ? "s" : "";
- if (my @nested = grep { $_->eval_fid != $fi->fid } @has_evals) {
+ if (my @nested = grep { $_->eval_fid != $fid } @has_evals) {
$msg .= sprintf ": %d direct plus %d nested",
$n_evals- at nested, scalar @nested;
}
@@ -1297,8 +1325,16 @@
$eval_stmts = sum(map { $_->sum_of_stmts_count } @has_evals);
$eval_time = sum(map { $_->sum_of_stmts_time } @has_evals);
}
-
- print $fh qq{<tr class="index">};
+ # is this file one where we sawampersand (or contains an eval that is)?
+ if ($sawampersand_fi && $fi == ($sawampersand_fi->outer || $sawampersand_fi)) {
+ my $in_eval = ($fi == $sawampersand_fi)
+ ? 'here'
+ : sprintf q{<a %s>in eval here</a>}, $reporter->href_for_file($sawampersand_fi, undef, 'line');
+ push @extra, sprintf qq{variables that impact regex performance for whole application seen $in_eval},
+ $css_class = "warn $css_class";
+ }
+
+ print $fh qq{<tr class="$css_class">};
my $stmts = $meta->{'calls'} + $eval_stmts;
print $fh determine_severity($stmts, undef, 0,
@@ -1321,7 +1357,7 @@
print $fh sprintf q{<td><a name="f%s" title="%s">%s</a> %s</td>},
$fi->fid, $fi->abs_filename, $fi->filename_without_inc,
- (@extra) ? sprintf("(%s)", join ", ", @extra) : "";
+ (@extra) ? sprintf("(%s)", join "; ", @extra) : "";
print $fh "</tr>\n";
}
print $fh "</tbody>\n";
Modified: trunk/libdevel-nytprof-perl/bin/nytprofmerge
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-nytprof-perl/bin/nytprofmerge?rev=60259&op=diff
==============================================================================
--- trunk/libdevel-nytprof-perl/bin/nytprofmerge (original)
+++ trunk/libdevel-nytprof-perl/bin/nytprofmerge Mon Jul 12 15:49:16 2010
@@ -18,7 +18,7 @@
require Devel::NYTProf::Data;
use List::Util qw(min);
-our $VERSION = '4.03';
+our $VERSION = '4.04';
if ($VERSION != $Devel::NYTProf::Core::VERSION) {
die "$0 version '$VERSION' doesn't match version '$Devel::NYTProf::Core::VERSION' of $INC{'Devel/NYTProf/Core.pm'}\n";
Modified: trunk/libdevel-nytprof-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-nytprof-perl/debian/changelog?rev=60259&op=diff
==============================================================================
--- trunk/libdevel-nytprof-perl/debian/changelog (original)
+++ trunk/libdevel-nytprof-perl/debian/changelog Mon Jul 12 15:49:16 2010
@@ -1,3 +1,9 @@
+libdevel-nytprof-perl (4.04-1) UNRELEASED; urgency=low
+
+ * New upstream release.
+
+ -- gregor herrmann <gregoa at debian.org> Mon, 12 Jul 2010 17:48:04 +0200
+
libdevel-nytprof-perl (4.03-1) unstable; urgency=low
* New upstream release.
Modified: trunk/libdevel-nytprof-perl/demo/demo-code.pl
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-nytprof-perl/demo/demo-code.pl?rev=60259&op=diff
==============================================================================
--- trunk/libdevel-nytprof-perl/demo/demo-code.pl (original)
+++ trunk/libdevel-nytprof-perl/demo/demo-code.pl Mon Jul 12 15:49:16 2010
@@ -1,4 +1,5 @@
use strict 0.1; # use UNIVERSAL::VERSION
+use English; # demo detection of $& et al
use Benchmark;
use File::Find;
@@ -28,6 +29,7 @@
# With all line profilers except NYTProf, the time for that expression gets
# assigned to the previous statement, i.e., the last statement executed in foo()!
foo() && 'aaaaaaaaaaa' =~ /((a{0,5}){0,5})*[c]/;
+
1;
}
Modified: trunk/libdevel-nytprof-perl/lib/Devel/NYTProf.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-nytprof-perl/lib/Devel/NYTProf.pm?rev=60259&op=diff
==============================================================================
--- trunk/libdevel-nytprof-perl/lib/Devel/NYTProf.pm (original)
+++ trunk/libdevel-nytprof-perl/lib/Devel/NYTProf.pm Mon Jul 12 15:49:16 2010
@@ -7,11 +7,11 @@
## http://search.cpan.org/dist/Devel-NYTProf/
##
###########################################################
-## $Id: NYTProf.pm 1316 2010-06-19 18:56:26Z tim.bunce at gmail.com $
+## $Id: NYTProf.pm 1329 2010-07-08 14:10:06Z tim.bunce at gmail.com $
###########################################################
package Devel::NYTProf;
-our $VERSION = '4.03';
+our $VERSION = '4.04';
package # hide the package from the PAUSE indexer
DB;
Modified: trunk/libdevel-nytprof-perl/lib/Devel/NYTProf/Core.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-nytprof-perl/lib/Devel/NYTProf/Core.pm?rev=60259&op=diff
==============================================================================
--- trunk/libdevel-nytprof-perl/lib/Devel/NYTProf/Core.pm (original)
+++ trunk/libdevel-nytprof-perl/lib/Devel/NYTProf/Core.pm Mon Jul 12 15:49:16 2010
@@ -7,14 +7,14 @@
# http://search.cpan.org/dist/Devel-NYTProf/
#
###########################################################
-# $Id: Core.pm 1316 2010-06-19 18:56:26Z tim.bunce at gmail.com $
+# $Id: Core.pm 1329 2010-07-08 14:10:06Z tim.bunce at gmail.com $
###########################################################
package Devel::NYTProf::Core;
use XSLoader;
-our $VERSION = '4.03'; # increment with XS changes too
+our $VERSION = '4.04'; # increment with XS changes too
XSLoader::load('Devel::NYTProf', $VERSION);
Modified: trunk/libdevel-nytprof-perl/lib/Devel/NYTProf/Data.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-nytprof-perl/lib/Devel/NYTProf/Data.pm?rev=60259&op=diff
==============================================================================
--- trunk/libdevel-nytprof-perl/lib/Devel/NYTProf/Data.pm (original)
+++ trunk/libdevel-nytprof-perl/lib/Devel/NYTProf/Data.pm Mon Jul 12 15:49:16 2010
@@ -7,7 +7,7 @@
# http://search.cpan.org/dist/Devel-NYTProf/
#
###########################################################
-# $Id: Data.pm 1310 2010-06-17 14:51:01Z tim.bunce at gmail.com $
+# $Id: Data.pm 1325 2010-07-08 10:48:58Z tim.bunce at gmail.com $
###########################################################
package Devel::NYTProf::Data;
@@ -333,10 +333,10 @@
sub fileinfo_of {
- my $self = shift;
- my $arg = shift;
+ my ($self, $arg, $silent_if_undef) = @_;
+
if (not defined $arg) {
- carp "Can't resolve fid of undef value";
+ carp "Can't resolve fid of undef value" unless $silent_if_undef;
return undef;
}
@@ -542,8 +542,8 @@
$profile->normalize_variables;
Traverses the profile data structure and normalizes highly variable data, such
-as the time, in order that the data can more easily be compared. This is used,
-for example, by the test suite.
+as the time, in order that the data can more easily be compared. This is mainly of
+use to the test suite.
The data normalized is:
@@ -582,9 +582,9 @@
basetime xs_version perl_version clock_id ticks_per_sec nv_size
profiler_duration profiler_end_time profiler_start_time
total_stmts_duration total_stmts_measured total_stmts_discounted
- total_sub_calls
+ total_sub_calls sawampersand_line
)) {
- $attributes->{$attr} = 0;
+ $attributes->{$attr} = 0 if exists $attributes->{$attr};
}
for my $attr (qw(PL_perldb)) {
Modified: trunk/libdevel-nytprof-perl/lib/Devel/NYTProf/FileInfo.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-nytprof-perl/lib/Devel/NYTProf/FileInfo.pm?rev=60259&op=diff
==============================================================================
--- trunk/libdevel-nytprof-perl/lib/Devel/NYTProf/FileInfo.pm (original)
+++ trunk/libdevel-nytprof-perl/lib/Devel/NYTProf/FileInfo.pm Mon Jul 12 15:49:16 2010
@@ -275,12 +275,15 @@
my $s_ltd = $survivor_fi->line_time_data; # XXX line only
my $s_scl = $survivor_fi->sub_call_lines;
+ my %donor_fids;
for my $donor_fi (@donors) {
# copy data from donor to survivor_fi then delete donor
+ my $donor_fid = $donor_fi->fid;
+ $donor_fids{$donor_fid} = $donor_fi;
warn sprintf "collapse_sibling_evals: processing donor fid %d: %s\n",
- $donor_fi->fid, $donor_fi->filename
+ $donor_fid, $donor_fi->filename
if trace_level() >= 3;
# XXX nested evals not handled yet
@@ -294,7 +297,7 @@
for my $si (@subs_defined) {
warn sprintf " - moving from fid %d: sub %s\n",
- $donor_fi->fid, $si->subname
+ $donor_fid, $si->subname
if trace_level() >= 4;
$si->_alter_fileinfo($donor_fi, $survivor_fi);
warn sprintf " - moving done\n"
@@ -336,41 +339,28 @@
my $s_tld_l = $s_ltd->[$line] ||= [];
$s_tld_l->[$_] += $d_tld_l->[$_] for (0..@$d_tld_l-1);
warn sprintf "%d:%d: @$s_tld_l from @$d_tld_l fid:%d\n",
- $survivor_fi->fid, $line, $donor_fi->fid if 0;
- }
-
- push @{ $survivor_fi->meta->{merged_fids} }, $donor_fi->fid;
+ $survivor_fi->fid, $line, $donor_fid if 0;
+ }
+
+ push @{ $survivor_fi->meta->{merged_fids} }, $donor_fid;
++$survivor_fi->meta->{merged_fids_src_varied}
if $donor_fi->src_digest ne $survivor_fi->src_digest;
- # remove eval from NYTP_FIDi_HAS_EVALS
- # XXX DISABLED - moved to after donor loop
- if (0 and my $eval_fis = $self->[NYTP_FIDi_HAS_EVALS()]) {
- my $count = @$eval_fis;
- # XXX this is very expensive when there are many siblings
- # could possibly be deferred till outside the donor loop
- # so alll donors could be deleted at once
- while ($count--) {
- if ($eval_fis->[$count] == $donor_fi) {
- splice @$eval_fis, $count, 1;
- undef $count; # mark as done
- last;
- }
- }
- warn "_delete_eval missed for ".$donor_fi->filename
- if defined $count;
- }
-
$donor_fi->_nullify;
}
- # remove donors
+ # remove donors from parent NYTP_FIDi_HAS_EVALS
if (my $eval_fis = $self->[NYTP_FIDi_HAS_EVALS()]) {
my %donors = map { +"$_" => 1 } @donors;
my $count = @$eval_fis;
@$eval_fis = grep { !$donors{$_} } @$eval_fis;
warn "_delete_eval mismatch"
if @$eval_fis != $count - @donors;
+ }
+
+ # update sawampersand_fid if it's one of the now-dead donors
+ if ($donor_fids{ $profile->attributes->{sawampersand_fid} || 0 }) {
+ $profile->attributes->{sawampersand_fid} = $survivor_fi->fid;
}
# now the fid merging is complete...
Modified: trunk/libdevel-nytprof-perl/lib/Devel/NYTProf/Reader.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-nytprof-perl/lib/Devel/NYTProf/Reader.pm?rev=60259&op=diff
==============================================================================
--- trunk/libdevel-nytprof-perl/lib/Devel/NYTProf/Reader.pm (original)
+++ trunk/libdevel-nytprof-perl/lib/Devel/NYTProf/Reader.pm Mon Jul 12 15:49:16 2010
@@ -7,11 +7,11 @@
## http://search.cpan.org/dist/Devel-NYTProf/
##
###########################################################
-## $Id: Reader.pm 1316 2010-06-19 18:56:26Z tim.bunce at gmail.com $
+## $Id: Reader.pm 1329 2010-07-08 14:10:06Z tim.bunce at gmail.com $
###########################################################
package Devel::NYTProf::Reader;
-our $VERSION = '4.03';
+our $VERSION = '4.04';
use warnings;
use strict;
@@ -74,6 +74,10 @@
taintmsg => "# WARNING!\n"
. "# The source file used in generating this report has been modified\n"
. "# since generating the profiler database. It might be out of sync\n",
+ sawampersand => "# NOTE!\n"
+ . "# This file uses special regexp match variables that impact the performance\n"
+ . "# of all regular expression in the program!\n"
+ . "# See WARNING in http://perldoc.perl.org/perlre.html#Capture-buffers\n",
};
bless($self, $class);
@@ -347,6 +351,10 @@
# In this case we need to warn the user as the report would be garbled.
print OUT $self->get_param('taintmsg', [$profile, $fi])
if !$fi->has_savesrc and $self->file_has_been_modified($filestr);
+
+ print OUT $self->get_param('sawampersand', [$profile, $fi])
+ if $profile->{attribute}{sawampersand_fid}
+ && $fi->fid == $profile->{attribute}{sawampersand_fid};
print OUT $self->get_param('merged_fids', [$profile, $fi])
if $fi->meta->{merged_fids};
Modified: trunk/libdevel-nytprof-perl/t/test14.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-nytprof-perl/t/test14.pm?rev=60259&op=diff
==============================================================================
--- trunk/libdevel-nytprof-perl/t/test14.pm (original)
+++ trunk/libdevel-nytprof-perl/t/test14.pm Mon Jul 12 15:49:16 2010
@@ -10,7 +10,7 @@
1;
__END__
sub foo {
- 1;
+ $&;
}
sub bar {
Modified: trunk/libdevel-nytprof-perl/t/test14.rdt
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-nytprof-perl/t/test14.rdt?rev=60259&op=diff
==============================================================================
--- trunk/libdevel-nytprof-perl/t/test14.rdt (original)
+++ trunk/libdevel-nytprof-perl/t/test14.rdt Mon Jul 12 15:49:16 2010
@@ -7,6 +7,8 @@
attribute profiler_duration 0
attribute profiler_end_time 0
attribute profiler_start_time 0
+attribute sawampersand_fid 3
+attribute sawampersand_line 0
attribute ticks_per_sec 0
attribute total_stmts_discounted 0
attribute total_stmts_duration 0
Modified: trunk/libdevel-nytprof-perl/t/test18-goto2.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-nytprof-perl/t/test18-goto2.pm?rev=60259&op=diff
==============================================================================
--- trunk/libdevel-nytprof-perl/t/test18-goto2.pm (original)
+++ trunk/libdevel-nytprof-perl/t/test18-goto2.pm Mon Jul 12 15:49:16 2010
@@ -5,4 +5,6 @@
delete $Test18::{longmess_jmp};
*longmess_jmp = *longmess_real;
+my $dummy = $&; # also test sawampersand
+
1;
More information about the Pkg-perl-cvs-commits
mailing list