@@ -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"
@@ -1,9 +1,47 @@
=head1 NAME
-Changes - History of significant changes in Devel::NYTProf
+Devel::NYTProf::Changes - History of significant changes in Devel::NYTProf
=cut
+=head2 Changes in Devel::NYTProf 6.01 - 4th April 2015
+
+ Changed the clock used on Windows to high resolution QueryPerformanceCounter
+ which makes NYTProf useful on windows, at last, thanks to bulk88, #68
+
+ Fallback to checking PATH for nytprof scripts, #61 thanks to calid
+ Fix unused variable warnings thanks to zefram, RT#103107
+ Fix handling of PERL_DISABLE_PMC, thanks to bulk88, #67
+
+ Use larger buffer size when writing the data file, thanks to bulk88 #69
+
+ Clarified the docs re DB:: functions, #63 thanks to dbooth-boston
+ Documentation cleanup thanks to wollmers, #64
+ Clarify reason for loading Devel::NYTProf as early as possible.
+ Clarification of the RUN-TIME CONTROL OF PROFILING docs
+
+=head2 Changes in Devel::NYTProf 5.07 - 21st Feb 2015
+
+ 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;
@@ -196,9 +215,15 @@ NYTP_open(const char *name, const char *mode) {
if (!raw_file)
return NULL;
+/* MS libc has 4096 as default, this is too slow for GB size profiling data */
+ if (setvbuf(raw_file, NULL, _IOFBF, 16384))
+ return NULL;
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 +259,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 +311,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 +414,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 +501,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 +540,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 +587,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 +604,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 +618,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 +881,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 +966,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 +1122,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,8 @@ t/test01.t
t/test01.x
t/test02.calls
t/test02.p
+t/test02.pf
+t/test02.pf.csv
t/test02.rdt
t/test02.t
t/test02.x
@@ -216,6 +220,14 @@ t/test62-subcaller1.calls
t/test62-subcaller1.p
t/test62-subcaller1.rdt
t/test62-subcaller1.t
+t/test62-tie-a.calls
+t/test62-tie-a.p
+t/test62-tie-a.rdt
+t/test62-tie-a.t
+t/test62-tie-b.calls
+t/test62-tie-b.p
+t/test62-tie-b.rdt
+t/test62-tie-b.t
t/test70-subexcl.calls
t/test70-subexcl.p
t/test70-subexcl.t
@@ -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 7.04, CPAN::Meta::Converter version 2.143240",
"license" : [
"perl_5"
],
@@ -28,8 +28,14 @@
"ExtUtils::MakeMaker" : "0"
}
},
+ "configure" : {
+ "requires" : {
+ "ExtUtils::MakeMaker" : "0"
+ }
+ },
"runtime" : {
"requires" : {
+ "File::Which" : "1.09",
"Getopt::Long" : "0",
"JSON::Any" : "0",
"List::Util" : "0",
@@ -56,5 +62,5 @@
},
"x_MailingList" : "http://groups.google.com/group/develnytprof-dev"
},
- "version" : "5.06"
+ "version" : "6.01"
}
@@ -3,13 +3,15 @@ abstract: 'Powerful fast feature-rich Perl source code profiler'
author:
- 'Tim Bunce <timb@cpan.org>'
build_requires:
- ExtUtils::MakeMaker: 0
+ ExtUtils::MakeMaker: '0'
+configure_requires:
+ ExtUtils::MakeMaker: '0'
dynamic_config: 1
-generated_by: 'ExtUtils::MakeMaker version 6.68, CPAN::Meta::Converter version 2.131560'
+generated_by: 'ExtUtils::MakeMaker version 7.04, CPAN::Meta::Converter version 2.143240'
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:
@@ -18,16 +20,17 @@ no_index:
package:
- SVG
requires:
- Getopt::Long: 0
- JSON::Any: 0
- List::Util: 0
- Test::Differences: 0.60
- Test::More: 0.84
- XSLoader: 0
+ File::Which: '1.09'
+ 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: '6.01'
@@ -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;
@@ -154,6 +159,7 @@ WriteMakefile(
PREREQ_PM => {
'List::Util' => 0,
'Test::More' => '0.84',
+ 'File::Which' => '1.09',
'Test::Differences' => '0.60',
'XSLoader' => 0,
'Getopt::Long' => 0,
@@ -161,7 +167,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;
@@ -296,13 +301,21 @@ and write the options to the stream when profiling starts.
/* time tracking */
+#ifdef WIN32
+/* win32_gettimeofday has ~15 ms resolution on Win32, so use
+ * QueryPerformanceCounter which has us or ns resolution depending on
+ * motherboard and OS. Comment this out to use the old clock.
+ */
+# define HAS_QPC
+#endif /* WIN32 */
#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)
@@ -331,7 +344,51 @@ typedef uint64_t time_of_day_t;
#else /* !HAS_MACH_TIME */
-#ifdef HAS_GETTIMEOFDAY
+#ifdef HAS_QPC
+
+# ifndef U64_CONST
+# ifdef _MSC_VER
+# define U64_CONST(x) x##UI64
+# else
+# define U64_CONST(x) x##ULL
+# endif
+# endif
+
+unsigned __int64 time_frequency = U64_CONST(0);
+typedef unsigned __int64 time_of_day_t;
+# define TICKS_PER_SEC time_frequency
+# define get_time_of_day(into) QueryPerformanceCounter((LARGE_INTEGER*)&into)
+# define get_ticks_between(typ, s, e, ticks, overflow) STMT_START { \
+ overflow = 0; /* XXX whats this? */ \
+ ticks = (typ)(e-s); \
+} STMT_END
+
+/* workaround for "error C2520: conversion from unsigned __int64 to double not
+ implemented, use signed __int64" on VC 6 */
+# if defined(_MSC_VER) && _MSC_VER < 1300 /* < VC 7/2003*/
+# define NYTPIuint642NV(x) \
+ ((NV)(__int64)((x) & U64_CONST(0x7FFFFFFFFFFFFFFF)) \
+ + -(NV)(__int64)((x) & U64_CONST(0x8000000000000000)))
+# define get_NV_ticks_between(s, e, ticks, overflow) STMT_START { \
+ overflow = 0; /* XXX whats this? */ \
+ ticks = NYTPIuint642NV(e-s); \
+} STMT_END
+
+# endif
+
+#elif defined(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,19 +397,30 @@ 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
+static int (*time_hires_u2time_hook)(pTHX_ UV *) = 0;
+
+#endif /* HAS_GETTIMEOFDAY else */
+#endif /* HAS_MACH_TIME else */
+#endif /* HAS_CLOCK_GETTIME else */
+
+#ifndef get_NV_ticks_between
+# define get_NV_ticks_between(s, e, ticks, overflow) get_ticks_between(NV, s, e, ticks, overflow)
#endif
-#endif
+
+#ifndef NYTPIuint642NV
+# define NYTPIuint642NV(x) ((NV)(x))
#endif
static time_of_day_t start_time;
@@ -443,6 +511,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 +533,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
*/
@@ -1132,6 +1211,9 @@ get_file_id(pTHX_ char* file_name, STRLEN file_name_len, int created_via)
/**
* Return a unique persistent id number for a string.
+ *
+ * XXX Currently not used, so may trigger compiler warnings, but is intended to be
+ * used to assign ids to strings like subroutine names like we do for file ids.
*/
static unsigned int
get_str_id(pTHX_ char* str, STRLEN len)
@@ -1683,6 +1765,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 +1831,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 +1859,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 +1889,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 +2087,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 +2147,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 +2171,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 +3049,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 */
@@ -3023,6 +3116,24 @@ _init_profiler_clock(pTHX)
profile_clock = -1;
}
#endif
+#ifdef HAS_QPC
+{
+ const char * fnname;
+ if(!QueryPerformanceFrequency((LARGE_INTEGER *)&time_frequency)) {
+ fnname = "QueryPerformanceFrequency";
+ goto win32_failed;
+ }
+ {
+ LARGE_INTEGER tmp; /* do 1 test call, dont check return value for
+ further calls for performance reasons */
+ if(!QueryPerformanceCounter(&tmp)) {
+ fnname = "QueryPerformanceCounter";
+ win32_failed:
+ croak("%s failed with Win32 error %u, no clocks available", fnname, GetLastError());
+ }
+ }
+}
+#endif
ticks_per_sec = TICKS_PER_SEC;
}
@@ -3088,13 +3199,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 +4329,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 +4696,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 +4979,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 +4997,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);
@@ -4920,7 +5030,20 @@ load_profile_to_hv(pTHX_ NYTP_file in)
int show_summary_stats = (trace_level >= 1);
if (state.profiler_end_time
- && state.total_stmts_duration > state.profiler_duration * 1.1) {
+ && state.total_stmts_duration > state.profiler_duration * 1.1
+/* GetSystemTimeAsFiletime/gettimeofday_nv on Win32 have 15.625 ms resolution
+ by default. 1 ms best case scenario if you use special options which Perl
+ land doesn't use, and MS strongly discourages in
+ "Timers, Timer Resolution, and Development of Efficient Code". So for short
+ programs profiler_duration winds up being 0. If necessery, in the future
+ profiler_duration could be set to 15.625 ms automatically on NYTProf start
+ because of the argument that a process can not execute in 0 ms according to
+ the laws of space and time, or at "the end" if profiler_duration is 0.0, set
+ it to 15.625 ms*/
+#ifdef HAS_QPC
+ && state.profiler_duration != 0.0
+#endif
+ ) {
logwarn("The sum of the statement timings is %.1"NVff"%% of the total time profiling."
" (Values slightly over 100%% can be due simply to cumulative timing errors,"
" whereas larger values can indicate a problem with the clock used.)\n",
@@ -5028,7 +5151,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);
}
@@ -5131,6 +5254,7 @@ PROTOTYPES: DISABLE
void
example_xsub(const char *unused="", SV *action=Nullsv, SV *arg=Nullsv)
CODE:
+ PERL_UNUSED_VAR(unused);
if (!action)
XSRETURN(0);
if (SvROK(action) && SvTYPE(SvRV(action))==SVt_PVCV) {
@@ -5179,7 +5303,7 @@ ticks_for_usleep(long u_seconds)
get_time_of_day(s_time);
PerlSock_select(0, 0, 0, 0, &timebuf);
get_time_of_day(e_time);
- get_ticks_between(NV, s_time, e_time, elapsed, overflow);
+ get_NV_ticks_between(s_time, e_time, elapsed, overflow);
#else
PERL_UNUSED_VAR(u_seconds);
#endif
@@ -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 = '6.01';
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,8 @@ use Config qw(%Config);
use Getopt::Long;
use List::Util qw(sum max);
use File::Copy;
+use File::Spec;
+use File::Which qw(which);
use File::Path qw(rmtree);
# Handle --profself before loading Devel::NYTProf::Core
@@ -59,7 +61,7 @@ use Devel::NYTProf::Util qw(
);
use Devel::NYTProf::Constants qw(NYTP_SCi_CALLING_SUB);
-our $VERSION = '5.06';
+our $VERSION = '6.01';
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 +70,20 @@ 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');
+$nytprofcalls = which 'nytprofcalls' if not -e $nytprofcalls;
+
+die "Unable to find nytprofcalls in $Config{bin} or on the PATH"
+ unless $nytprofcalls;
+
+my $flamegraph = File::Spec->catfile($Config{'bin'}, 'flamegraph') . $script_ext;
+$flamegraph = which "flamegraph$script_ext" if not -e $flamegraph;
+
+die "Unable to find flamegraph$script_ext in $Config{bin} or on the PATH"
+ unless $flamegraph;
+
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 +805,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 +830,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 +1326,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 +1335,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 +1987,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 = '6.01';
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 = '6.01';
+
+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 = '6.01'; # 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 = '6.01'; # 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
@@ -330,6 +338,7 @@ Specify at which phase of program execution the profiler should be enabled:
The start=no option is handy if you want to explicitly control profiling
by calling DB::enable_profile() and DB::disable_profile() yourself.
+See L</RUN-TIME CONTROL OF PROFILING>.
=head2 optimize=0
@@ -599,30 +608,39 @@ collecting profile data.
Using the C<start=no> option lets you leave the profiler disabled initially
until you call DB::enable_profile() at the right moment. You still need to
load Devel::NYTProf as early as possible, even if you don't call
-DB::enable_profile() until much later. See also L</use_db_sub=1>.
+DB::enable_profile() until much later. That's because any code that's compiled
+before Devel::NYTProf is loaded will not be profiled by default. See also
+L</use_db_sub=1>.
The profile output file can't be used until it's been properly completed and
closed. Calling DB::disable_profile() doesn't do that. To make a profile file
usable before the profiled application has completed you can call
DB::finish_profile(). Alternatively you could call DB::enable_profile($newfile).
+Always call the DB::enable_profile(), DB::disable_profile() or
+DB::finish_profile() function with the C<DB::> prefix as shown because you
+can't import them. They're provided automatically when NYTProf is in use.
+
=head2 disable_profile
DB::disable_profile()
-Stops collection of profile data.
+Stops collection of profile data until DB:enable_profile() is called.
Subroutine calls which were made while profiling was enabled and are still on
the call stack (have not yet exited) will still have their profile data
-collected when they exit.
+collected when they exit. Compare with L</finish_profile> below.
=head2 enable_profile
DB::enable_profile($newfile)
+ DB::enable_profile()
-Enables collection of profile data. If $newfile is true the profile data will be
+Enables collection of profile data. If $newfile is specified the profile data will be
written to $newfile (after completing and closing the previous file, if any).
If $newfile already exists it will be deleted first.
+If DB::enable_profile() is called without a filename argument then profile data
+will continue to be written to the current file (nytprof.out by default).
=head2 finish_profile
@@ -650,7 +668,7 @@ when perl calls or returns from a subroutine.
The individual statement timings for a subroutine usually add up to slightly
less than the exclusive time for the subroutine. That's because the handling of
the subroutine call and return overheads is included in the exclusive time for
-the subroutine. The difference may only be a new microseconds but that may
+the subroutine. The difference may only be a few microseconds but that may
become noticeable for subroutines that are called hundreds of thousands of times.
The statement profiler keeps track how much time was spent on overheads, like
@@ -861,6 +879,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
@@ -1074,6 +1097,8 @@ impacted by those more than it otherwise would.
=head3 Windows
+B<THIS SECTION DOESN'T MATCH THE CODE>
+
On Windows NYTProf uses Time::HiRes which uses the windows
QueryPerformanceCounter() API with some extra logic to adjust for the current
clock speed and try to resync the raw counter to wallclock time every so often
@@ -1204,6 +1229,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);
@@ -2,7 +2,7 @@ use Test::More;
my $nytprof_out;
BEGIN {
- $nytprof_out = "nytprof-50-errno.out";
+ $nytprof_out = "t/nytprof-50-errno.out";
$ENV{NYTPROF} = "start=init:file=$nytprof_out";
unlink $nytprof_out;
}
@@ -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
@@ -0,0 +1,5 @@
+Name, File location, Time, Avg. Time, Own Time, Invocation Count, Level
+main::bar, /Users/timbo/repos/nytprof/master/t/test02.p, 0.117, 0.000, 0.067, 7, 0
+main::CORE:print, /Users/timbo/repos/nytprof/master/t/test02.p, 0.052, 0.000, 0.052, 10, 0
+main::baz, /Users/timbo/repos/nytprof/master/t/test02.p, 0.057, 0.000, 0.026, 1, 0
+main::foo, /Users/timbo/repos/nytprof/master/t/test02.p, 0.031, 0.000, 0.019, 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,8 +1,18 @@
use strict;
use Test::More;
use Config;
+
+my $no_pmc;
+if (Config->can('non_bincompat_options')) {
+ foreach(Config::non_bincompat_options()) {
+ if($_ eq "PERL_DISABLE_PMC"){
+ $no_pmc = 1;
+ last;
+ }
+ }
+};
plan skip_all => ".pmc are disabled in this perl"
- if $Config{ccflags} =~ /(?<!\w)-DPERL_DISABLE_PMC\b/;
+ if $no_pmc;
use lib qw(t/lib);
use NYTProfTest;
@@ -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 ]
@@ -0,0 +1,3 @@
+MyTie::TIESCALAR 1
+MyTie::STORE 1
+MyTie::FETCH 1
@@ -0,0 +1,14 @@
+# test determination of subroutine caller in tie calls
+
+{
+ # 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
+
+exit 0;
@@ -0,0 +1,57 @@
+attribute application test62-tie-a.p
+attribute basetime 0
+attribute clock_id 0
+attribute complete 1
+attribute nv_size 0
+attribute perl_version 0
+attribute profiler_active 0
+attribute profiler_duration 0
+attribute profiler_end_time 0
+attribute profiler_start_time 0
+attribute ticks_per_sec 0
+attribute total_stmts_discounted 0
+attribute total_stmts_duration 0
+attribute total_stmts_measured 0
+attribute total_sub_calls 0
+attribute xs_version 0
+fid_block_time 1 5 [ 0 2 ]
+fid_block_time 1 6 [ 0 1 ]
+fid_block_time 1 7 [ 0 1 ]
+fid_block_time 1 10 [ 0 1 ]
+fid_block_time 1 11 [ 0 1 ]
+fid_block_time 1 12 [ 0 1 ]
+fid_block_time 1 14 [ 0 1 ]
+fid_fileinfo 1 [ test62-tie-a.p 1 2 0 0 ]
+fid_fileinfo 1 sub MyTie::FETCH 6-6
+fid_fileinfo 1 sub MyTie::STORE 7-7
+fid_fileinfo 1 sub MyTie::TIESCALAR 5-5
+fid_fileinfo 1 sub main::BEGIN 0-0
+fid_fileinfo 1 sub main::RUNTIME 1-1
+fid_fileinfo 1 call 10 MyTie::TIESCALAR [ 1 0 0 0 0 0 0 main::RUNTIME ]
+fid_fileinfo 1 call 11 MyTie::STORE [ 1 0 0 0 0 0 0 main::RUNTIME ]
+fid_fileinfo 1 call 12 MyTie::FETCH [ 1 0 0 0 0 0 0 main::RUNTIME ]
+fid_line_time 1 5 [ 0 2 ]
+fid_line_time 1 6 [ 0 1 ]
+fid_line_time 1 7 [ 0 1 ]
+fid_line_time 1 10 [ 0 1 ]
+fid_line_time 1 11 [ 0 1 ]
+fid_line_time 1 12 [ 0 1 ]
+fid_line_time 1 14 [ 0 1 ]
+fid_sub_time 1 5 [ 0 2 ]
+fid_sub_time 1 6 [ 0 1 ]
+fid_sub_time 1 7 [ 0 1 ]
+fid_sub_time 1 10 [ 0 1 ]
+fid_sub_time 1 11 [ 0 1 ]
+fid_sub_time 1 12 [ 0 1 ]
+fid_sub_time 1 14 [ 0 1 ]
+profile_modes fid_block_time block
+profile_modes fid_line_time line
+profile_modes fid_sub_time sub
+sub_subinfo MyTie::FETCH [ 1:6-6 calls 1 times 0 0 0 0 ]
+sub_subinfo MyTie::FETCH called_by 1:12 [ 1 0 0 0 0 0 0 main::RUNTIME ]
+sub_subinfo MyTie::STORE [ 1:7-7 calls 1 times 0 0 0 0 ]
+sub_subinfo MyTie::STORE called_by 1:11 [ 1 0 0 0 0 0 0 main::RUNTIME ]
+sub_subinfo MyTie::TIESCALAR [ 1:5-5 calls 1 times 0 0 0 0 ]
+sub_subinfo MyTie::TIESCALAR called_by 1:10 [ 1 0 0 0 0 0 0 main::RUNTIME ]
+sub_subinfo main::BEGIN [ 1:0-0 calls 0 times 0 0 0 0 ]
+sub_subinfo main::RUNTIME [ 1:1-1 calls 0 times 0 0 0 0 ]
@@ -0,0 +1,12 @@
+use strict;
+use Test::More;
+use lib qw(t/lib);
+use NYTProfTest;
+
+plan skip_all => "needs perl >= 5.8.9 or >= 5.10.1"
+ if $] < 5.008009 or $] eq "5.010000";
+
+plan skip_all => "needs perl < 5.21.1 (see t/test62-tie-b.t)" # XXX
+ if $] >= 5.021001;
+
+run_test_group;
@@ -0,0 +1,3 @@
+MyTie::TIESCALAR 1
+MyTie::STORE 1
+MyTie::FETCH 1
@@ -0,0 +1,14 @@
+# test determination of subroutine caller in tie calls
+
+{
+ # 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
+
+exit 0;
@@ -0,0 +1,57 @@
+attribute application test62-tie-b.p
+attribute basetime 0
+attribute clock_id 0
+attribute complete 1
+attribute nv_size 0
+attribute perl_version 0
+attribute profiler_active 0
+attribute profiler_duration 0
+attribute profiler_end_time 0
+attribute profiler_start_time 0
+attribute ticks_per_sec 0
+attribute total_stmts_discounted 0
+attribute total_stmts_duration 0
+attribute total_stmts_measured 0
+attribute total_sub_calls 0
+attribute xs_version 0
+fid_block_time 1 5 [ 0 1 ]
+fid_block_time 1 6 [ 0 1 ]
+fid_block_time 1 7 [ 0 1 ]
+fid_block_time 1 10 [ 0 2 ]
+fid_block_time 1 11 [ 0 1 ]
+fid_block_time 1 12 [ 0 1 ]
+fid_block_time 1 14 [ 0 1 ]
+fid_fileinfo 1 [ test62-tie-b.p 1 2 0 0 ]
+fid_fileinfo 1 sub MyTie::FETCH 6-6
+fid_fileinfo 1 sub MyTie::STORE 7-7
+fid_fileinfo 1 sub MyTie::TIESCALAR 5-5
+fid_fileinfo 1 sub main::BEGIN 0-0
+fid_fileinfo 1 sub main::RUNTIME 1-1
+fid_fileinfo 1 call 10 MyTie::TIESCALAR [ 1 0 0 0 0 0 0 main::RUNTIME ]
+fid_fileinfo 1 call 11 MyTie::STORE [ 1 0 0 0 0 0 0 main::RUNTIME ]
+fid_fileinfo 1 call 12 MyTie::FETCH [ 1 0 0 0 0 0 0 main::RUNTIME ]
+fid_line_time 1 5 [ 0 1 ]
+fid_line_time 1 6 [ 0 1 ]
+fid_line_time 1 7 [ 0 1 ]
+fid_line_time 1 10 [ 0 2 ]
+fid_line_time 1 11 [ 0 1 ]
+fid_line_time 1 12 [ 0 1 ]
+fid_line_time 1 14 [ 0 1 ]
+fid_sub_time 1 5 [ 0 1 ]
+fid_sub_time 1 6 [ 0 1 ]
+fid_sub_time 1 7 [ 0 1 ]
+fid_sub_time 1 10 [ 0 2 ]
+fid_sub_time 1 11 [ 0 1 ]
+fid_sub_time 1 12 [ 0 1 ]
+fid_sub_time 1 14 [ 0 1 ]
+profile_modes fid_block_time block
+profile_modes fid_line_time line
+profile_modes fid_sub_time sub
+sub_subinfo MyTie::FETCH [ 1:6-6 calls 1 times 0 0 0 0 ]
+sub_subinfo MyTie::FETCH called_by 1:12 [ 1 0 0 0 0 0 0 main::RUNTIME ]
+sub_subinfo MyTie::STORE [ 1:7-7 calls 1 times 0 0 0 0 ]
+sub_subinfo MyTie::STORE called_by 1:11 [ 1 0 0 0 0 0 0 main::RUNTIME ]
+sub_subinfo MyTie::TIESCALAR [ 1:5-5 calls 1 times 0 0 0 0 ]
+sub_subinfo MyTie::TIESCALAR called_by 1:10 [ 1 0 0 0 0 0 0 main::RUNTIME ]
+sub_subinfo main::BEGIN [ 1:0-0 calls 0 times 0 0 0 0 ]
+sub_subinfo main::RUNTIME [ 1:1-1 calls 0 times 0 0 0 0 ]
@@ -0,0 +1,9 @@
+use strict;
+use Test::More;
+use lib qw(t/lib);
+use NYTProfTest;
+
+plan skip_all => "needs perl >= 5.21.1 (see t/test62-tie-a)"
+ if $] < 5.021001;
+
+run_test_group;