improvements from cperl

.travis.yml

@@ -3,6 +3,9 @@ language: perl
 perl:
     - "dev"
     - "dev-thr-mb-shrplib-dbg"
+    - "5.30"
+    - "5.28"
+    - "5.26"
     - "5.24"
     - "5.24-extras"
     - "5.24-thr-mb-shrplib-dbg"
@@ -21,20 +24,27 @@ perl:
 sudo: false             # faster builds as long as you don't need sudo access
 
 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
+  - eval $(curl https://travis-perl.github.io/init) --auto
+  - if [ X$cperl != X ]; then
+      perlbrew --notest install $cperl ;
+      perlbrew use $cperl ;
+    fi
 
 install:
-    - cpan-install --deps       # installs prereqs, including recommends
-    - cpanm Test::Pod Test::Pod::Coverage || true
-    - cpanm Test::Portability::Files || true
+  - if [ X$cperl != X ]; then
+      alias perl=~/perl5/perlbrew/perls/$cperl/bin/cperl ;
+      alias cpan=~/perl5/perlbrew/perls/$cperl/bin/cpan ;
+      cpan App::cpanminus ;
+    fi
+  - cpan-install --deps       # installs prereqs, including recommends
+  - cpanm Test::Pod Test::Pod::Coverage || true
+  - cpanm Test::Portability::Files || true
 
 matrix:
   fast_finish: true
+  include:
+    - perl: "5.28"
+      env: cperl=cperl-5.28.2
   allow_failures:
     - perl: dev
     - perl: dev-thr-mb-shrplib-dbg

Changes

@@ -4,6 +4,32 @@ Devel::NYTProf::Changes - History of significant changes in Devel::NYTProf
 
 =cut
 
+=head2 Changes in Devel::NYTProf 6.06_03 - 18th June 2019
+
+  in cperl-5.30.0
+
+  Fixes #399
+  CVE-2019-11358 and CVE-2015-9251 jquery-1.12.4.js update to latest
+
+  Also update the two plugins to latest,
+  and adjust the tablesorter css.
+
+=head2 Changes in Devel::NYTProf 6.06_02 - 14th Apr 2019
+
+  in cperl-5.29.2
+
+  merge cperl patches with master:
+  simplify pp_subcall_profiler op_type, -Wformat
+
+=head2 Changes in Devel::NYTProf 6.06_01 - 29th Aug 2018
+
+  in cperl-5.28.0
+
+  rebased our cperl-core branch to 6.06
+  Support more cperl features:
+    signatures, enterxssub, builtin strict, anon named subs
+    See https://github.com/rurban/devel-nytprof/tree/cperl-core
+
 =head2 Changes in Devel::NYTProf 6.06 - 4th June 2018
 
   Fix sorting of numbers ending ...5s as microsec

FileHandle.h

@@ -69,7 +69,7 @@ const char *NYTP_type_of_offset(NYTP_file file);
 #define NYTP_TAG_SUB_RETURN      '<'
 /* also add new items to nytp_tax_index below */
 
-typedef enum {      /* XXX keep in sync with various *_callback strucures */
+typedef enum {      /* XXX keep in sync with various *_callback structures */
     nytp_no_tag,
     nytp_version,   /* Not actually a tag, but needed by the perl callback */
     nytp_attribute,

FileHandle.xs

@@ -20,7 +20,9 @@
 #include "FileHandle.h"
 #include "NYTProf.h"
 
+#define NEED_newRV_noinc
 #define NEED_sv_2pvbyte
+#define NEED_my_snprintf
 #include "ppport.h"
 
 #ifdef HAS_ZLIB
@@ -217,9 +219,11 @@ 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))
+    /* MS libc has 4096 as default, this is too slow for GB size profiling data */
+    if (setvbuf(raw_file, NULL, _IOFBF, 16384)) {
+        fclose(raw_file);
         return NULL;
+    }
     Newx(file, 1, struct NYTP_file_t);
     file->file = raw_file;
 
@@ -878,7 +882,7 @@ NYTP_write_comment(NYTP_file ofile, const char *format, ...) {
 
     va_start(args, format);
 
-    if(strEQ(format, "%s")) {
+    if(strEQc(format, "%s")) {
         const char * const s = va_arg(args, char*);
         STRLEN len = strlen(s);
         retval = NYTP_write(ofile, s, len);
@@ -969,7 +973,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), "%"NVgf, value);
+    const size_t len = my_snprintf(buffer, sizeof(buffer), "%" NVgf, value);
 
     return NYTP_write_attribute_string(ofile, key, key_len, buffer, len);
 }
@@ -989,7 +993,7 @@ NYTP_write_option_iv(NYTP_file ofile, const char *key, IV value)
 {
     /* 3: 1 for rounding errors, 1 for the sign, 1 for the '\0'  */
     char buffer[(int)(sizeof (IV) * CHAR_BIT * LOG_2_OVER_LOG_10 + 3)];
-    const size_t len = my_snprintf(buffer, sizeof(buffer), "%"IVdf, value);
+    const size_t len = my_snprintf(buffer, sizeof(buffer), "%" IVdf, value);
 
     return NYTP_write_option_pv(ofile, key, buffer, len);
 }
@@ -1247,9 +1251,6 @@ NYTP_write_sub_info(NYTP_file ofile, U32 fid,
     if (retval < 1)
         return retval;
 
-    if (retval < 1)
-        return retval;
-
     return total;
 }
 

MANIFEST

@@ -55,7 +55,7 @@ lib/Devel/NYTProf/js/jit/gradient50.png
 lib/Devel/NYTProf/js/jit/jit-yc.js
 lib/Devel/NYTProf/js/jit/jit.js
 lib/Devel/NYTProf/js/jquery-min.js
-lib/Devel/NYTProf/js/jquery-tablesorter-min.js
+lib/Devel/NYTProf/js/jquery.tablesorter.min.js
 lib/Devel/NYTProf/js/style-tablesorter.css
 ppport.h
 slowops.h

Makefile.PL

@@ -15,6 +15,7 @@ use strict;
 use ExtUtils::MakeMaker;
 use Getopt::Long;
 use Config;
+use File::Spec;
 
 my $is_developer = (-d '.git');
 
@@ -51,10 +52,16 @@ if (not defined $opt_assert) {
     $opt_assert = 1 if $ENV{AUTOMATED_TESTING}; # enable assert()s for cpan-testers
 }
 
-# --- make sure t/test40pmc.pmc is newer than t/test40pmc.pmc
+# The -m32 cross-compiler traditionally gets this wrong
+if ($ENV{PERL_CORE} and ($Config{ccflags} =~ /-m32/ or $Config{cc} =~ / -m32/)) {
+  $opt_zlib = 0;
+}
 
-utime time(), time(), "t/test40pmc.pmc"
+# --- make sure t/test40pmc.pmc is newer than t/test40pmc.pmc (??)
+if (-f "t/test40pmc.pmc") {
+  utime time(), time(), "t/test40pmc.pmc"
     or die "Can't update mod time of t/test40pmc.pmc";
+}
 
 
 # --- Discover how much of stdio is implemented
@@ -139,7 +146,8 @@ if( $ExtUtils::MakeMaker::VERSION >= 6.45 ) {
 if (my $gccversion = $Config{gccversion}) {    # ask gcc to be more pedantic
     print "Your perl was compiled with gcc (version $Config{gccversion}), okay.\n";
     $gccversion =~ s/[^\d\.]//g;               # just a number please
-    $mm_opts{DEFINE} .= ' -W -Wall -Wpointer-arith -Wbad-function-cast';
+    $mm_opts{DEFINE} .= ' -W -Wall -Wpointer-arith';
+    $mm_opts{DEFINE} .= ' -Wbad-function-cast' unless $Config{d_cplusplus};
     $mm_opts{DEFINE} .= ' -Wno-comment -Wno-sign-compare -Wno-cast-qual';
     $mm_opts{DEFINE} .= ' -Wmissing-noreturn -Wno-unused-parameter' if $gccversion ge "3.0";
     if ($is_developer && $opt_g) {
@@ -163,8 +171,12 @@ WriteMakefile(
         'Test::Differences' => '0.60',
         'XSLoader'     => 0,
         'Getopt::Long' => 0,
-        'JSON::MaybeXS' => 0,
+        ($ENV{PERL_CORE} && $Config{usecperl}
+         ? ('Cpanel::JSON::XS' => 0)
+         : ('JSON::MaybeXS' => 0)),
     },
+    INST_LIB  => ($ENV{PERL_CORE} ? File::Spec->catfile(qw(.. .. lib)) : 'blib/lib'),
+    INST_ARCHLIB => ($ENV{PERL_CORE} ? File::Spec->catfile(qw(.. .. lib)) : 'blib/arch'),
     LIBS      => [join ' ', @libs],
     OBJECT    => q/$(O_FILES)/,
     FUNCLIST => ['boot_Devel__NYTProf', 'boot_Devel__NYTProf__FileHandle'],
@@ -192,7 +204,7 @@ WriteMakefile(
     %mm_opts,
 );
 
-exit 0;
+# exit 0;
 
 # --- Utility functions ---
 
@@ -217,8 +229,10 @@ sub find_h_files {
 sub search_h_file {
     my ($h_file, $regex) = @_;
     my $dir = $h_files->{$h_file}
-        or return undef;
-    open H, "$cpp $dir/$h_file |";
+              or return undef;
+    # darwin is very noisy preprocessing mach_time.h
+    my $devnull = $^O eq 'MSWin32' ? "2>NUL" : "2>/dev/null";
+    open H, "$cpp $dir/$h_file $devnull |";
     while (<H>) {
         return $1 if m/$regex/;
     }
@@ -279,9 +293,10 @@ ctidy_bcpp:
 
 sub dynamic {
     my $make = shift->SUPER::dynamic(@_);
+    return $make if $Config::Config{usecperl}; # cperl has no broken XSLoader
 
-    my $xsl_dest_dir = '$(INST_LIB)/$(PARENT_NAME)/auto/$(FULLEXT)';
-    my $xsl_dest     = '$(XSL_DEST_DIR)/$(DLBASE).$(DLEXT)';
+    my $xsl_dest_dir = File::Spec->catdir('$(INST_LIB)','auto','$(FULLEXT)'.'$(PARENT_NAME)');
+    my $xsl_dest     = File::Spec->catdir('$(XSL_DEST_DIR)','$(DLBASE).$(DLEXT)');
 
     if($^O eq 'VMS'){
         $xsl_dest_dir = File::Spec->catdir('blib','lib','Devel','auto','Devel','NYTProf');

MemoryProfiling.pod

@@ -1,3 +1,7 @@
+=head1 NAME
+
+MemoryProfiling
+
 =head1 Ideas and Plans for Memory Profiling with NYTProf
 
 XXX I<This mostly a dumping ground for thoughts, and links at the moment>.
@@ -38,57 +42,93 @@ subroutine profilers.
 =head1 Email threads
 
 "Memory profiling in Devel::NYTProf?: - June 2009
-http://groups.google.com/group/develnytprof-dev/browse_frm/thread/1df4cba3001cd4e4/136812b44e9f7631
+L<http://groups.google.com/group/develnytprof-dev/browse_frm/thread/1df4cba3001cd4e4/136812b44e9f7631>
 Talking about the problems of measuring memory usage of the whole process re:
-http://blog.robin.smidsrod.no/index.php/2009/05/26/memory-footprint-of-popular-cpan-modules
+L<http://blog.robin.smidsrod.no/index.php/2009/05/26/memory-footprint-of-popular-cpan-modules>
 
 "Memory profiling possibilities in NYTProf" - September 2009
-http://groups.google.com/group/develnytprof-dev/browse_frm/thread/c711c132216a3cea/035012e3dc2971ec
+L<http://groups.google.com/group/develnytprof-dev/browse_frm/thread/c711c132216a3cea/035012e3dc2971ec>
 This includes a detailed overview of the issues.
 
 "profiling memory" - Dec 2009
-http://groups.google.com/group/develnytprof-dev/browse_frm/thread/5ffd24200866b0c1/201b58c18d826aaa
+L<http://groups.google.com/group/develnytprof-dev/browse_frm/thread/5ffd24200866b0c1/201b58c18d826aaa>
 Nicholas Clark offers an experimental patch that intercepts malloc and free
 and makes NYTProf measure memory usage.
 
 =head1 Possibly Relevant Perl Modules
 
 Per-process memory information:
 
-    http://metacpan.org/pod/Devel::Mallinfo
+=over
+
+=item L<http://metacpan.org/pod/Devel::Mallinfo>
+
+=back
 
 Arena, stash, and pad based memory reporters:
 
-    http://metacpan.org/pod/Devel::Gladiator
-    http://metacpan.org/release/Internals-DumpArenas/
-    http://metacpan.org/release/Internals-GraphArenas/
-    http://metacpan.org/pod/Devel::DumpSizes
-    http://metacpan.org/pod/Devel::Arena
+=over
+
+=item L<http://metacpan.org/pod/Devel::Gladiator>
+
+=item L<http://metacpan.org/release/Internals-DumpArenas/>
+
+=item L<http://metacpan.org/release/Internals-GraphArenas/>
+
+=item L<http://metacpan.org/pod/Devel::DumpSizes>
+
+=item L<http://metacpan.org/pod/Devel::Arena>
+
+=back
 
 Per-object memory size reporters:
 
-    http://metacpan.org/pod/Devel::Size
-    http://metacpan.org/pod/Devel::Size::Report
+=over
+
+=item L<http://metacpan.org/pod/Devel::Size>
+
+=item L<http://metacpan.org/pod/Devel::Size::Report>
+
+=back
 
 Others:
 
-    http://metacpan.org/release/Devel-Memalyzer/
-    http://metacpan.org/pod/Devel::Memalyzer::Plugin::ProcSmaps
+=over
+
+=item L<http://metacpan.org/release/Devel-Memalyzer/>
+
+=item L<http://metacpan.org/pod/Devel::Memalyzer::Plugin::ProcSmaps>
+
+=item L<http://metacpan.org/release/B-Stats/>
+
+=item L<http://metacpan.org/release/B-C/>
+
+=back
 
 =head1 Other Items of Interest
 
 "Memory Efficient Perl" slides by jjore
 
-    http://docs.google.com/present/view?id=dg7kgpct_24cjs3c9fv
-    http://diotalevi.isa-geek.net/~josh/090402/frontend.png
+=over
+
+=item L<http://docs.google.com/present/view?id=dg7kgpct_24cjs3c9fv>
+
+=item L<http://diotalevi.isa-geek.net/~josh/090402/frontend.png>
+
+=back
 
 Other profile/memory visualization tools
 
-    http://netjam.org/spoon/viz/
-    http://java.dzone.com/announcements/visualvm-12-great-java
+=over
+
+=item L<http://netjam.org/spoon/viz/>
+
+=item L<http://java.dzone.com/announcements/visualvm-12-great-java>
+
+=back
 
-http://blogs.perl.org/users/alex_balhatchet/2012/01/debugging-memory-use-in-perl---help.html
+L<http://blogs.perl.org/users/alex_balhatchet/2012/01/debugging-memory-use-in-perl---help.html>
 
-http://stackoverflow.com/questions/8715611/can-i-use-dtrace-on-os-x-10-5-to-determine-which-of-my-perl-subs-is-causing-the
+L<http://stackoverflow.com/questions/8715611/can-i-use-dtrace-on-os-x-10-5-to-determine-which-of-my-perl-subs-is-causing-the>
 
 =cut

NYTProf.h

@@ -10,7 +10,14 @@
  * Adam Kaplan, akaplan at nytimes.com
  * Tim Bunce, http://www.tim.bunce.name and http://blog.timbunce.org
  * Steve Peters, steve at fisharerojo.org
+ * Forked version by Reini Urban for cperl core
  *
  * ************************************************************************
  */
 
+/* cperl optims */
+#ifndef strEQc
+#define strEQc(s,c) memEQ(s, ("" c ""), sizeof(c))
+#define strNEc(s,c) memNE(s, ("" c ""), sizeof(c))
+#define memNEc(s,c) memNE(s, ("" c ""), sizeof(c)-1)
+#endif