@@ -12,6 +12,9 @@ NYTProf.o
blib/
*.tar.gz
*.o
+*.obj
+*.pdb
+*.def
*.c
*.bs
*.out
@@ -0,0 +1,31 @@
+language: perl
+
+perl:
+ - "blead"
+ - "blead-thr-mb-shrplib-dbg"
+ - "5.20"
+ - "5.20-extras"
+ - "5.20-thr-mb-shrplib-dbg"
+ - "5.18"
+ - "5.18-extras"
+ - "5.16"
+ - "5.14"
+ - "5.12"
+ - "5.10"
+ - "5.8"
+
+before_install:
+ - git clone git://github.com/travis-perl/helpers ~/travis-perl-helpers
+ - source ~/travis-perl-helpers/init
+ - build-perl
+ - perl -V
+ - build-dist
+ - cd $BUILD_DIR # $BUILD_DIR is set by the build-dist command
+
+install:
+ - cpan-install --deps # installs prereqs, including recommends
+ - cpanm Test::Pod Test::Pod::Coverage || true
+ - cpanm Test::Portability::Files || true
+
+notifications:
+ irc: "irc.perl.org#nytprof"
@@ -4,6 +4,28 @@ Changes - History of significant changes in Devel::NYTProf
=cut
+=head2 Changes in Devel::NYTProf 5.07
+
+ Fixed use of nytprofcalls and flamegraph scripts to not require PATH #21
+ Fixed nytprofhtml --open for KDE4 thanks to HMBRAND RT#99080
+ Fixed for installs into directory path with spaces, mohawk2 #40
+ Fixed printf NV conversion compiler warnings thanks to zefram RT#91986
+ Disabled optimize in t/test25-strevalb.t if -DDEBUGGING and perl >= 5.20
+ as workaround for perl RT#70211, #38
+
+ Added 'addtimestamp' option to add a timestamp to the output filename
+ (similar to addpid option), PR#17 thanks to Naosuke Yokoe (zentooo)
+ Added nytprofpf script to generate reports in the plat_forms format
+ http://www.plat-forms.org PR#11 thanks to Holger Schmeisky.
+ Added ability to increase the maximum length of a subroutine name #44
+
+ Optimized output performance on threaded perl, thanks to bulk88. PR#27
+
+ Add docs re FCGI::Engine and open('-|') #20
+ Corrected typo in nytprofhtml thanks to wollmers #41
+ Fixed link to screencast, thanks to Herwin. #19
+ Added hint to use --no-flame for big reports. #28
+
=head2 Changes in Devel::NYTProf 5.06 - 12th Sept 2013
Fixed for perl 5.19.4. RT#88288 thanks to sprout.
@@ -17,6 +17,14 @@
/* Arguably this header is naughty, as it's not self contained, because it
assumes that stdlib.h has already been included (via perl.h) */
+#if defined(PERL_IMPLICIT_SYS) && !defined(NO_XSLOCKS)
+/* on Win32 XSUB.h redirects stdio to PerlIO, interp context is then required */
+# define NYTP_IO_dTHX dTHX
+# define NYTP_IO_NEEDS_THX
+#else
+# define NYTP_IO_dTHX dNOOP
+#endif
+
typedef struct NYTP_file_t *NYTP_file;
void NYTP_start_deflate(NYTP_file file, int compression_level);
@@ -7,10 +7,11 @@
* ************************************************************************
*/
+#define PERL_NO_GET_CONTEXT /* we want efficiency */
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
-#if defined(PERL_IMPLICIT_SYS)
+#if defined(PERL_IMPLICIT_SYS) && !defined(NO_XSLOCKS)
# ifndef fgets
# define fgets PerlSIO_fgets
# endif
@@ -57,6 +58,10 @@
struct NYTP_file_t {
FILE *file;
+#ifdef PERL_IMPLICIT_CONTEXT
+ tTHX aTHX; /* on 5.8 and older, pTHX contains a "register" which is not
+ compatible with a struct def, so use something else */
+#endif
#ifdef HAS_ZLIB
unsigned char state;
bool stdio_at_eof;
@@ -69,6 +74,16 @@ struct NYTP_file_t {
#endif
};
+/* unlike dTHX which contains a function call, and therefore can never be
+ optimized away, even if return value isn't used, the below will optimize away
+ if NO_XSLOCKS is defined and PerlIO is not being used (i.e. native C lib
+ IO is being used on Win32 )*/
+#ifdef PERL_IMPLICIT_CONTEXT
+# define dNFTHX(x) dTHXa((x)->aTHX)
+#else
+# define dNFTHX(x) dNOOP
+#endif
+
/* XXX The proper return value would be Off_t */
long
NYTP_tell(NYTP_file file) {
@@ -82,7 +97,10 @@ NYTP_tell(NYTP_file file) {
? file->zs.total_out : file->zs.total_in;
}
#endif
- return (long)ftell(file->file);
+ {
+ dNFTHX(file);
+ return (long)ftell(file->file);
+ }
}
#ifdef HAS_ZLIB
@@ -189,6 +207,7 @@ NYTP_start_inflate(NYTP_file file) {
NYTP_file
NYTP_open(const char *name, const char *mode) {
+ dTHX;
FILE *raw_file = fopen(name, mode);
NYTP_file file;
ERRNO_PROBE;
@@ -199,6 +218,9 @@ NYTP_open(const char *name, const char *mode) {
Newx(file, 1, struct NYTP_file_t);
file->file = raw_file;
+#ifdef PERL_IMPLICIT_CONTEXT
+ file->aTHX = aTHX;
+#endif
#ifdef HAS_ZLIB
file->state = NYTP_FILE_STDIO;
file->count = 0;
@@ -234,8 +256,9 @@ grab_input(NYTP_file ifile) {
if (got == 0) {
if (!feof(ifile->file)) {
- dTHX;
- croak("grab_input failed: %d (%s)", errno, strerror(errno));
+ int eno = errno;
+ dNFTHX(ifile);
+ croak("grab_input failed: %d (%s)", eno, strerror(eno));
}
ifile->stdio_at_eof = TRUE;
}
@@ -285,6 +308,7 @@ grab_input(NYTP_file ifile) {
size_t
NYTP_read_unchecked(NYTP_file ifile, void *buffer, size_t len) {
+ dNFTHX(ifile);
#ifdef HAS_ZLIB
size_t result = 0;
#endif
@@ -387,18 +411,21 @@ NYTP_gets(NYTP_file ifile, char **buffer_p, size_t *len_p) {
#endif
CROAK_IF_NOT_STDIO(ifile, "NYTP_gets");
- while(fgets(buffer + prev_len, (int)(len - prev_len), ifile->file)) {
- /* We know that there are no '\0' bytes in the part we've already
- read, so don't bother running strlen() over that part. */
- char *end = buffer + prev_len + strlen(buffer + prev_len);
- if (end[-1] == '\n') {
- *buffer_p = buffer;
- *len_p = len;
- return end;
+ {
+ dNFTHX(ifile);
+ while(fgets(buffer + prev_len, (int)(len - prev_len), ifile->file)) {
+ /* We know that there are no '\0' bytes in the part we've already
+ read, so don't bother running strlen() over that part. */
+ char *end = buffer + prev_len + strlen(buffer + prev_len);
+ if (end[-1] == '\n') {
+ *buffer_p = buffer;
+ *len_p = len;
+ return end;
+ }
+ prev_len = len - 1; /* -1 to take off the '\0' at the end */
+ len *= 2;
+ buffer = (char *)saferealloc(buffer, len);
}
- prev_len = len - 1; /* -1 to take off the '\0' at the end */
- len *= 2;
- buffer = (char *)saferealloc(buffer, len);
}
*buffer_p = buffer;
*len_p = len;
@@ -471,9 +498,10 @@ flush_output(NYTP_file ofile, int flush) {
where += count;
avail -= count;
} else {
- dTHX;
- croak("fwrite in flush error %d: %s", errno,
- strerror(errno));
+ int eno = errno;
+ dNFTHX(ofile);
+ croak("fwrite in flush error %d: %s", eno,
+ strerror(eno));
}
}
ofile->zs.next_out = (Bytef *) ofile->small_buffer;
@@ -509,10 +537,13 @@ NYTP_write(NYTP_file ofile, const void *buffer, size_t len) {
/* http://www.opengroup.org/platform/resolutions/bwg98-007.html */
if (len == 0)
return len;
- if (fwrite(buffer, 1, len, ofile->file) < 1) {
- dTHX;
- croak("fwrite error %d writing %ld bytes to fd%d: %s",
- errno, (long)len, fileno(ofile->file), strerror(errno));
+ {
+ dNFTHX(ofile);
+ if (fwrite(buffer, 1, len, ofile->file) < 1) {
+ int eno = errno;
+ croak("fwrite error %d writing %ld bytes to fd%d: %s",
+ eno, (long)len, fileno(ofile->file), strerror(eno));
+ }
}
return len;
}
@@ -553,7 +584,10 @@ NYTP_printf(NYTP_file ofile, const char *format, ...) {
CROAK_IF_NOT_STDIO(ofile, "NYTP_printf");
va_start(args, format);
- retval = vfprintf(ofile->file, format, args);
+ {
+ dNFTHX(ofile);
+ retval = vfprintf(ofile->file, format, args);
+ }
va_end(args);
return retval;
@@ -567,7 +601,10 @@ NYTP_flush(NYTP_file file) {
flush_output(file, Z_SYNC_FLUSH);
}
#endif
- return fflush(file->file);
+ {
+ dNFTHX(file);
+ return fflush(file->file);
+ }
}
int
@@ -578,24 +615,30 @@ NYTP_eof(NYTP_file ifile) {
return ifile->zlib_at_eof;
}
#endif
- return feof(ifile->file);
+ {
+ dNFTHX(ifile);
+ return feof(ifile->file);
+ }
}
const char *
NYTP_fstrerror(NYTP_file file) {
- dTHX;
#ifdef HAS_ZLIB
if (FILE_STATE(file) == NYTP_FILE_DEFLATE || FILE_STATE(file) == NYTP_FILE_INFLATE) {
return file->zs.msg;
}
#endif
- return strerror(errno);
+ {
+ dNFTHX(file);
+ return strerror(errno);
+ }
}
int
NYTP_close(NYTP_file file, int discard) {
FILE *raw_file = file->file;
int result;
+ dNFTHX(file);
ERRNO_PROBE;
#ifdef HAS_ZLIB
@@ -835,7 +878,10 @@ NYTP_write_comment(NYTP_file ofile, const char *format, ...) {
retval = NYTP_write(ofile, s, len);
} else {
CROAK_IF_NOT_STDIO(ofile, "NYTP_printf");
- retval = vfprintf(ofile->file, format, args);
+ {
+ dNFTHX(ofile);
+ retval = vfprintf(ofile->file, format, args);
+ }
}
va_end(args);
@@ -917,7 +963,7 @@ NYTP_write_attribute_nv(NYTP_file ofile, const char *key,
size_t key_len, NV value)
{
char buffer[NV_DIG+20]; /* see Perl_sv_2pv_flags */
- const size_t len = my_snprintf(buffer, sizeof(buffer), "%g", value);
+ const size_t len = my_snprintf(buffer, sizeof(buffer), "%"NVgf, value);
return NYTP_write_attribute_string(ofile, key, key_len, buffer, len);
}
@@ -1073,6 +1119,7 @@ write_time_common(NYTP_file ofile, unsigned char tag, I32 elapsed, U32 overflow,
size_t retval;
if (overflow) {
+ dNFTHX(ofile);
/* XXX needs protocol change to output a new time-overflow tag */
fprintf(stderr, "profile time overflow of %lu seconds discarded!\n",
(unsigned long)overflow);
@@ -2,6 +2,7 @@
.gitignore
.indent.pro
.perltidyrc
+.travis.yml
Changes
FileHandle.h
FileHandle.xs
@@ -19,6 +20,7 @@ bin/nytprofcg
bin/nytprofcsv
bin/nytprofhtml
bin/nytprofmerge
+bin/nytprofpf
demo/1m_stmts.pl
demo/README
demo/closure.pl
@@ -83,6 +85,7 @@ t/test01.t
t/test01.x
t/test02.calls
t/test02.p
+t/test02.pf
t/test02.rdt
t/test02.t
t/test02.x
@@ -4,7 +4,7 @@
"Tim Bunce <timb@cpan.org>"
],
"dynamic_config" : 1,
- "generated_by" : "ExtUtils::MakeMaker version 6.68, CPAN::Meta::Converter version 2.131560",
+ "generated_by" : "ExtUtils::MakeMaker version 6.66, CPAN::Meta::Converter version 2.142690",
"license" : [
"perl_5"
],
@@ -22,23 +22,6 @@
"SVG"
]
},
- "prereqs" : {
- "build" : {
- "requires" : {
- "ExtUtils::MakeMaker" : "0"
- }
- },
- "runtime" : {
- "requires" : {
- "Getopt::Long" : "0",
- "JSON::Any" : "0",
- "List::Util" : "0",
- "Test::Differences" : "0.60",
- "Test::More" : "0.84",
- "XSLoader" : "0"
- }
- }
- },
"release_status" : "stable",
"resources" : {
"bugtracker" : {
@@ -56,5 +39,5 @@
},
"x_MailingList" : "http://groups.google.com/group/develnytprof-dev"
},
- "version" : "5.06"
+ "version" : "5.07"
}
@@ -2,14 +2,13 @@
abstract: 'Powerful fast feature-rich Perl source code profiler'
author:
- 'Tim Bunce <timb@cpan.org>'
-build_requires:
- ExtUtils::MakeMaker: 0
+build_requires: {}
dynamic_config: 1
-generated_by: 'ExtUtils::MakeMaker version 6.68, CPAN::Meta::Converter version 2.131560'
+generated_by: 'ExtUtils::MakeMaker version 6.66, CPAN::Meta::Converter version 2.142690'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
- version: 1.4
+ version: '1.4'
name: Devel-NYTProf
no_index:
directory:
@@ -17,17 +16,10 @@ no_index:
- inc
package:
- SVG
-requires:
- Getopt::Long: 0
- JSON::Any: 0
- List::Util: 0
- Test::Differences: 0.60
- Test::More: 0.84
- XSLoader: 0
resources:
MailingList: http://groups.google.com/group/develnytprof-dev
bugtracker: https://github.com/timbunce/devel-nytprof/issues
homepage: https://code.google.com/p/perl-devel-nytprof/
license: http://dev.perl.org/licenses/
repository: git://github.com/timbunce/devel-nytprof.git
-version: 5.06
+version: '5.07'
@@ -32,6 +32,7 @@ if ($ENV{PERL_CORE}) {
'bin/nytprofcsv' => '$(INST_MAN1DIR)/nytprofcsv.1',
'bin/nytprofcalls'=> '$(INST_MAN1DIR)/nytprofcalls.1',
'bin/nytprofcg' => '$(INST_MAN1DIR)/nytprofcg.1',
+ 'bin/nytprofpf' => '$(INST_MAN1DIR)/nytprofpf.1'
} );
}
@@ -102,6 +103,10 @@ if ($opt_assert or (not defined $opt_assert and $is_developer)) {
$mm_opts{DEFINE} .= " -DUSE_HARD_ASSERT";
}
+if ($ENV{NYTP_MAX_SUB_NAME_LEN}) {
+ $mm_opts{DEFINE} .= " -DNYTP_MAX_SUB_NAME_LEN=$ENV{NYTP_MAX_SUB_NAME_LEN}";
+}
+
$mm_opts{LICENSE} = 'perl' if $ExtUtils::MakeMaker::VERSION >= 6.3002;
$mm_opts{OPTIMIZE} = '-g' if $opt_g;
$mm_opts{CCFLAGS} = "-pg" if $opt_pg;
@@ -161,7 +166,7 @@ WriteMakefile(
},
LIBS => [join ' ', @libs],
OBJECT => q/$(O_FILES)/,
- EXE_FILES => ['bin/nytprofhtml', 'bin/flamegraph.pl', 'bin/nytprofcsv', 'bin/nytprofcalls', 'bin/nytprofcg', 'bin/nytprofmerge'],
+ EXE_FILES => ['bin/nytprofhtml', 'bin/flamegraph.pl', 'bin/nytprofcsv', 'bin/nytprofcalls', 'bin/nytprofcg', 'bin/nytprofmerge', 'bin/nytprofpf'],
@man,
INC => $INCLUDE,
clean => {
@@ -14,9 +14,7 @@
*
* ************************************************************************
*/
-#ifndef WIN32
#define PERL_NO_GET_CONTEXT /* we want efficiency */
-#endif
#include "EXTERN.h"
#include "perl.h"
@@ -108,6 +106,10 @@ Perl_gv_fetchfile_flags(pTHX_ const char *const name, const STRLEN namelen, cons
#define ZLIB_VERSION "0"
#endif
+#ifndef NYTP_MAX_SUB_NAME_LEN
+#define NYTP_MAX_SUB_NAME_LEN 500
+#endif
+
#define NYTP_FILE_MAJOR_VERSION 5
#define NYTP_FILE_MINOR_VERSION 0
@@ -120,6 +122,7 @@ Perl_gv_fetchfile_flags(pTHX_ const char *const name, const STRLEN namelen, cons
#define NYTP_OPTf_ADDPID 0x0001 /* append .pid to output filename */
#define NYTP_OPTf_OPTIMIZE 0x0002 /* affect $^P & 0x04 */
#define NYTP_OPTf_SAVESRC 0x0004 /* copy source code lines into profile data */
+#define NYTP_OPTf_ADDTIMESTAMP 0x0008 /* append timestamp to output filename */
#define NYTP_FIDf_IS_PMC 0x0001 /* .pm probably really loaded as .pmc */
#define NYTP_FIDf_VIA_STMT 0x0002 /* fid first seen by stmt profiler */
@@ -236,6 +239,8 @@ static char PROF_output_file[MAXPATHLEN+1] = "nytprof.out";
static unsigned int profile_opts = NYTP_OPTf_OPTIMIZE | NYTP_OPTf_SAVESRC;
static int profile_start = NYTP_START_BEGIN; /* when to start profiling */
+static char *nytp_panic_overflow_msg_fmt = "panic: buffer overflow of %s on '%s' (see TROUBLESHOOTING section of the documentation)";
+
struct NYTP_options_t {
const char *option_name;
IV option_iv;
@@ -298,11 +303,12 @@ and write the options to the stream when profiling starts.
/* time tracking */
#ifdef HAS_CLOCK_GETTIME
+
/* http://www.freebsd.org/cgi/man.cgi?query=clock_gettime
* http://webnews.giga.net.tw/article//mailing.freebsd.performance/710
* http://sean.chittenden.org/news/2008/06/01/
* Explanation of why gettimeofday() (and presumably CLOCK_REALTIME) may go backwards:
- * http://groups.google.com/group/comp.os.linux.development.apps/tree/browse_frm/thread/dc29071f2417f75f/ac44671fdb35f6db?rnum=1&_done=%2Fgroup%2Fcomp.os.linux.development.apps%2Fbrowse_frm%2Fthread%2Fdc29071f2417f75f%2Fc46264dba0863463%3Flnk%3Dst%26rnum%3D1%26#doc_776f910824bdbee8
+ * https://groups.google.com/forum/#!topic/comp.os.linux.development.apps/3CkHHyQX918
*/
typedef struct timespec time_of_day_t;
# define CLOCK_GETTIME(ts) clock_gettime(profile_clock, ts)
@@ -332,6 +338,19 @@ typedef uint64_t time_of_day_t;
#else /* !HAS_MACH_TIME */
#ifdef HAS_GETTIMEOFDAY
+
+/* on Win32 gettimeofday is always implemented in Perl, not the MS C lib, so
+ either we use PerlProc_gettimeofday or win32_gettimeofday, depending on the
+ Perl defines about NO_XSLOCKS and PERL_IMPLICIT_SYS, to simplify logic,
+ we don't check the defines, just the macro symbol to see if it forwards to
+ presumably the iperlsys.h vtable call or not.
+ See https://github.com/timbunce/devel-nytprof/pull/27#issuecomment-46102026
+ for more details.
+*/
+#if defined(WIN32) && !defined(gettimeofday)
+# define gettimeofday win32_gettimeofday
+#endif
+
typedef struct timeval time_of_day_t;
# define TICKS_PER_SEC 1000000 /* 1 million */
# define get_time_of_day(into) gettimeofday(&into, NULL)
@@ -340,20 +359,23 @@ typedef struct timeval time_of_day_t;
ticks = ((e.tv_sec - s.tv_sec) * TICKS_PER_SEC + e.tv_usec - s.tv_usec); \
} STMT_END
-#else
+#else /* !HAS_GETTIMEOFDAY */
-static int (*u2time)(pTHX_ UV *) = 0;
+/* worst-case fallback - use Time::HiRes which is expensive to call */
+#define WANT_TIME_HIRES
typedef UV time_of_day_t[2];
# define TICKS_PER_SEC 1000000 /* 1 million */
-# define get_time_of_day(into) (*u2time)(aTHX_ into)
+# define get_time_of_day(into) (*time_hires_u2time_hook)(aTHX_ into)
# define get_ticks_between(typ, s, e, ticks, overflow) STMT_START { \
overflow = 0; \
ticks = ((e[0] - s[0]) * (typ)TICKS_PER_SEC + e[1] - s[1]); \
} STMT_END
-#endif
-#endif
-#endif
+#endif /* HAS_GETTIMEOFDAY else */
+#endif /* HAS_MACH_TIME else */
+#endif /* HAS_CLOCK_GETTIME else */
+
+static int (*time_hires_u2time_hook)(pTHX_ UV *) = 0;
static time_of_day_t start_time;
static time_of_day_t end_time;
@@ -443,6 +465,7 @@ logwarn(const char *pat, ...)
{
/* we avoid using any perl mechanisms here */
va_list args;
+ NYTP_IO_dTHX;
va_start(args, pat);
if (!logfh)
logfh = stderr;
@@ -464,19 +487,29 @@ static NV
gettimeofday_nv(void)
{
#ifdef HAS_GETTIMEOFDAY
+
+ NYTP_IO_dTHX;
struct timeval when;
gettimeofday(&when, (struct timezone *) 0);
return when.tv_sec + (when.tv_usec / 1000000.0);
+
#else
- if (u2time) {
- UV time_of_day[2];
- (*u2time)(aTHX_ &time_of_day);
- return time_of_day[0] + (time_of_day[1] / 1000000.0);
- }
- return (NV)time();
-#endif
+#ifdef WANT_TIME_HIRES
+
+ NYTP_IO_dTHX;
+ UV time_of_day[2];
+ (*time_hires_u2time_hook)(aTHX_ &time_of_day);
+ return time_of_day[0] + (time_of_day[1] / 1000000.0);
+
+#else
+
+ return (NV)time(); /* practically useless */
+
+#endif /* WANT_TIME_HIRES else */
+#endif /* HAS_GETTIMEOFDAY else */
}
+
/**
* output file header
*/
@@ -1683,6 +1716,11 @@ set_option(pTHX_ const char* option, const char* value)
? profile_opts | NYTP_OPTf_ADDPID
: profile_opts & ~NYTP_OPTf_ADDPID;
}
+ else if (strEQ(option, "addtimestamp")) {
+ profile_opts = (atoi(value))
+ ? profile_opts | NYTP_OPTf_ADDTIMESTAMP
+ : profile_opts & ~NYTP_OPTf_ADDTIMESTAMP;
+ }
else if (strEQ(option, "optimize") || strEQ(option, "optimise")) {
profile_opts = (atoi(value))
? profile_opts | NYTP_OPTf_OPTIMIZE
@@ -1744,10 +1782,16 @@ open_output_file(pTHX_ char *filename)
mode = "wb";
#endif
- if ((profile_opts & NYTP_OPTf_ADDPID)
- || out /* already opened so assume forking */
- ) {
- sprintf(filename_buf, "%s.%d", filename, getpid());
+ if ((profile_opts & (NYTP_OPTf_ADDPID|NYTP_OPTf_ADDTIMESTAMP))
+ || out /* already opened so assume we're forking and add the pid */
+ ) {
+ if (strlen(filename) >= MAXPATHLEN-(20+20)) /* buffer overrun protection */
+ croak("Filename '%s' too long", filename);
+ strcpy(filename_buf, filename);
+ if ((profile_opts & NYTP_OPTf_ADDPID) || out)
+ sprintf(&filename_buf[strlen(filename_buf)], ".%d", getpid());
+ if ( profile_opts & NYTP_OPTf_ADDTIMESTAMP )
+ sprintf(&filename_buf[strlen(filename_buf)], ".%.0"NVff"", gettimeofday_nv());
filename = filename_buf;
/* caller is expected to have purged/closed old out if appropriate */
}
@@ -1766,7 +1810,7 @@ open_output_file(pTHX_ char *filename)
filename, fopen_errno, strerror(fopen_errno), hint);
}
if (trace_level >= 1)
- logwarn("~ opened %s at %.6f\n", filename, gettimeofday_nv());
+ logwarn("~ opened %s at %.6"NVff"\n", filename, gettimeofday_nv());
output_header(aTHX);
}
@@ -1796,7 +1840,7 @@ close_output_file(pTHX) {
out = NULL;
if (trace_level >= 1)
- logwarn("~ closed file at %.6f\n", timeofday);
+ logwarn("~ closed file at %.6"NVff"\n", timeofday);
}
@@ -1994,9 +2038,9 @@ static void
incr_sub_inclusive_time(pTHX_ subr_entry_t *subr_entry)
{
int saved_errno = errno;
- char called_subname_pv[500]; /* XXX */
+ char called_subname_pv[NYTP_MAX_SUB_NAME_LEN];
char *called_subname_pv_end = called_subname_pv;
- char subr_call_key[500]; /* XXX */
+ char subr_call_key[NYTP_MAX_SUB_NAME_LEN];
int subr_call_key_len;
NV overhead_ticks, called_sub_ticks;
SV *incl_time_sv, *excl_time_sv;
@@ -2054,7 +2098,7 @@ incr_sub_inclusive_time(pTHX_ subr_entry_t *subr_entry)
(subr_entry->caller_subnam_sv) ? SvPV_nolen(subr_entry->caller_subnam_sv) : "(null)",
subr_entry->caller_fid, subr_entry->caller_line);
if (subr_call_key_len >= sizeof(subr_call_key))
- croak("panic: NYTProf buffer overflow on %s\n", subr_call_key);
+ croak(nytp_panic_overflow_msg_fmt, "subr_call_key", subr_call_key);
/* compose called_subname_pv as "${pkg}::${sub}" avoiding sprintf */
STMT_START {
@@ -2078,7 +2122,7 @@ incr_sub_inclusive_time(pTHX_ subr_entry_t *subr_entry)
memcpy(called_subname_pv_end, p, len + 1);
called_subname_pv_end += len;
if (called_subname_pv_end >= called_subname_pv+sizeof(called_subname_pv))
- croak("panic: called_subname_pv buffer overflow on '%s'\n", called_subname_pv);
+ croak(nytp_panic_overflow_msg_fmt, "called_subname_pv", called_subname_pv);
} STMT_END;
/* { called_subname => { "caller_subname[fid:line]" => [ count, incl_time, ... ] } } */
@@ -2956,7 +3000,7 @@ finish_profile(pTHX)
#endif
if (trace_level >= 1)
- logwarn("~ finish_profile (overhead %gt, is_profiling %d)\n",
+ logwarn("~ finish_profile (overhead %"NVgf"t, is_profiling %d)\n",
cumulative_overhead_ticks, is_profiling);
/* write data for final statement, unless DB_leave has already */
@@ -3088,13 +3132,13 @@ init_profiler(pTHX)
return 0;
}
-#ifndef HAS_GETTIMEOFDAY
+#ifdef WANT_TIME_HIRES
require_pv("Time/HiRes.pm"); /* before opcode redirection */
svp = hv_fetch(PL_modglobal, "Time::U2time", 12, 0);
if (!svp || !SvIOK(*svp)) croak("Time::HiRes is required");
- u2time = INT2PTR(int(*)(pTHX_ UV*), SvIV(*svp));
- if (trace_level)
- logwarn("NYTProf using Time::HiRes %p\n", u2time);
+ time_hires_u2time_hook = INT2PTR(int(*)(pTHX_ UV*), SvIV(*svp));
+ if (trace_level || !time_hires_u2time_hook)
+ logwarn("NYTProf using Time::HiRes %p\n", time_hires_u2time_hook);
#endif
/* create file id mapping hash */
@@ -4218,7 +4262,8 @@ load_sub_callers_callback(Loader_state_base *cb_data, const nytp_tax_index tag,
sv = *av_fetch(av, NYTP_SCi_REC_DEPTH, 1);
if (!SvOK(sv) || SvUV(sv) < rec_depth) /* max() */
sv_setuv(sv, rec_depth);
- /* XXX temp hack way to store calling subname */
+ /* XXX temp hack way to store calling subname as key with undef value */
+ /* ideally we should assign ids to subs (sid) the way we do with files (fid) */
sv = *av_fetch(av, NYTP_SCi_CALLING_SUB, 1);
if (!SvROK(sv)) /* autoviv */
sv_setsv(sv, newRV_noinc((SV*)newHV()));
@@ -4584,10 +4629,9 @@ static loader_callback processing_callbacks[nytp_tag_max] =
* data for each line of the string eval.
*/
static void
-load_profile_data_from_stream(loader_callback *callbacks,
+load_profile_data_from_stream(pTHX_ loader_callback *callbacks,
Loader_state_base *state, NYTP_file in)
{
- dTHX;
int file_major, file_minor;
SV *tmp_str1_sv = newSVpvn("",0);
@@ -4868,7 +4912,6 @@ load_profile_to_hv(pTHX_ NYTP_file in)
Zero(&state, 1, Loader_state_profiler);
state.total_stmts_duration = 0.0;
state.profiler_start_time = 0.0;
- state.profiler_start_time = 0.0;
state.profiler_end_time = 0.0;
state.profiler_duration = 0.0;
#ifdef MULTIPLICITY
@@ -4887,7 +4930,7 @@ load_profile_to_hv(pTHX_ NYTP_file in)
av_extend(state.fid_srclines_av, 64);
av_extend(state.fid_line_time_av, 64);
- load_profile_data_from_stream(processing_callbacks,
+ load_profile_data_from_stream(aTHX_ processing_callbacks,
(Loader_state_base *)&state, in);
@@ -5028,7 +5071,7 @@ load_profile_to_callback(pTHX_ NYTP_file in, SV *cb)
for (i = 0; i < C_ARRAY_LENGTH(state.cb_args); i++)
state.cb_args[i] = sv_newmortal();
- load_profile_data_from_stream(perl_callbacks, (Loader_state_base *)&state,
+ load_profile_data_from_stream(aTHX_ perl_callbacks, (Loader_state_base *)&state,
in);
}
@@ -6,7 +6,8 @@ Devel::NYTProf is a powerful feature-rich perl source code profiler.
For more information see:
- http://www.slideshare.net/Tim.Bunce/develnytprof-v4-at-yapceu-201008-4906467
+ https://www.youtube.com/watch?v=T7EK6RZAnEA
+ http://www.slideshare.net/Tim.Bunce/nyt-prof-201406key
http://blog.timbunce.org/tag/nytprof/
## DOWNLOAD AND INSTALLATION
@@ -14,7 +14,7 @@ use strict;
use Devel::NYTProf::Core;
require Devel::NYTProf::Data;
-our $VERSION = '5.06';
+our $VERSION = '5.07';
use Data::Dumper;
use Getopt::Long;
@@ -34,6 +34,27 @@ $|++ if $opt_verbose;
usage() unless @ARGV;
+sub usage {
+ print <<END;
+usage: [perl] nytprofcalls [opts] nytprof-file [...]
+
+ --help, -h Print this message
+ --verbose, -v Be more verbose
+
+This script of part of the Devel::NYTProf distribution.
+See https://metacpan.org/release/Devel-NYTProf for details and copyright.
+END
+ exit 0;
+}
+
+
+my $last_subid = 0;
+my %subname2id;
+
+my %option;
+my %attribute;
+
+
# We're building a tree structure from a stream of "subroutine returned" events.
# (We use these because the subroutine entry events don't have reliable
# value for the subroutine name, and obviously don't have timings.)
@@ -46,119 +67,129 @@ my $root = {};
my @stack = ($root);
my $total_in = 0;
-my $last_subid = 0;
-my %subname2id;
-my $sibling_avoided = 0;
-my $siblings_max = 0;
+my $callbacks = {
+ OPTION => sub { my (undef, $k, $v) = @_; $option{$k} = $v },
+ ATTRIBUTE => sub { my (undef, $k, $v) = @_; $attribute{$k} = $v },
+};
+$callbacks->{SUB_ENTRY} = \&on_sub_entry_log if $opt_verbose;
+$callbacks->{SUB_RETURN} = \&on_sub_return_build_call_stack;
+$callbacks->{all_loaded} = sub {
+ output_call_path_hash( extract_call_path_hash($root) );
+};
-my %option;
-my %attribute;
+
+foreach my $input (@ARGV) {
+ warn "Reading $input...\n" if $opt_verbose;
+ Devel::NYTProf::Data->new({
+ filename => $input,
+ quiet => 1,
+ callback => $callbacks
+ });
+}
+$callbacks->{all_loaded}->();
-my $callbacks = {
+exit 0;
- OPTION => sub { my (undef, $k, $v) = @_; $option{$k} = $v },
- ATTRIBUTE => sub { my (undef, $k, $v) = @_; $attribute{$k} = $v },
- SUB_ENTRY => sub {
- my (undef, $fid, $line) = @_;
- warn "> at $fid:$line\n" if $opt_verbose;
- },
+sub on_sub_entry_log {
+ my (undef, $fid, $line) = @_;
+ warn "> at $fid:$line\n";
+}
- SUB_RETURN => sub {
- # $retn_depth is the call stack depth of the sub call we're returning from
- my (undef, $retn_depth, undef, $excl_time, $subname) = @_;
- warn sprintf "< %2d %-10s %s (stack %d)\n", $retn_depth, $subname, $excl_time, scalar @stack
- if $opt_verbose;
+sub on_sub_return_build_call_stack {
+ # $retn_depth is the call stack depth of the sub call we're returning from
+ my (undef, $retn_depth, undef, $excl_time, $subname) = @_;
- my $v = ($opt_calls) ? 1 : $excl_time;
- $total_in += $v;
+ warn sprintf "< %2d %-10s %s (stack %d)\n", $retn_depth, $subname, $excl_time, scalar @stack
+ if $opt_verbose;
- # normalize and merge sibling string evals by setting eval seqn to 0
- $subname =~ s/\( (\w*eval)\s\d+ \) (?= \[ .+? :\d+ \] )/($1 0)/gx;
- # assign an id to the subname for memory efficiency
- my $subid = $subname2id{$subname} ||= ++$last_subid;
+ my $v = ($opt_calls) ? 1 : $excl_time;
+ $total_in += $v;
- # Either...
- # a) we're returning from some sub deeper than the current stack
- # in which case we push unnamed sub calls ("0") onto the stack
- # till we get to the right depth, then fall through to:
- # b) we're returning from the sub on top of the stack.
+ # normalize and merge sibling string evals by setting eval seqn to 0
+ $subname =~ s/\( (\w*eval)\s\d+ \) (?= \[ .+? :\d+ \] )/($1 0)/gx;
+ # assign an id to the subname for memory efficiency
+ my $subid = $subname2id{$subname} ||= ++$last_subid;
- while (@stack <= $retn_depth) { # build out the tree if needed
- my $crnt_node = $stack[-1];
- die "panic" if $crnt_node->{0};
- push @stack, ($crnt_node->{0} = {});
- }
+ # Either...
+ # a) we're returning from some sub deeper than the current stack
+ # in which case we push unnamed sub calls ("0") onto the stack
+ # till we get to the right depth, then fall through to:
+ # b) we're returning from the sub on top of the stack.
- # top of stack: sub we're returning from
- # next on stack: sub that was the caller
- my $sub_return = pop @stack;
- my $sub_caller = $stack[-1] || die "panic";
+ while (@stack <= $retn_depth) { # build out the tree if needed
+ my $crnt_node = $stack[-1];
+ die "panic" if $crnt_node->{0};
+ push @stack, ($crnt_node->{0} = {});
+ }
- die "panic" unless $sub_return == $sub_caller->{0};
- delete $sub_caller->{0} or die "panic"; # == $sub_return
+ # top of stack: sub we're returning from
+ # next on stack: sub that was the caller
+ my $sub_return = pop @stack;
+ my $sub_caller = $stack[-1] || die "panic";
- # {
- # 0 - as-yet un-returned subs
- # 'v' - cumulative excl_time in this sub
- # $subid1 => {...} # calls to $subid1 made by this sub
- # $subid2 => {...}
- # }
+ die "panic" unless $sub_return == $sub_caller->{0};
+ delete $sub_caller->{0} or die "panic"; # == $sub_return
- $sub_return->{v} += $v;
- _merge_sub_return_into_caller($sub_caller->{$subid} ||= {}, $sub_return);
- },
-};
+ # {
+ # 0 - as-yet un-returned subs
+ # 'v' - cumulative excl_time in this sub
+ # $subid1 => {...} # calls to $subid1 made by this sub
+ # $subid2 => {...}
+ # }
+ $sub_return->{v} += $v;
+ _merge_sub_return_into_caller($sub_caller->{$subid} ||= {}, $sub_return);
+}
-foreach my $input (@ARGV) {
- warn "Reading $input...\n" if $opt_verbose;
- Devel::NYTProf::Data->new({
- filename => $input,
- quiet => 1,
- callback => $callbacks
+
+# build hash of call paths ("subid;subid;subid" => value) from the call tree
+sub extract_call_path_hash {
+ my ($root) = @_;
+
+ my %subid_call_path_hash;
+ visit_nodes_depth_first($root, [], sub {
+ my ($node, $path) = @_;
+ $subid_call_path_hash{ join(";", @$path) } += $node->{v}
+ if @$path;
+ %$node = (); # reclaim memory as we go
});
+ return \%subid_call_path_hash;
}
-# transform tree into a simple hash of call paths "subid;subid;subid" => value
-my %subidpaths;
-visit_node($root, [], sub {
- my ($node, $path) = @_;
- $subidpaths{ join(";", @$path) } += $node->{v}
- if @$path;
-});
-
-# output the totals without scaling, so they're in ticks_per_sec units
-my $val_scale_factor = 1; # ($opt_calls) ? 1 : 1_000_000 / $attribute{ticks_per_sec};
-my $val_format = ($opt_calls || $val_scale_factor==1) ? "%s %d\n" : "%s %.1f\n";
-my $total_out = 0;
-
-# ensure subnames don't contain ";" or " "
-tr/; /??/ for values %subname2id;
-my %subid2name = reverse %subname2id;
-
-# output the subidpaths hash using subroutine names
-my @subidpaths = keys %subidpaths;
-@subidpaths = sort @subidpaths if $opt_stable;
-for my $subidpath (@subidpaths) {
- my @path = map { $subid2name{$_} } split ";", $subidpath;
- my $path = join(";", @path);
- my $v = $subidpaths{$subidpath};
- printf $val_format, join(";", @path), $v * $val_scale_factor;
- $total_out += $v;
-}
+sub output_call_path_hash {
+ my ($subid_call_path_hash) = @_;
-warn "nytprofcalls inconsistency: total in $total_in doesn't match total out $total_out\n"
- if $total_in != $total_out;
+ # ensure subnames don't contain ";" or " "
+ tr/; /??/ for values %subname2id;
+ my %subid2name = reverse %subname2id;
-warn sprintf "Done Total $total_in (siblings: avoided $sibling_avoided, max $siblings_max)\n"
- if $opt_verbose;
+ # output the totals without scaling, so they're in ticks_per_sec units
+ my $val_scale_factor = 1; # ($opt_calls) ? 1 : 1_000_000 / $attribute{ticks_per_sec};
+ my $val_format = ($opt_calls || $val_scale_factor==1) ? "%s %d\n" : "%s %.1f\n";
+ my $total_out = 0;
-exit 0;
+ # output the subid_call_path_hash hash using subroutine names
+ my @keys = keys %$subid_call_path_hash;
+ @keys = sort @keys if $opt_stable;
+ for my $subidpath (@keys) {
+ my @path = map { $subid2name{$_} } split ";", $subidpath;
+ my $path = join(";", @path);
+ my $v = $subid_call_path_hash->{$subidpath};
+ printf $val_format, join(";", @path), $v * $val_scale_factor;
+ $total_out += $v;
+ }
+
+ warn "nytprofcalls inconsistency: total in $total_in doesn't match total out $total_out\n"
+ if $total_in != $total_out;
+
+ warn sprintf "Done. Total $total_in\n"
+ if $opt_verbose;
+}
sub _merge_sub_return_into_caller {
@@ -175,7 +206,7 @@ sub _merge_sub_return_into_caller {
}
-sub visit_node { # depth first
+sub visit_nodes_depth_first { # depth first
my $node = shift;
my $path = shift;
my $sub = shift;
@@ -189,29 +220,14 @@ sub visit_node { # depth first
$path->[-1] = $subid;
warn "node @$path: @{[ %$childnode ]}\n" if $opt_debug;
- visit_node($childnode, $path, $sub);
+ visit_nodes_depth_first($childnode, $path, $sub);
}
pop @$path;
$sub->($node, $path);
-
- %$node = (); # reclaim memory as we go
}
-sub usage {
- print <<END;
-usage: [perl] nytprofcalls [opts] nytprof-file [...]
-
- --help, -h Print this message
- --verbose, -v Be more verbose
-
-This script of part of the Devel::NYTProf distribution.
-See https://metacpan.org/release/Devel-NYTProf for details and copyright.
-END
- exit 0;
-}
-
__END__
=head1 NAME
@@ -35,6 +35,7 @@ use Config qw(%Config);
use Getopt::Long;
use List::Util qw(sum max);
use File::Copy;
+use File::Spec;
use File::Path qw(rmtree);
# Handle --profself before loading Devel::NYTProf::Core
@@ -59,7 +60,7 @@ use Devel::NYTProf::Util qw(
);
use Devel::NYTProf::Constants qw(NYTP_SCi_CALLING_SUB);
-our $VERSION = '5.06';
+our $VERSION = '5.07';
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";
@@ -68,6 +69,10 @@ if ($VERSION != $Devel::NYTProf::Core::VERSION) {
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";
+my $script_ext = ($^O eq "MSWin32") ? "" : ".pl";
+my $nytprofcalls = File::Spec->catfile($Config{'bin'}, 'nytprofcalls');
+my $flamegraph = File::Spec->catfile($Config{'bin'}, 'flamegraph') . $script_ext;
+
my @treemap_colors = (0,2,4,6,8,10,1,3,5,7,9);
# These control the limits for what the script will consider ok to severe times
@@ -789,10 +794,11 @@ sub output_index_page {
if ($profile->{option}{calls} && $opt_flame) {
my $mk_flamegraph = sub {
+ my $total_sub_calls = $profile->{attribute}{total_sub_calls};
+ my $is_big = ($total_sub_calls <= 1_000_000);
warn sprintf "Extracting subroutine call data%s ...\n",
- ($profile->{attribute}{total_sub_calls} <= 1_000_000) ? ""
- : " (there were $profile->{attribute}{total_sub_calls} of them, so this may take some time)";
- system("nytprofcalls $opt_file > $opt_out/$call_stacks_file") == 0
+ ($is_big) ? "" : " (There were $total_sub_calls of them, so this may take some time, or cancel and use --no-flame to skip this step.)";
+ system("\"$nytprofcalls\" $opt_file > $opt_out/$call_stacks_file") == 0
or die "Generating $opt_out/$call_stacks_file failed\n";
my %subname_subinfo_map = %{ $profile->subname_subinfo_map };
@@ -813,9 +819,7 @@ sub output_index_page {
my $factor = 1_000_000 / $profile->{attribute}{ticks_per_sec};
# total (width) for flamegraph is profiler_active in ticks
my $run_us = $profile->{attribute}{profiler_active} * $profile->{attribute}{ticks_per_sec};
- my $extension = $^O eq "MSWin32" ? "" : ".pl";
- my $fg_cmd = "flamegraph$extension --nametype=sub --countname=microseconds";
- system("$fg_cmd --factor=$factor --nameattr=$subattr --total=$run_us $opt_out/$call_stacks_file > $opt_out/$call_stacks_svg") == 0
+ system("\"$flamegraph\" --nametype=sub --countname=microseconds --factor=$factor --nameattr=$subattr --total=$run_us $opt_out/$call_stacks_file > $opt_out/$call_stacks_svg") == 0
or die "Generating $opt_out/$call_stacks_svg failed\n";
print $fh qq{<div class="flamegraph">\n};
@@ -1311,7 +1315,7 @@ sub open_browser_on {
$BROWSER = "/usr/bin/open %s";
}
else {
- my @try = qw(xdg-open);
+ my @try;
if ($ENV{BROWSER}) {
push(@try, split(/:/, $ENV{BROWSER}));
}
@@ -1320,9 +1324,10 @@ sub open_browser_on {
}
unshift(@try, "kfmclient") if $ENV{KDE_FULL_SESSION};
unshift(@try, "gnome-open") if $ENV{GNOME_DESKTOP_SESSION_ID};
+ unshift(@try, "xdg-open");
for (grep { have_prog($_) } @try) {
if ($_ eq "kfmclient") {
- $BROWSER .= " openURL %s";
+ $BROWSER = "$_ openURL %s";
}
elsif ($_ eq "gnome-open" || $_ eq "opera") {
$BROWSER = "$_ %s";
@@ -1971,7 +1976,7 @@ Don't generate graphviz .dot files or block/sub-level reports.
=item --no-flame
-Disable generation of the framegraph on the index page.
+Disable generation of the flamegraph on the index page.
Also disables calculation of distinct call stacks that are used to produce the
flamegraph.
@@ -16,7 +16,7 @@ require Devel::NYTProf::FileHandle;
require Devel::NYTProf::Data;
use List::Util qw(min sum);
-our $VERSION = '5.06';
+our $VERSION = '5.07';
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";
@@ -0,0 +1,165 @@
+#!/usr/bin/perl
+##########################################################
+## This script is part of the Devel::NYTProf distribution
+##
+## Copyright, contact and other information can be found
+## at the bottom of this file, or by going to:
+## http://search.cpan.org/~akaplan/Devel-NYTProf
+##
+###########################################################
+
+=head1 NAME
+
+nytprofpf - Generate a report for plat_forms (L<http://www.plat-forms.org/>) from Devel::NYTProf data
+
+=head1 SYNOPSIS
+
+Typical usage:
+
+ $ perl -d:NYTProf some_perl_app.pl
+ $ nytprofpf
+
+Options synopsis:
+
+ --file <file>, -f <file> Read profile data from the specified file [default: nytprof.out]
+ --delete, -d Delete any old report files first
+ --lib <lib>, -l <lib> Add <lib> to the beginning of \@INC
+ --no-mergeevals Disable merging of string evals
+ --help, -h Print this message
+
+This script of part of the Devel::NYTProf distribution. Generate a report for plat_forms (L<http://www.plat-forms.org/>) from Devel::NYTProf data.
+See http://search.cpan.org/dist/Devel-NYTProf/ for details and copyright.
+
+=encoding ISO8859-1
+
+=cut
+
+use warnings;
+use strict;
+
+use Carp;
+use Config qw(%Config);
+use Getopt::Long;
+use List::Util qw(sum max);
+use File::Copy;
+use File::Path qw(rmtree);
+
+use Devel::NYTProf::Reader;
+use Devel::NYTProf::Core;
+use Devel::NYTProf::Util qw(
+ fmt_float fmt_time fmt_incl_excl_time
+ calculate_median_absolute_deviation
+ get_abs_paths_alternation_regex
+ html_safe_filename
+);
+use Devel::NYTProf::Constants qw(NYTP_SCi_CALLING_SUB);
+
+our $VERSION = '5.07';
+
+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";
+}
+
+GetOptions(
+ 'file|f=s' => \(my $opt_file = 'nytprof.out'),
+ 'lib|l=s' => \my $opt_lib,
+ 'out|o=s' => \(my $opt_out = 'nytprof'),
+ 'delete|d!' => \my $opt_delete,
+ 'help|h' => sub { exit usage() },
+ 'mergeevals!'=> \(my $opt_mergeevals = 1),
+) or do { exit usage(); };
+
+sub usage {
+ print <<END;
+
+usage: [perl] nytprofpf [opts]
+ --file <file>, -f <file> Read profile data from the specified file [default: nytprof.out]
+ --delete, -d Delete any old report files first
+ --lib <lib>, -l <lib> Add <lib> to the beginning of \@INC
+ --no-mergeevals Disable merging of string evals
+ --help, -h Print this message
+
+This script of part of the Devel::NYTProf distribution.
+See http://search.cpan.org/dist/Devel-NYTProf/ for details and copyright.
+END
+ return 0;
+}
+
+use constant NUMERIC_PRECISION => 7;
+
+
+# handle output location
+if (!-e $opt_out) {
+ # everything is fine
+}
+elsif (!-f $opt_out) {
+ die "$0: Specified output file '$opt_out' already exists as a directory!\n";
+}
+elsif (!-w $opt_out) {
+ die "$0: Unable to write to output directory '$opt_out'\n";
+}
+else {
+ if (defined($opt_delete)) {
+ print "Deleting existing $opt_out file\n";
+ rm($opt_out);
+ }
+}
+
+# handle custom lib path
+if (defined($opt_lib)) {
+ warn "$0: Specified lib directory '$opt_lib' does not exist.\n"
+ unless -d $opt_lib;
+ require lib;
+ lib->import($opt_lib);
+}
+
+eval { $SIG{USR2} = \&Carp::cluck }; # some platforms don't have SIGUSR2 (Windows)
+
+my $reporter = new Devel::NYTProf::Reader($opt_file, {
+ quiet => 0,
+ skip_collapse_evals => !$opt_mergeevals,
+});
+
+my $profile = $reporter->{profile};
+open my $fh, '>', $opt_out
+ or croak "Unable to open file $opt_out: $!";
+print $fh subroutine_table($profile, undef, 0, 'excl_time');
+close $fh;
+
+sub subroutine_table {
+ my ($profile, $fi, $max_subs, $sortby) = @_;
+ $sortby ||= 'excl_time';
+
+ my $subs_unsorted = $profile->subname_subinfo_map;
+
+ my $inc_path_regex = get_abs_paths_alternation_regex([$profile->inc], qr/^|\[/);
+
+ my @all_subs =
+ sort { $b->$sortby <=> $a->$sortby or $a->subname cmp $b->subname }
+ values %$subs_unsorted;
+
+ #don't show subs that were never called
+ my @subs = grep { $_->calls > 0 } @all_subs if !$fi;
+
+ my $max_pkg_name_len = max(map { length($_->package) } @subs);
+
+ my $output;
+
+ $output .= "Name, File location, Time, Avg. Time, Own Time, Invocation Count, Level\n";
+
+ my $profiler_active = $profile->{attribute}{profiler_active};
+
+ for my $sub (@subs) {
+ $output .= sprintf ("%s, %s, %.3f, %.3f, %.3f, %d, %d\n",
+ $sub->subname,
+ $sub->fileinfo->filename,
+ $sub->incl_time * 1000,
+ 0,
+ $sub->excl_time * 1000,
+ $sub->calls,
+ 0);
+ }
+
+ return $output;
+}
+exit 0;
@@ -12,7 +12,7 @@ package Devel::NYTProf::Core;
use XSLoader;
-our $VERSION = '5.06'; # increment with XS changes too
+our $VERSION = '5.07'; # increment with XS changes too
XSLoader::load('Devel::NYTProf', $VERSION);
@@ -79,12 +79,13 @@ sub profile_this {
or carp "Exit status $? from @perl $src_file";
}
elsif (my $src_code = $opt{src_code}) {
- open my $fh, "| @perl"
- or croak "Can't open pipe to @perl";
+ my $cmd = join ' ', map qq{"$_"}, @perl;
+ open my $fh, "| $cmd"
+ or croak "Can't open pipe to $cmd";
print $fh $src_code;
- close $fh
- or carp $! ? "Error closing @perl pipe: $!"
- : "Exit status $? from @perl";
+ close $fh
+ or carp $! ? "Error closing $cmd pipe: $!"
+ : "Exit status $? from $cmd";
}
else {
@@ -9,7 +9,7 @@
###########################################################
package Devel::NYTProf;
-our $VERSION = '5.06'; # also change in Devel::NYTProf::Core
+our $VERSION = '5.07'; # also change in Devel::NYTProf::Core
package # hide the package from the PAUSE indexer
DB;
@@ -62,8 +62,10 @@ Devel::NYTProf - Powerful fast feature-rich Perl source code profiler
# or into comma separated files, e.g., ./nytprof/*.csv
nytprofcsv
-A screencast about profiling perl code, including a detailed look at how to use
-NYTProf and how to optimize your code, is available at L<http://timbunce.blip.tv/file/3913278/>
+I give talks on profiling perl code, including a detailed look at how to use
+NYTProf and how to optimize your code, every year. A video of my YAPC::NA 2014
+talk can be found at L<http://perltv.org/v/performance-profiling-with-develnytprof>
+
=head1 DESCRIPTION
@@ -308,6 +310,12 @@ a backslash.
Append the current process id to the end of the filename.
This avoids concurrent, or consecutive, processes from overwriting the same file.
+If a fork is detected during profiling then the child process will automatically
+add the process id to the filename.
+
+=head2 addtimestamp=1
+
+Append the current time, as integer epoch seconds, to the end of the filename.
=head2 trace=N
@@ -861,6 +869,11 @@ The C<Devel::NYTProf> subroutine profiler gets confused by the stack gymnastics
performed by the L<Coro> module and aborts. When profiling applications that
use Coro you should disable the subroutine profiler using the L</subs=0> option.
+=head2 FCGI::Engine
+
+Using C<open('-|')> in code running under L<FCGI::Engine> causes a panic in nytprofcalls.
+See https://github.com/timbunce/devel-nytprof/issues/20 for more information.
+
=head2 For perl < 5.8.8 it may change what caller() returns
For example, the L<Readonly> module croaks with "Invalid tie" when profiled with
@@ -1204,6 +1217,12 @@ You could also try recompiling perl to use 'long doubles' for the NV floating
point type (use Configure -Duselongdouble). If you try this please let me know.
I'd also happily take a patch to use long doubles, if available, by default.
+=head2 panic: buffer overflow ...
+
+You have unusually long subroutine names in your code. You'll need to rebuild
+Devel::NYTProf with the NYTP_MAX_SUB_NAME_LEN environment variable set to a
+value longer than the longest subroutine names in your code.
+
=head1 AUTHORS AND CONTRIBUTORS
B<Tim Bunce> (L<http://www.tim.bunce.name> and L<http://blog.timbunce.org>)
@@ -30,21 +30,29 @@ run_test_group( {
my $fi_s = $profile->fileinfo_of('-');
isa_ok $fi_s, 'Devel::NYTProf::FileInfo', 'should have fileinfo for "-"';
- my $fi_e = $profile->fileinfo_of('(eval 1)[-:1]');
- isa_ok $fi_e, 'Devel::NYTProf::FileInfo', 'should have fileinfo for "(eval 0)[-:1]"';
-
if ($env->{savesrc}) {
my $lines_s = $fi_s->srclines_array;
isa_ok $lines_s, 'ARRAY', 'srclines_array should return an array ref';
-
is $lines_s->[0], $src_code, 'source code line should match';
+ }
+ else { pass() for 1..2 }
+
+ my $fi_e = $profile->fileinfo_of('(eval 1)[-:1]');
+ isa_ok $fi_e, 'Devel::NYTProf::FileInfo',
+ 'should have fileinfo for "(eval 0)[-:1]"'
+ or do {
+ diag "Have fileinfo for: '$_'"
+ for sort map { $_->filename } $profile->all_fileinfos;
+ };
+
+ if ($env->{savesrc} && $fi_e) {
my $lines_e = $fi_e->srclines_array;
# perl adds a newline to eval strings
is $lines_e->[0], "$src_eval\n", 'source code line should match';
#warn "@$lines_e";
}
else {
- pass() for 1..3;
+ pass() for 1;
}
},
});
@@ -2,6 +2,7 @@
use strict;
use Test::More;
+use lib '/home/travis/perl5'; # travis workaround https://travis-ci.org/timbunce/devel-nytprof/jobs/35285944
use Test::Differences;
use lib qw(t/lib);
@@ -6,8 +6,8 @@ use Test::More;
use lib qw(t/lib);
use NYTProfTest;
-eval "use Sub::Name 0.04; 1"
- or plan skip_all => "Sub::Name 0.04 required (0.06+ preferred)";
+eval "use Sub::Name 0.11; 1"
+ or plan skip_all => "Sub::Name 0.11 or later required";
print "Sub::Name $Sub::Name::VERSION $INC{'Sub/Name.pm'}\n";
@@ -51,3 +51,9 @@ __DATA__
#!perl
use Sub::Name;
(subname 'named' => sub { print "sub called\n" })->();
+
+my $longname = "sub34567890" x 10 x 4;
+(subname $longname => sub { print "sub called\n" })->();
+
+my $deepname = "sub345678::" x 10 x 4;
+(subname $deepname => sub { print "sub called\n" })->();
@@ -42,7 +42,7 @@ $opts{v} ||= $opts{d};
$opts{html} ||= $opts{open};
# note some env vars that might impact the tests
-$ENV{$_} && warn "$_=$ENV{$_}\n" for qw(PERL5DB PERL5OPT PERL_UNICODE PERLIO);
+$ENV{$_} && warn "$_='$ENV{$_}'\n" for qw(PERL5DB PERL5OPT PERL_UNICODE PERLIO);
if ($ENV{NYTPROF}) { # avoid external interference
warn "Existing NYTPROF env var value ($ENV{NYTPROF}) ignored for tests. Use NYTPROF_TEST env var if need be.\n";
@@ -66,6 +66,7 @@ my $text_extn_info = {
rdt => { order => 20, tests => ($opts{mergerdt}) ? 2 : 1, },
x => { order => 30, tests => 3, },
calls => { order => 40, tests => 1, },
+ pf => { order => 50, tests => 2, },
};
chdir('t') if -d 't';
@@ -82,6 +83,7 @@ my $bindir = (grep {-d} qw(./blib/script ../blib/script))[0] || do {
my $nytprofcsv = File::Spec->catfile($bindir, "nytprofcsv");
my $nytprofcalls = File::Spec->catfile($bindir, "nytprofcalls");
my $nytprofhtml = File::Spec->catfile($bindir, "nytprofhtml");
+my $nytprofpf = File::Spec->catfile($bindir, "nytprofpf");
my $nytprofmerge = File::Spec->catfile($bindir, "nytprofmerge");
my $path_sep = $Config{path_sep} || ':';
@@ -90,6 +92,7 @@ my $perl = $opts{p} || $^X;
# turn ./perl into ../perl, because of chdir(t) above.
$perl = ".$perl" if $perl =~ m|^\./|;
+$perl = qq{"$perl"}; # in case it has spaces
if ($opts{one}) { # for one quick test
@@ -361,6 +364,9 @@ sub run_test {
verify_csv_report($test, $tag, $test_datafile, $outdir);
}
+ elsif ($type eq 'pf') {
+ verify_platforms_csv_report($test, $tag, $test_datafile, $outdir);
+ }
elsif ($type =~ /^(?:pl|pm|new|outdir)$/) {
# skip; handy for "test.pl t/test01.*"
}
@@ -396,13 +402,16 @@ sub run_command {
return $ok;
}
+sub _quote_join {
+ join ' ', map qq{"$_"}, @_;
+}
# some tests use profile_this() in Devel::NYTProf::Run
sub run_perl_command {
my ($cmd, $show_stdout) = @_;
local $ENV{PERL5LIB} = $perl5lib;
my @perl = perl_command_words(skip_sitecustomize => 1);
- run_command("@perl $cmd", $show_stdout);
+ run_command(_quote_join(@perl) . " $cmd", $show_stdout);
}
@@ -410,7 +419,7 @@ sub profile { # TODO refactor to use run_perl_command()?
my ($test, $profile_datafile) = @_;
my @perl = perl_command_words(skip_sitecustomize => 1);
- my $cmd = "@perl $opts{profperlopts} $test";
+ my $cmd = _quote_join(@perl) . " $opts{profperlopts} $test";
return ok run_command($cmd), "$test runs ok under the profiler";
}
@@ -474,12 +483,14 @@ sub dump_profile_to_file {
return;
}
+
sub diff_files {
my ($old_file, $new_file, $newp_file) = @_;
# we don't care if this fails, it's just an aid to debug test failures
- my @opts = split / /, $ENV{NYTPROF_DIFF_OPTS} || $diff_opts; # e.g. '-y'
- system("cmp -s $new_file $newp_file || diff @opts $old_file $new_file 1>&2");
+ # XXX needs to behave better on windows
+ my @opts = split / /, $ENV{NYTPROF_DIFF_OPTS} || $diff_opts; # e.g. '-y'
+ system("diff @opts $old_file $new_file 1>&2");
}
@@ -588,12 +599,33 @@ sub verify_csv_report {
chomp @got;
chomp @expected;
is_deeply(\@got, \@expected, "$test match generated CSV data for $tag") or do {
- spit_file($test.'_new', join("\n", @got,''), $test.'_newp');
+ write_out_file($test.'_new', join("\n", @got,''), $test.'_newp');
diff_files($test, $test.'_new', $test.'_newp');
};
is(join("\n", @accuracy_errors), '', "$test times should be reasonable");
}
+sub verify_platforms_csv_report {
+ my ($test, $tag, $profile_datafile, $outdir) = @_;
+
+ my $outfile = "$outdir/$test.csv";
+
+ my $cmd = "$perl $nytprofpf --file=$profile_datafile --out=$outfile";
+ ok run_command($cmd), "nytprofpf runs ok";
+
+ my $got = slurp_file($outfile);
+
+ #test if all lines from .pf are contained in result file
+ #(we can not be sure about the order, so we match each line individually)
+ my $match_result = 1;
+ open (EXPECTED, $test);
+ while (<EXPECTED>) {
+ $match_result = $match_result && $got =~ m/$_/;
+ }
+ close (EXPECTED);
+
+ ok $match_result, "$outfile file matches $test";
+}
sub pop_times {
my $hash = shift || return;
@@ -626,7 +658,7 @@ sub slurp_file { # individual lines in list context, entire file in scalar co
}
-sub spit_file {
+sub write_out_file {
my ($file, $content, $rename_existing) = @_;
rename $file, $rename_existing or warn "rename($file, $rename_existing): $!"
if $rename_existing && -f $file;
@@ -0,0 +1,5 @@
+Name, File location, Time, Avg. Time, Own Time, Invocation Count, Level
+main::CORE:print, [^,]+?, \d+.\d+, 0.000, \d+.\d+, 10, 0
+main::bar, [^,]+?, \d+.\d+, 0.000, \d+.\d+, 7, 0
+main::baz, [^,]+?, \d+.\d+, 0.000, \d+.\d+, 1, 0
+main::foo, [^,]+?, \d+.\d+, 0.000, \d+.\d+, 2, 0
@@ -6,6 +6,7 @@ use Test::More;
use lib qw(t/lib);
use NYTProfTest;
use Data::Dumper;
+use Config qw(%Config);
use Devel::NYTProf::Run qw(profile_this);
use Devel::NYTProf::Constants qw(NYTP_SCi_elements);
@@ -14,8 +15,14 @@ my $pre589 = ($] < 5.008009 or $] eq "5.010000");
my $src_code = join("", <DATA>);
+# perl assert failure https://rt.perl.org/Ticket/Display.html?id=122771
+my $perl_rt70211 = ($] >= 5.020 && $Config{ccflags} =~ /-DDEBUGGING/);
+
run_test_group( {
- extra_options => { start => 'begin' },
+ extra_options => {
+ start => 'begin',
+ optimize => ($perl_rt70211) ? 0 : 1,
+ },
extra_test_count => 8,
extra_test_code => sub {
my ($profile, $env) = @_;
@@ -1,7 +1,3 @@
-MyTie::TIESCALAR 1
-main::sub4 2
-MyTie::STORE 1
-MyTie::FETCH 1
Devel::NYTProf::Test::example_xsub 2
main::sub1 1
main::CORE:sort 2
@@ -9,3 +5,4 @@ main::CORE:sort;Devel::NYTProf::Test::example_xsub 3
main::CORE:sort;main::sub2 6
main::CORE:subst 1
main::CORE:substcont 3
+main::sub4 2
@@ -1,17 +1,5 @@
# test determination of subroutine caller in unusual cases
-{
- my $a = time;
- # calls to TIESCALAR aren't seen by perl < 5.8.9 and 5.10.1
- sub MyTie::TIESCALAR { bless {}, shift; }
- sub MyTie::FETCH { }
- sub MyTie::STORE { }
-}
-
-tie my $tied, 'MyTie', 42; # TIESCALAR
-$tied = 1; # STORE
-if ($tied) { 1 } # FETCH
-
# test dying from an xsub
require Devel::NYTProf::Test;
eval { Devel::NYTProf::Test::example_xsub(0, "die") };
@@ -23,10 +11,8 @@ sub1 eval { Devel::NYTProf::Test::example_xsub(0, "die") };
# test sub calls (xs and perl) from within a sort block
sub sub2 { $_[0] }
-my @a = sort {
- Devel::NYTProf::Test::example_xsub();
- sub2($a) <=> sub2($b);
-} (1,3,2);
+# sort block on one line due to change to line numbering in perl 5.21
+my @a = sort { Devel::NYTProf::Test::example_xsub(); sub2($a) <=> sub2($b); } (1,3,2);
# test sub call as a sort block
sub sub3 { $_[0] } # XXX not recorded due to limitation of perl
@@ -14,26 +14,17 @@ attribute total_stmts_duration 0
attribute total_stmts_measured 0
attribute total_sub_calls 0
attribute xs_version 0
-fid_block_time 1 4 [ 0 2 ]
-fid_block_time 1 6 [ 0 1 ]
-fid_block_time 1 7 [ 0 1 ]
-fid_block_time 1 8 [ 0 1 ]
-fid_block_time 1 11 [ 0 1 ]
-fid_block_time 1 12 [ 0 1 ]
-fid_block_time 1 13 [ 0 1 ]
-fid_block_time 1 16 [ 0 1 ]
-fid_block_time 1 17 [ 0 2 ]
-fid_block_time 1 21 [ 0 1 ]
+fid_block_time 1 4 [ 0 1 ]
+fid_block_time 1 5 [ 0 2 ]
+fid_block_time 1 9 [ 0 1 ]
+fid_block_time 1 10 [ 0 2 ]
+fid_block_time 1 13 [ 0 6 ]
+fid_block_time 1 15 [ 0 7 ]
+fid_block_time 1 19 [ 0 1 ]
fid_block_time 1 22 [ 0 2 ]
-fid_block_time 1 25 [ 0 6 ]
-fid_block_time 1 26 [ 0 3 ]
-fid_block_time 1 27 [ 0 1 ]
-fid_block_time 1 28 [ 0 3 ]
-fid_block_time 1 33 [ 0 1 ]
-fid_block_time 1 36 [ 0 2 ]
-fid_block_time 1 37 [ 0 1 ]
-fid_block_time 1 38 [ 0 1 ]
-fid_block_time 1 40 [ 0 1 ]
+fid_block_time 1 23 [ 0 1 ]
+fid_block_time 1 24 [ 0 1 ]
+fid_block_time 1 26 [ 0 1 ]
fid_block_time 2 7 [ 0 1 ]
fid_block_time 2 8 [ 0 1 ]
fid_block_time 2 9 [ 0 1 ]
@@ -41,79 +32,55 @@ fid_block_time 2 11 [ 0 1 ]
fid_block_time 2 15 [ 0 1 ]
fid_fileinfo 1 [ test62-subcaller1.p 1 2 0 0 ]
fid_fileinfo 1 sub Devel::NYTProf::Test::example_xsub undef-undef
-fid_fileinfo 1 sub MyTie::FETCH 7-7
-fid_fileinfo 1 sub MyTie::STORE 8-8
-fid_fileinfo 1 sub MyTie::TIESCALAR 6-6
fid_fileinfo 1 sub main::BEGIN 0-0
fid_fileinfo 1 sub main::CORE:sort 0-0
fid_fileinfo 1 sub main::CORE:subst 0-0
fid_fileinfo 1 sub main::CORE:substcont 0-0
fid_fileinfo 1 sub main::RUNTIME 1-1
-fid_fileinfo 1 sub main::sub1 21-21
-fid_fileinfo 1 sub main::sub2 25-25
-fid_fileinfo 1 sub main::sub3 32-32
-fid_fileinfo 1 sub main::sub4 36-36
-fid_fileinfo 1 call 11 MyTie::TIESCALAR [ 1 0 0 0 0 0 0 main::RUNTIME ]
-fid_fileinfo 1 call 12 MyTie::STORE [ 1 0 0 0 0 0 0 main::RUNTIME ]
-fid_fileinfo 1 call 13 MyTie::FETCH [ 1 0 0 0 0 0 0 main::RUNTIME ]
-fid_fileinfo 1 call 17 Devel::NYTProf::Test::example_xsub [ 1 0 0 0 0 0 0 main::RUNTIME ]
-fid_fileinfo 1 call 22 Devel::NYTProf::Test::example_xsub [ 1 0 0 0 0 0 0 main::RUNTIME ]
-fid_fileinfo 1 call 22 main::sub1 [ 1 0 0 0 0 0 0 main::RUNTIME ]
-fid_fileinfo 1 call 26 Devel::NYTProf::Test::example_xsub [ 3 0 0 0 0 0 0 main::CORE:sort ]
-fid_fileinfo 1 call 27 main::CORE:sort [ 1 0 0 0 0 0 0 main::RUNTIME ]
-fid_fileinfo 1 call 28 main::sub2 [ 6 0 0 0 0 0 0 main::CORE:sort ]
-fid_fileinfo 1 call 33 main::CORE:sort [ 1 0 0 0 0 0 0 main::RUNTIME ]
-fid_fileinfo 1 call 38 main::CORE:subst [ 1 0 0 0 0 0 0 main::RUNTIME ]
-fid_fileinfo 1 call 38 main::CORE:substcont [ 3 0 0 0 0 0 0 main::RUNTIME ]
-fid_fileinfo 1 call 38 main::sub4 [ 2 0 0 0 0 0 0 main::RUNTIME ]
+fid_fileinfo 1 sub main::sub1 9-9
+fid_fileinfo 1 sub main::sub2 13-13
+fid_fileinfo 1 sub main::sub3 18-18
+fid_fileinfo 1 sub main::sub4 22-22
+fid_fileinfo 1 call 5 Devel::NYTProf::Test::example_xsub [ 1 0 0 0 0 0 0 main::RUNTIME ]
+fid_fileinfo 1 call 10 Devel::NYTProf::Test::example_xsub [ 1 0 0 0 0 0 0 main::RUNTIME ]
+fid_fileinfo 1 call 10 main::sub1 [ 1 0 0 0 0 0 0 main::RUNTIME ]
+fid_fileinfo 1 call 15 Devel::NYTProf::Test::example_xsub [ 3 0 0 0 0 0 0 main::CORE:sort ]
+fid_fileinfo 1 call 15 main::CORE:sort [ 1 0 0 0 0 0 0 main::RUNTIME ]
+fid_fileinfo 1 call 15 main::sub2 [ 6 0 0 0 0 0 0 main::CORE:sort ]
+fid_fileinfo 1 call 19 main::CORE:sort [ 1 0 0 0 0 0 0 main::RUNTIME ]
+fid_fileinfo 1 call 24 main::CORE:subst [ 1 0 0 0 0 0 0 main::RUNTIME ]
+fid_fileinfo 1 call 24 main::CORE:substcont [ 3 0 0 0 0 0 0 main::RUNTIME ]
+fid_fileinfo 1 call 24 main::sub4 [ 2 0 0 0 0 0 0 main::RUNTIME ]
fid_fileinfo 2 [ Devel/NYTProf/Test.pm 2 2 0 0 ]
fid_fileinfo 2 sub Devel::NYTProf::Test::example_sub 13-13
fid_fileinfo 3 [ Exporter.pm 3 2 0 0 ]
-fid_line_time 1 4 [ 0 2 ]
-fid_line_time 1 6 [ 0 1 ]
-fid_line_time 1 7 [ 0 1 ]
-fid_line_time 1 8 [ 0 1 ]
-fid_line_time 1 11 [ 0 1 ]
-fid_line_time 1 12 [ 0 1 ]
-fid_line_time 1 13 [ 0 1 ]
-fid_line_time 1 16 [ 0 1 ]
-fid_line_time 1 17 [ 0 2 ]
-fid_line_time 1 21 [ 0 1 ]
+fid_line_time 1 4 [ 0 1 ]
+fid_line_time 1 5 [ 0 2 ]
+fid_line_time 1 9 [ 0 1 ]
+fid_line_time 1 10 [ 0 2 ]
+fid_line_time 1 13 [ 0 6 ]
+fid_line_time 1 15 [ 0 7 ]
+fid_line_time 1 19 [ 0 1 ]
fid_line_time 1 22 [ 0 2 ]
-fid_line_time 1 25 [ 0 6 ]
-fid_line_time 1 26 [ 0 3 ]
-fid_line_time 1 27 [ 0 1 ]
-fid_line_time 1 28 [ 0 3 ]
-fid_line_time 1 33 [ 0 1 ]
-fid_line_time 1 36 [ 0 2 ]
-fid_line_time 1 37 [ 0 1 ]
-fid_line_time 1 38 [ 0 1 ]
-fid_line_time 1 40 [ 0 1 ]
+fid_line_time 1 23 [ 0 1 ]
+fid_line_time 1 24 [ 0 1 ]
+fid_line_time 1 26 [ 0 1 ]
fid_line_time 2 7 [ 0 1 ]
fid_line_time 2 8 [ 0 1 ]
fid_line_time 2 9 [ 0 1 ]
fid_line_time 2 11 [ 0 1 ]
fid_line_time 2 15 [ 0 1 ]
-fid_sub_time 1 4 [ 0 2 ]
-fid_sub_time 1 6 [ 0 1 ]
-fid_sub_time 1 7 [ 0 1 ]
-fid_sub_time 1 8 [ 0 1 ]
-fid_sub_time 1 11 [ 0 1 ]
-fid_sub_time 1 12 [ 0 1 ]
-fid_sub_time 1 13 [ 0 1 ]
-fid_sub_time 1 16 [ 0 1 ]
-fid_sub_time 1 17 [ 0 2 ]
-fid_sub_time 1 21 [ 0 1 ]
+fid_sub_time 1 4 [ 0 1 ]
+fid_sub_time 1 5 [ 0 2 ]
+fid_sub_time 1 9 [ 0 1 ]
+fid_sub_time 1 10 [ 0 2 ]
+fid_sub_time 1 13 [ 0 6 ]
+fid_sub_time 1 15 [ 0 7 ]
+fid_sub_time 1 19 [ 0 1 ]
fid_sub_time 1 22 [ 0 2 ]
-fid_sub_time 1 25 [ 0 6 ]
-fid_sub_time 1 26 [ 0 3 ]
-fid_sub_time 1 27 [ 0 1 ]
-fid_sub_time 1 28 [ 0 3 ]
-fid_sub_time 1 33 [ 0 1 ]
-fid_sub_time 1 36 [ 0 2 ]
-fid_sub_time 1 37 [ 0 1 ]
-fid_sub_time 1 38 [ 0 1 ]
-fid_sub_time 1 40 [ 0 1 ]
+fid_sub_time 1 23 [ 0 1 ]
+fid_sub_time 1 24 [ 0 1 ]
+fid_sub_time 1 26 [ 0 1 ]
fid_sub_time 2 7 [ 0 1 ]
fid_sub_time 2 8 [ 0 1 ]
fid_sub_time 2 9 [ 0 1 ]
@@ -124,28 +91,22 @@ profile_modes fid_line_time line
profile_modes fid_sub_time sub
sub_subinfo Devel::NYTProf::Test::example_sub [ 2:13-13 calls 0 times 0 0 0 0 ]
sub_subinfo Devel::NYTProf::Test::example_xsub [ 1:undef-undef calls 5 times 0 0 0 0 ]
-sub_subinfo Devel::NYTProf::Test::example_xsub called_by 1:17 [ 1 0 0 0 0 0 0 main::RUNTIME ]
-sub_subinfo Devel::NYTProf::Test::example_xsub called_by 1:22 [ 1 0 0 0 0 0 0 main::RUNTIME ]
-sub_subinfo Devel::NYTProf::Test::example_xsub called_by 1:26 [ 3 0 0 0 0 0 0 main::CORE:sort ]
-sub_subinfo MyTie::FETCH [ 1:7-7 calls 1 times 0 0 0 0 ]
-sub_subinfo MyTie::FETCH called_by 1:13 [ 1 0 0 0 0 0 0 main::RUNTIME ]
-sub_subinfo MyTie::STORE [ 1:8-8 calls 1 times 0 0 0 0 ]
-sub_subinfo MyTie::STORE called_by 1:12 [ 1 0 0 0 0 0 0 main::RUNTIME ]
-sub_subinfo MyTie::TIESCALAR [ 1:6-6 calls 1 times 0 0 0 0 ]
-sub_subinfo MyTie::TIESCALAR called_by 1:11 [ 1 0 0 0 0 0 0 main::RUNTIME ]
+sub_subinfo Devel::NYTProf::Test::example_xsub called_by 1:5 [ 1 0 0 0 0 0 0 main::RUNTIME ]
+sub_subinfo Devel::NYTProf::Test::example_xsub called_by 1:10 [ 1 0 0 0 0 0 0 main::RUNTIME ]
+sub_subinfo Devel::NYTProf::Test::example_xsub called_by 1:15 [ 3 0 0 0 0 0 0 main::CORE:sort ]
sub_subinfo main::BEGIN [ 1:0-0 calls 0 times 0 0 0 0 ]
sub_subinfo main::CORE:sort [ 1:0-0 calls 2 times 0 0 0 0 ]
-sub_subinfo main::CORE:sort called_by 1:27 [ 1 0 0 0 0 0 0 main::RUNTIME ]
-sub_subinfo main::CORE:sort called_by 1:33 [ 1 0 0 0 0 0 0 main::RUNTIME ]
+sub_subinfo main::CORE:sort called_by 1:15 [ 1 0 0 0 0 0 0 main::RUNTIME ]
+sub_subinfo main::CORE:sort called_by 1:19 [ 1 0 0 0 0 0 0 main::RUNTIME ]
sub_subinfo main::CORE:subst [ 1:0-0 calls 1 times 0 0 0 0 ]
-sub_subinfo main::CORE:subst called_by 1:38 [ 1 0 0 0 0 0 0 main::RUNTIME ]
+sub_subinfo main::CORE:subst called_by 1:24 [ 1 0 0 0 0 0 0 main::RUNTIME ]
sub_subinfo main::CORE:substcont [ 1:0-0 calls 3 times 0 0 0 0 ]
-sub_subinfo main::CORE:substcont called_by 1:38 [ 3 0 0 0 0 0 0 main::RUNTIME ]
+sub_subinfo main::CORE:substcont called_by 1:24 [ 3 0 0 0 0 0 0 main::RUNTIME ]
sub_subinfo main::RUNTIME [ 1:1-1 calls 0 times 0 0 0 0 ]
-sub_subinfo main::sub1 [ 1:21-21 calls 1 times 0 0 0 0 ]
-sub_subinfo main::sub1 called_by 1:22 [ 1 0 0 0 0 0 0 main::RUNTIME ]
-sub_subinfo main::sub2 [ 1:25-25 calls 6 times 0 0 0 0 ]
-sub_subinfo main::sub2 called_by 1:28 [ 6 0 0 0 0 0 0 main::CORE:sort ]
-sub_subinfo main::sub3 [ 1:32-32 calls 0 times 0 0 0 0 ]
-sub_subinfo main::sub4 [ 1:36-36 calls 2 times 0 0 0 0 ]
-sub_subinfo main::sub4 called_by 1:38 [ 2 0 0 0 0 0 0 main::RUNTIME ]
+sub_subinfo main::sub1 [ 1:9-9 calls 1 times 0 0 0 0 ]
+sub_subinfo main::sub1 called_by 1:10 [ 1 0 0 0 0 0 0 main::RUNTIME ]
+sub_subinfo main::sub2 [ 1:13-13 calls 6 times 0 0 0 0 ]
+sub_subinfo main::sub2 called_by 1:15 [ 6 0 0 0 0 0 0 main::CORE:sort ]
+sub_subinfo main::sub3 [ 1:18-18 calls 0 times 0 0 0 0 ]
+sub_subinfo main::sub4 [ 1:22-22 calls 2 times 0 0 0 0 ]
+sub_subinfo main::sub4 called_by 1:24 [ 2 0 0 0 0 0 0 main::RUNTIME ]