Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Improve Carp backtrace performance #16195

Closed
p5pRT opened this issue Oct 12, 2017 · 28 comments
Closed

Improve Carp backtrace performance #16195

p5pRT opened this issue Oct 12, 2017 · 28 comments

Comments

@p5pRT
Copy link

p5pRT commented Oct 12, 2017

Migrated from rt.perl.org#132274 (status was 'resolved')

Searchable as RT132274$

@p5pRT
Copy link
Author

p5pRT commented Oct 12, 2017

From @bdraco

Created by @bdraco

Please see attached patch

Perl Info

Flags:
    category=library
    severity=low
    module=Carp

Site configuration information for perl 5.26.0:

Configured by cPanel at Fri Sep 22 11:09:22 CDT 2017.

Summary of my perl5 (revision 5 version 26 subversion 0) configuration:
   
  Platform:
    osname=linux
    osvers=3.10.0-123.20.1.el7.x86_64
    archname=x86_64-linux-64int
    uname='linux rpmbuild-64-centos-7.dev.cpanel.net 3.10.0-123.20.1.el7.x86_64 #1 smp thu jan 29 18:05:33 utc 2015 x86_64 x86_64 x86_64 gnulinux '
    config_args='-des -Dusedevel -Darchname=x86_64-linux-64int -Dcc=/usr/bin/gcc -Dcpp=/usr/bin/cpp -Dusemymalloc=n -DDEBUGGING=none -Doptimize=-Os -Accflags=-m64 -Dccflags=-DPERL_DISABLE_PMC -fPIC -DPIC -I/usr/local/cpanel/3rdparty/perl/526/include -I/usr/local/cpanel/3rdparty/include -L/usr/local/cpanel/3rdparty/lib64 -Duseshrplib -Duselargefiles=yes -Duseposix=true -Dhint=recommended -Duseperlio=yes -Dcppflags=-I/usr/local/cpanel/3rdparty/perl/526/include -I/usr/local/cpanel/3rdparty/include -L/usr/local/cpanel/3rdparty/lib64 -Dldflags=-L/usr/local/cpanel/3rdparty/lib64 -Dprefix=/usr/local/cpanel/3rdparty/perl/526 -Dsiteprefix=/opt/cpanel/perl5/526 -Dsitebin=/opt/cpanel/perl5/526/bin -Dsitelib=/opt/cpanel/perl5/526/site_lib -Dusevendorprefix=true -Dvendorbin=/usr/local/cpanel/3rdparty/perl/526/bin -Dvendorprefix=/usr/local/cpanel/3rdparty/perl/526/lib64/perl5
-Dvendorlib=/usr/local/cpanel/3rdparty/perl/526/lib64/perl5/cpanel_lib -Dprivlib=/usr/local/cpanel/3rdparty/perl/526/lib64/perl5/5.26.0 -Dman1dir=none -Dman3dir=none -Dscriptdir=/usr/local/cpanel/3rdparty/perl/526/bin -Dscriptdirexp=/usr/local/cpanel/3rdparty/perl/526/bin -Dsiteman1dir=none -Dsiteman3dir=none -Dinstallman1dir=none -Dversiononly=no -Dinstallusrbinperl=no -Dcf_by=cPanel -Dmyhostname=localhost -Dperladmin=root@localhost -Dcf_email=support@cpanel.net -Di_dbm=/usr/local/cpanel/3rdparty/include -Di_gdbm=/usr/local/cpanel/3rdparty/include -Di_ndbm=/usr/local/cpanel/3rdparty/include -DDB_File=true -Ud_dosuid -Uuserelocatableinc -Umad -Uusethreads -Uusemultiplicity -Uusesocks -Uuselongdouble -Aldflags=-L/usr/local/cpanel/3rdparty/lib64 -L/usr/lib64 -L/lib64 -lgdbm -Dlocincpth=/usr/local/cpanel/3rdparty/perl/526/include /usr/local/cpanel/3rdparty/include /usr/local/include 
-Duse64bitint -Uuse64bitall -Dlibpth=/usr/local/cpanel/3rdparty/lib64 /usr/local/lib64 /usr/local/lib /lib64 /usr/lib64 '
    hint=recommended
    useposix=true
    d_sigaction=define
    useithreads=undef
    usemultiplicity=undef
    use64bitint=define
    use64bitall=undef
    uselongdouble=undef
    usemymalloc=n
    default_inc_excludes_dot=define
    bincompat5005=undef
  Compiler:
    cc='/usr/bin/gcc'
    ccflags ='-DPERL_DISABLE_PMC -fPIC -DPIC -I/usr/local/cpanel/3rdparty/perl/526/include -I/usr/local/cpanel/3rdparty/include -L/usr/local/cpanel/3rdparty/lib64 -m64 -fwrapv -fno-strict-aliasing -pipe -fstack-protector-strong -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64 -D_FORTIFY_SOURCE=2'
    optimize='-Os'
    cppflags='-I/usr/local/cpanel/3rdparty/perl/526/include -I/usr/local/cpanel/3rdparty/include -L/usr/local/cpanel/3rdparty/lib64 -DPERL_DISABLE_PMC -fPIC -DPIC -I/usr/local/cpanel/3rdparty/perl/526/include -I/usr/local/cpanel/3rdparty/include -L/usr/local/cpanel/3rdparty/lib64 -m64 -fwrapv -fno-strict-aliasing -pipe -fstack-protector-strong -I/usr/local/include'
    ccversion=''
    gccversion='4.8.2 20140120 (Red Hat 4.8.2-16)'
    gccosandvers=''
    intsize=4
    longsize=8
    ptrsize=8
    doublesize=8
    byteorder=12345678
    doublekind=3
    d_longlong=define
    longlongsize=8
    d_longdbl=define
    longdblsize=16
    longdblkind=3
    ivtype='long'
    ivsize=8
    nvtype='double'
    nvsize=8
    Off_t='off_t'
    lseeksize=8
    alignbytes=8
    prototype=define
  Linker and Libraries:
    ld='/usr/bin/gcc'
    ldflags ='-L/usr/local/cpanel/3rdparty/lib64 -L/usr/local/cpanel/3rdparty/lib64 -L/usr/lib64 -L/lib64 -lgdbm -fstack-protector-strong -L/usr/local/lib'
    libpth=/usr/local/cpanel/3rdparty/lib64 /usr/local/lib64 /usr/local/lib /lib64 /usr/lib64 /usr/local/lib /usr/lib /lib/../lib64 /usr/lib/../lib64 /lib
    libs=-lpthread -lnsl -lgdbm -ldb -ldl -lm -lcrypt -lutil -lc -lgdbm_compat
    perllibs=-lpthread -lnsl -ldl -lm -lcrypt -lutil -lc
    libc=libc-2.17.so
    so=so
    useshrplib=true
    libperl=libperl.so
    gnulibc_version='2.17'
  Dynamic Linking:
    dlsrc=dl_dlopen.xs
    dlext=so
    d_dlsymun=undef
    ccdlflags='-Wl,-E -Wl,-rpath,/usr/local/cpanel/3rdparty/perl/526/lib64/perl5/5.26.0/x86_64-linux-64int/CORE'
    cccdlflags='-fPIC'
    lddlflags='-shared -Os -L/usr/local/cpanel/3rdparty/lib64 -L/usr/lib64 -L/lib64 -L/usr/local/lib -fstack-protector-strong'

Locally applied patches:
    cPanel patches
    cPanel INC path changes
    cPanel performance improvements to modules
    cPanel Immortal COW
    cPanel B and O performance fixups
    cPanel B::C Declare Static Memory malloc patches
    cPanel Disable XS handshake


@INC for perl 5.26.0:
    /usr/local/cpanel
    /usr/local/cpanel/3rdparty/perl/526/lib64/perl5/cpanel_lib/x86_64-linux-64int
    /usr/local/cpanel/3rdparty/perl/526/lib64/perl5/cpanel_lib
    /usr/local/cpanel/3rdparty/perl/526/lib64/perl5/5.26.0/x86_64-linux-64int
    /usr/local/cpanel/3rdparty/perl/526/lib64/perl5/5.26.0
    /opt/cpanel/perl5/526/site_lib/x86_64-linux-64int
    /opt/cpanel/perl5/526/site_lib


Environment for perl 5.26.0:
    HOME=/root
    LANG=en_US.UTF-8
    LANGUAGE (unset)
    LD_LIBRARY_PATH (unset)
    LOGDIR (unset)
    PATH=/root/bin:/usr/local/cpanel/bin:/usr/local/cpanel/3rdparty/bin:/usr/local/cpanel/3rdparty/perl/526/bin:/usr/local/cpanel/3rdparty/perl/524/bin:/usr/local/cpanel/3rdparty/perl/522/bin:/usr/local/cpanel/3rdparty/perl/514/bin:/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/opt/cpanel/composer/bin
    PERL_BADLANG (unset)
    SHELL=/bin/bash

@p5pRT
Copy link
Author

p5pRT commented Oct 12, 2017

From @bdraco

The patch is attached.

@p5pRT
Copy link
Author

p5pRT commented Oct 12, 2017

From @bdraco

0001-Optimize-format_arg-_cgc-and-utf-8-downgrade-calls-i.patch
From a40b93e033fbfcab7fb97a722c2909da5a139db5 Mon Sep 17 00:00:00 2001
From: "J. Nick Koston" <nick@cpanel.net>
Date: Thu, 12 Oct 2017 01:57:36 -0500
Subject: [PATCH] Optimize format_arg,_cgc, and utf-8 downgrade calls in
 Carp.pm

---
 dist/Carp/Changes           | 14 ++++++++++++++
 dist/Carp/lib/Carp.pm       | 21 +++++++++++----------
 dist/Carp/lib/Carp/Heavy.pm |  2 +-
 3 files changed, 26 insertions(+), 11 deletions(-)

diff --git a/dist/Carp/Changes b/dist/Carp/Changes
index 0498eeb885..3ebf87fd81 100644
--- a/dist/Carp/Changes
+++ b/dist/Carp/Changes
@@ -1,3 +1,17 @@
+version 1.44
+
+  * Optimize format_arg when arguments contain many references
+
+     The format_arg call now avoids the expensive logic for
+     checking each argument if the argument will not have
+     CARP_TRACE such as a simple hashref or arrayref.
+     In testing this decreased the Carp backtrace time by about
+     35% in production code.
+
+  * Reduce overhead of checking for caller() being overridden
+
+  * Avoid a utf-8 downgrade when there are only printable ASCII characters
+
 version 1.43
 
   * fix problems introduced by the partial EBCDIC support from version
diff --git a/dist/Carp/lib/Carp.pm b/dist/Carp/lib/Carp.pm
index 6127b26f54..4109998a6a 100644
--- a/dist/Carp/lib/Carp.pm
+++ b/dist/Carp/lib/Carp.pm
@@ -116,7 +116,7 @@ BEGIN {
 	;
 }
 
-our $VERSION = '1.43';
+our $VERSION = '1.44';
 $VERSION =~ tr/_//d;
 
 our $MaxEvalLen = 0;
@@ -159,8 +159,7 @@ sub export_fail { shift; $Verbose = shift if $_[0] eq 'verbose'; @_ }
 
 sub _cgc {
     no strict 'refs';
-    return \&{"CORE::GLOBAL::caller"} if defined &{"CORE::GLOBAL::caller"};
-    return;
+    return defined &{"CORE::GLOBAL::caller"} ? \&{"CORE::GLOBAL::caller"} : undef;
 }
 
 sub longmess {
@@ -280,11 +279,11 @@ sub caller_info {
 # Transform an argument to a function into a string.
 our $in_recurse;
 sub format_arg {
-    my $arg = shift;
+    my ($arg) = @_;
 
     if ( ref($arg) ) {
          # legitimate, let's not leak it.
-        if (!$in_recurse &&
+        if (!$in_recurse && UNIVERSAL::isa( $arg, 'UNIVERSAL' ) &&
 	    do {
                 local $@;
 	        local $in_recurse = 1;
@@ -332,12 +331,14 @@ sub format_arg {
 	    substr $arg, $i, 1, sprintf("\\x{%x}", $o)
 		unless is_safe_printable_codepoint($o);
 	}
-    } else {
+	downgrade($arg, 1);
+    } elsif ($arg =~ tr{"\\@$}{} || $arg =~ tr/ !"\$\%#'()*+,\-.\/0123456789:;<=>?\@ABCDEFGHIJKLMNOPQRSTUVWXYZ\[\\\]^_`abcdefghijklmnopqrstuvwxyz\{|}~//c) {
 	$arg =~ s/([\"\\\$\@])/\\$1/g;
         # This is all the ASCII printables spelled-out.  It is portable to all
         # Perl versions and platforms (such as EBCDIC).  There are other more
         # compact ways to do this, but may not work everywhere every version.
         $arg =~ s/([^ !"#\$\%\&'()*+,\-.\/0123456789:;<=>?\@ABCDEFGHIJKLMNOPQRSTUVWXYZ\[\\\]^_`abcdefghijklmnopqrstuvwxyz\{|}~])/sprintf("\\x{%x}",ord($1))/eg;
+        downgrade($arg, 1);
     }
     downgrade($arg, 1);
     return "\"".$arg."\"".$suffix;
@@ -383,7 +384,7 @@ sub get_status {
 # Takes the info from caller() and figures out the name of
 # the sub/require/eval
 sub get_subname {
-    my $info = shift;
+    my ($info) = @_;
     if ( defined( $info->{evaltext} ) ) {
         my $eval = $info->{evaltext};
         if ( $info->{is_require} ) {
@@ -397,7 +398,7 @@ sub get_subname {
 
     # this can happen on older perls when the sub (or the stash containing it)
     # has been deleted
-    if ( !defined( $info->{sub} ) ) {
+    elsif ( !defined( $info->{sub} ) ) {
         return '__ANON__::__ANON__';
     }
 
@@ -409,9 +410,9 @@ sub get_subname {
 sub long_error_loc {
     my $i;
     my $lvl = $CarpLevel;
+    my $cgc = _cgc();
     {
         ++$i;
-        my $cgc = _cgc();
         my @caller = $cgc ? $cgc->($i) : caller($i);
         my $pkg = $caller[0];
         unless ( defined($pkg) ) {
@@ -508,8 +509,8 @@ sub short_error_loc {
     my $cache = {};
     my $i     = 1;
     my $lvl   = $CarpLevel;
+    my $cgc = _cgc();
     {
-        my $cgc = _cgc();
         my $called = $cgc ? $cgc->($i) : caller($i);
         $i++;
         my $caller = $cgc ? $cgc->($i) : caller($i);
diff --git a/dist/Carp/lib/Carp/Heavy.pm b/dist/Carp/lib/Carp/Heavy.pm
index 4b8cbe1b94..84b1106545 100644
--- a/dist/Carp/lib/Carp/Heavy.pm
+++ b/dist/Carp/lib/Carp/Heavy.pm
@@ -2,7 +2,7 @@ package Carp::Heavy;
 
 use Carp ();
 
-our $VERSION = '1.43';
+our $VERSION = '1.44';
 $VERSION =~ tr/_//d;
 
 # Carp::Heavy was merged into Carp in version 1.12.  Any mismatched versions
-- 
2.14.2

@p5pRT
Copy link
Author

p5pRT commented Oct 12, 2017

From @jkeenan

On Thu, 12 Oct 2017 07​:36​:50 GMT, bdraco wrote​:

This is a bug report for perl from nick@​cpanel.net,
generated with the help of perlbug 1.40 running under perl 5.26.0.

-----------------------------------------------------------------
[Please describe your issue here]

Please see attached patch

I have made this patch available for smoke-testing in the following branch​:

smoke-me/jkeenan/132274-carp-backtrace

Would it be possible to add some description of the motivation for this patch to this RT?

Thank you very much.

--
James E Keenan (jkeenan@​cpan.org)

@p5pRT
Copy link
Author

p5pRT commented Oct 12, 2017

The RT System itself - Status changed from 'new' to 'open'

@p5pRT
Copy link
Author

p5pRT commented Oct 12, 2017

From @bdraco

Hi James,

In our production code we log failures with a backtrace. We use this patch to reduce the overhead of doing so because the amount of time it was taking to the format_arg call was having noticeable impact on production machines.

On Thu, 12 Oct 2017 05​:53​:23 -0700, jkeenan wrote​:

On Thu, 12 Oct 2017 07​:36​:50 GMT, bdraco wrote​:

This is a bug report for perl from nick@​cpanel.net,
generated with the help of perlbug 1.40 running under perl 5.26.0.

-----------------------------------------------------------------
[Please describe your issue here]

Please see attached patch

I have made this patch available for smoke-testing in the following
branch​:

smoke-me/jkeenan/132274-carp-backtrace

Would it be possible to add some description of the motivation for
this patch to this RT?

Thank you very much.

@p5pRT
Copy link
Author

p5pRT commented Oct 12, 2017

From zefram@fysh.org

J. Nick Koston via RT wrote​:

+ } elsif ($arg =~ tr{"\\@​$}{} || $arg =~ tr/ !"\$\%#'()*+,\-.\/0123456789​:;<=>?\@​ABCDEFGHIJKLMNOPQRSTUVWXYZ\[\\\]^_`abcdefghijklmnopqrstuvwxyz\{|}~//c) {

I'm dubious about this change.

There's a trivial bug here in that this repetition of the ASCII printable
set doesn't include "&"​: it seems to be copied from a buggy version of
the substitution that appeared in an older version of Carp. It also
seems strange to use two tr ops here when they could be combined into
one for the same logical effect.

Even if done correctly, I question the value of this extra conditional
test before the substitution operation. Does it actually save time?
It definitely carries a maintenance cost, as illustrated by the fact
that it manages to have a bug (described above) that the substitution
doesn't have.

But even stranger is the additional downgrade operations, quite
contrary to the Changes entry which says this is reducing the amount
of downgrading. That's probably not intended. If a patch were supplied
that actually reduced the number of downgrade operations then I'd have
some opinion about that, quite likely that it's not worth the trouble
to remove redundant downgrading (which is cheap).

Overall, it looks like this patch was formulated against an older
version of Carp and then textually merged into the current version
without checking that it still made sense.

Generally I question the value of making this code more complicated in
order to get small performance gains. It's not a performance-critical
function.

- my $info = shift;
+ my ($info) = @​_;

The changes of this type (and some others) are just distracting.
They're not worth the churn.

\# this can happen on older perls when the sub \(or the stash containing it\)
\# has been deleted

- if ( !defined( $info->{sub} ) ) {
+ elsif ( !defined( $info->{sub} ) ) {

This change makes no actual difference to execution, because in all
cases the preceding consequent block executes a return and so doesn't
get here. So this is another noise change. Except that by having an
elsif separated from the preceding block by two lines of comments and
a blank line it produces a misleading layout. Don't do that.

-zefram

@p5pRT
Copy link
Author

p5pRT commented Oct 12, 2017

From @bdraco

On Thu, 12 Oct 2017 08​:21​:40 -0700, zefram@​fysh.org wrote​:

J. Nick Koston via RT wrote​:

+ } elsif ($arg =~ tr{"\\@​$}{} || $arg =~ tr/ !"\$\%#'()*+,\-
.\/0123456789​:;<=>?\@​ABCDEFGHIJKLMNOPQRSTUVWXYZ\[\\\]^_`abcdefghijklmnopqrstuvwxyz\{|}~//c)
{

I'm dubious about this change.

There's a trivial bug here in that this repetition of the ASCII
printable
set doesn't include "&"​: it seems to be copied from a buggy version of
the substitution that appeared in an older version of Carp. It also
seems strange to use two tr ops here when they could be combined into
one for the same logical effect.

It may be my ignorance here, but I don't know how to combine them when one has a 'c' on the end

Even if done correctly, I question the value of this extra conditional
test before the substitution operation. Does it actually save time?
It definitely carries a maintenance cost, as illustrated by the fact
that it manages to have a bug (described above) that the substitution
doesn't have.

It will save time and avoid the downgrade if I merged the patch correctly. I've attached the fixed on to this.

But even stranger is the additional downgrade operations, quite
contrary to the Changes entry which says this is reducing the amount
of downgrading. That's probably not intended. If a patch were
supplied
that actually reduced the number of downgrade operations then I'd have
some opinion about that, quite likely that it's not worth the trouble
to remove redundant downgrading (which is cheap).

Overall, it looks like this patch was formulated against an older
version of Carp and then textually merged into the current version
without checking that it still made sense.

Fixed the forward merge conflict in the attached patched.

Generally I question the value of making this code more complicated in
order to get small performance gains. It's not a performance-critical
function.

- my $info = shift;
+ my ($info) = @​_;

The changes of this type (and some others) are just distracting.
They're not worth the churn.

# this can happen on older perls when the sub (or the stash
containing it)
# has been deleted
- if ( !defined( $info->{sub} ) ) {
+ elsif ( !defined( $info->{sub} ) ) {

This change makes no actual difference to execution, because in all
cases the preceding consequent block executes a return and so doesn't
get here. So this is another noise change. Except that by having an
elsif separated from the preceding block by two lines of comments and
a blank line it produces a misleading layout. Don't do that.

-zefram

@p5pRT
Copy link
Author

p5pRT commented Oct 12, 2017

From @bdraco

0001-Optimize-format_arg-_cgc-and-utf-8-downgrade-calls-i.patch
From 4d98ed451064ea7564516046f04b936bc49f423f Mon Sep 17 00:00:00 2001
From: "J. Nick Koston" <nick@cpanel.net>
Date: Thu, 12 Oct 2017 01:57:36 -0500
Subject: [PATCH] Optimize format_arg,_cgc, and utf-8 downgrade calls in
 Carp.pm

---
 dist/Carp/Changes           | 14 ++++++++++++++
 dist/Carp/lib/Carp.pm       | 22 +++++++++++-----------
 dist/Carp/lib/Carp/Heavy.pm |  2 +-
 3 files changed, 26 insertions(+), 12 deletions(-)

diff --git a/dist/Carp/Changes b/dist/Carp/Changes
index 0498eeb885..3ebf87fd81 100644
--- a/dist/Carp/Changes
+++ b/dist/Carp/Changes
@@ -1,3 +1,17 @@
+version 1.44
+
+  * Optimize format_arg when arguments contain many references
+
+     The format_arg call now avoids the expensive logic for
+     checking each argument if the argument will not have
+     CARP_TRACE such as a simple hashref or arrayref.
+     In testing this decreased the Carp backtrace time by about
+     35% in production code.
+
+  * Reduce overhead of checking for caller() being overridden
+
+  * Avoid a utf-8 downgrade when there are only printable ASCII characters
+
 version 1.43
 
   * fix problems introduced by the partial EBCDIC support from version
diff --git a/dist/Carp/lib/Carp.pm b/dist/Carp/lib/Carp.pm
index 6127b26f54..bfd4e3d88f 100644
--- a/dist/Carp/lib/Carp.pm
+++ b/dist/Carp/lib/Carp.pm
@@ -116,7 +116,7 @@ BEGIN {
 	;
 }
 
-our $VERSION = '1.43';
+our $VERSION = '1.44';
 $VERSION =~ tr/_//d;
 
 our $MaxEvalLen = 0;
@@ -159,8 +159,7 @@ sub export_fail { shift; $Verbose = shift if $_[0] eq 'verbose'; @_ }
 
 sub _cgc {
     no strict 'refs';
-    return \&{"CORE::GLOBAL::caller"} if defined &{"CORE::GLOBAL::caller"};
-    return;
+    return defined &{"CORE::GLOBAL::caller"} ? \&{"CORE::GLOBAL::caller"} : undef;
 }
 
 sub longmess {
@@ -280,11 +279,11 @@ sub caller_info {
 # Transform an argument to a function into a string.
 our $in_recurse;
 sub format_arg {
-    my $arg = shift;
+    my ($arg) = @_;
 
     if ( ref($arg) ) {
          # legitimate, let's not leak it.
-        if (!$in_recurse &&
+        if (!$in_recurse && UNIVERSAL::isa( $arg, 'UNIVERSAL' ) &&
 	    do {
                 local $@;
 	        local $in_recurse = 1;
@@ -332,14 +331,15 @@ sub format_arg {
 	    substr $arg, $i, 1, sprintf("\\x{%x}", $o)
 		unless is_safe_printable_codepoint($o);
 	}
-    } else {
+	downgrade($arg, 1);
+    } elsif ($arg =~ tr{"\\@$}{} || $arg =~ tr/ !"#\$\%\&'()*+,\-.\/0123456789:;<=>?\@ABCDEFGHIJKLMNOPQRSTUVWXYZ\[\\\]^_`abcdefghijklmnopqrstuvwxyz\{|}~//c) {
 	$arg =~ s/([\"\\\$\@])/\\$1/g;
         # This is all the ASCII printables spelled-out.  It is portable to all
         # Perl versions and platforms (such as EBCDIC).  There are other more
         # compact ways to do this, but may not work everywhere every version.
         $arg =~ s/([^ !"#\$\%\&'()*+,\-.\/0123456789:;<=>?\@ABCDEFGHIJKLMNOPQRSTUVWXYZ\[\\\]^_`abcdefghijklmnopqrstuvwxyz\{|}~])/sprintf("\\x{%x}",ord($1))/eg;
+        downgrade($arg, 1);
     }
-    downgrade($arg, 1);
     return "\"".$arg."\"".$suffix;
 }
 
@@ -383,7 +383,7 @@ sub get_status {
 # Takes the info from caller() and figures out the name of
 # the sub/require/eval
 sub get_subname {
-    my $info = shift;
+    my ($info) = @_;
     if ( defined( $info->{evaltext} ) ) {
         my $eval = $info->{evaltext};
         if ( $info->{is_require} ) {
@@ -397,7 +397,7 @@ sub get_subname {
 
     # this can happen on older perls when the sub (or the stash containing it)
     # has been deleted
-    if ( !defined( $info->{sub} ) ) {
+    elsif ( !defined( $info->{sub} ) ) {
         return '__ANON__::__ANON__';
     }
 
@@ -409,9 +409,9 @@ sub get_subname {
 sub long_error_loc {
     my $i;
     my $lvl = $CarpLevel;
+    my $cgc = _cgc();
     {
         ++$i;
-        my $cgc = _cgc();
         my @caller = $cgc ? $cgc->($i) : caller($i);
         my $pkg = $caller[0];
         unless ( defined($pkg) ) {
@@ -508,8 +508,8 @@ sub short_error_loc {
     my $cache = {};
     my $i     = 1;
     my $lvl   = $CarpLevel;
+    my $cgc = _cgc();
     {
-        my $cgc = _cgc();
         my $called = $cgc ? $cgc->($i) : caller($i);
         $i++;
         my $caller = $cgc ? $cgc->($i) : caller($i);
diff --git a/dist/Carp/lib/Carp/Heavy.pm b/dist/Carp/lib/Carp/Heavy.pm
index 4b8cbe1b94..84b1106545 100644
--- a/dist/Carp/lib/Carp/Heavy.pm
+++ b/dist/Carp/lib/Carp/Heavy.pm
@@ -2,7 +2,7 @@ package Carp::Heavy;
 
 use Carp ();
 
-our $VERSION = '1.43';
+our $VERSION = '1.44';
 $VERSION =~ tr/_//d;
 
 # Carp::Heavy was merged into Carp in version 1.12.  Any mismatched versions
-- 
2.14.2

@p5pRT
Copy link
Author

p5pRT commented Oct 12, 2017

From zefram@fysh.org

J. Nick Koston via RT wrote​:

It may be my ignorance here, but I don't know how to combine them when
one has a 'c' on the end

It turns into one tr///c, with the character set consisting of those
characters that are in the original tr///c and not in the original tr///.
So "tr/abc// || tr/abcdef//c" becomes "tr/def//c".

It will save time and avoid the downgrade

Downgrade of an already-downgraded string is dirt cheap. Comparing it
against an extra scan of the string, the downgrade has a smaller intrinsic
cost (and its cost doesn't grow with string length), though the fact
that the downgrade operation is accessed through a sub call might make
that more expensive on typical string lengths. Not so much difference
as to be worth making the code more difficult to maintain, though.

The only part of the patch that looks potentially worthwhile is the
UNIVERSAL​::isa() check. That's a low maintenance burden, and should
actually make a proportionally useful speedup to the ->can('CARP_TRACE')
check.

-zefram

@p5pRT
Copy link
Author

p5pRT commented Oct 12, 2017

From @bdraco

On Thu, 12 Oct 2017 09​:43​:48 -0700, zefram@​fysh.org wrote​:

J. Nick Koston via RT wrote​:

It may be my ignorance here, but I don't know how to combine them when
one has a 'c' on the end

It turns into one tr///c, with the character set consisting of those
characters that are in the original tr///c and not in the original tr///.
So "tr/abc// || tr/abcdef//c" becomes "tr/def//c".

It will save time and avoid the downgrade

Downgrade of an already-downgraded string is dirt cheap. Comparing it
against an extra scan of the string, the downgrade has a smaller intrinsic
cost (and its cost doesn't grow with string length), though the fact
that the downgrade operation is accessed through a sub call might make
that more expensive on typical string lengths. Not so much difference
as to be worth making the code more difficult to maintain, though.

The only part of the patch that looks potentially worthwhile is the
UNIVERSAL​::isa() check. That's a low maintenance burden, and should
actually make a proportionally useful speedup to the ->can('CARP_TRACE')
check.

-zefram

I have re-worked the patch and removed the downgrade optimization.

@p5pRT
Copy link
Author

p5pRT commented Oct 12, 2017

From @bdraco

0001-Optimize-format_arg-and-_cgc-calls-in-Carp.pm.patch
From 2b6d84c8f79d520997f2f88d4e3d82c7f28d2f15 Mon Sep 17 00:00:00 2001
From: "J. Nick Koston" <nick@cpanel.net>
Date: Thu, 12 Oct 2017 01:57:36 -0500
Subject: [PATCH] Optimize format_arg and _cgc calls in Carp.pm

---
 dist/Carp/Changes           | 12 ++++++++++++
 dist/Carp/lib/Carp.pm       | 17 ++++++++---------
 dist/Carp/lib/Carp/Heavy.pm |  2 +-
 3 files changed, 21 insertions(+), 10 deletions(-)

diff --git a/dist/Carp/Changes b/dist/Carp/Changes
index 0498eeb885..ad523ddd48 100644
--- a/dist/Carp/Changes
+++ b/dist/Carp/Changes
@@ -1,3 +1,15 @@
+version 1.44
+
+  * Optimize format_arg when arguments contain many references
+
+     The format_arg call now avoids the expensive logic for
+     checking each argument if the argument will not have
+     CARP_TRACE such as a simple hashref or arrayref.
+     In testing this decreased the Carp backtrace time by about
+     35% in production code.
+
+  * Reduce overhead of checking for caller() being overridden
+
 version 1.43
 
   * fix problems introduced by the partial EBCDIC support from version
diff --git a/dist/Carp/lib/Carp.pm b/dist/Carp/lib/Carp.pm
index 6127b26f54..c42a701b8e 100644
--- a/dist/Carp/lib/Carp.pm
+++ b/dist/Carp/lib/Carp.pm
@@ -116,7 +116,7 @@ BEGIN {
 	;
 }
 
-our $VERSION = '1.43';
+our $VERSION = '1.44';
 $VERSION =~ tr/_//d;
 
 our $MaxEvalLen = 0;
@@ -159,8 +159,7 @@ sub export_fail { shift; $Verbose = shift if $_[0] eq 'verbose'; @_ }
 
 sub _cgc {
     no strict 'refs';
-    return \&{"CORE::GLOBAL::caller"} if defined &{"CORE::GLOBAL::caller"};
-    return;
+    return defined &{"CORE::GLOBAL::caller"} ? \&{"CORE::GLOBAL::caller"} : undef;
 }
 
 sub longmess {
@@ -280,11 +279,11 @@ sub caller_info {
 # Transform an argument to a function into a string.
 our $in_recurse;
 sub format_arg {
-    my $arg = shift;
+    my ($arg) = @_;
 
     if ( ref($arg) ) {
          # legitimate, let's not leak it.
-        if (!$in_recurse &&
+        if (!$in_recurse && UNIVERSAL::isa( $arg, 'UNIVERSAL' ) &&
 	    do {
                 local $@;
 	        local $in_recurse = 1;
@@ -383,7 +382,7 @@ sub get_status {
 # Takes the info from caller() and figures out the name of
 # the sub/require/eval
 sub get_subname {
-    my $info = shift;
+    my ($info) = @_;
     if ( defined( $info->{evaltext} ) ) {
         my $eval = $info->{evaltext};
         if ( $info->{is_require} ) {
@@ -397,7 +396,7 @@ sub get_subname {
 
     # this can happen on older perls when the sub (or the stash containing it)
     # has been deleted
-    if ( !defined( $info->{sub} ) ) {
+    elsif ( !defined( $info->{sub} ) ) {
         return '__ANON__::__ANON__';
     }
 
@@ -409,9 +408,9 @@ sub get_subname {
 sub long_error_loc {
     my $i;
     my $lvl = $CarpLevel;
+    my $cgc = _cgc();
     {
         ++$i;
-        my $cgc = _cgc();
         my @caller = $cgc ? $cgc->($i) : caller($i);
         my $pkg = $caller[0];
         unless ( defined($pkg) ) {
@@ -508,8 +507,8 @@ sub short_error_loc {
     my $cache = {};
     my $i     = 1;
     my $lvl   = $CarpLevel;
+    my $cgc = _cgc();
     {
-        my $cgc = _cgc();
         my $called = $cgc ? $cgc->($i) : caller($i);
         $i++;
         my $caller = $cgc ? $cgc->($i) : caller($i);
diff --git a/dist/Carp/lib/Carp/Heavy.pm b/dist/Carp/lib/Carp/Heavy.pm
index 4b8cbe1b94..84b1106545 100644
--- a/dist/Carp/lib/Carp/Heavy.pm
+++ b/dist/Carp/lib/Carp/Heavy.pm
@@ -2,7 +2,7 @@ package Carp::Heavy;
 
 use Carp ();
 
-our $VERSION = '1.43';
+our $VERSION = '1.44';
 $VERSION =~ tr/_//d;
 
 # Carp::Heavy was merged into Carp in version 1.12.  Any mismatched versions
-- 
2.14.2

@p5pRT
Copy link
Author

p5pRT commented Oct 12, 2017

From @Smylers

J. Nick Koston via RT writes​:

I have re-worked the patch and removed the downgrade optimization.

Hi, Nick. Unfortunately your latest patch still has some trivial
coding-style changes in it of the sort that Zefram mentioned as being
distracting.

This one stood out to me​:

  - return \&{"CORE​::GLOBAL​::caller"} if defined &{"CORE​::GLOBAL​::caller"};
  - return;
  + return defined &{"CORE​::GLOBAL​::caller"} ? \&{"CORE​::GLOBAL​::caller"} : undef;

That would change what the function returns in list context​: a list
containing an undef rather than an empty list.

Now it may well be that function could never be called in list context.
But to verify your patch, somebody has to go and check, and convince
themselves that this change wouldn't cause any problems.

It isn't that changes like this make the code worse. It isn't even that
you couldn't make a case for why this style is an improvement.

It's that merely making unnecessary changes like this increases the
cognitive burden on people reviewing your patches, and increases the
chance that a bug slips through.

Smylers

@p5pRT
Copy link
Author

p5pRT commented Oct 13, 2017

From @bdraco

Hi Smylers,

Thank you for the explanation.

I have reduced the noise in the patch and re-attached.

-Nick

On Thu, 12 Oct 2017 14​:59​:44 -0700, smylers@​stripey.com wrote​:

J. Nick Koston via RT writes​:

I have re-worked the patch and removed the downgrade optimization.

Hi, Nick. Unfortunately your latest patch still has some trivial
coding-style changes in it of the sort that Zefram mentioned as being
distracting.

This one stood out to me​:

- return \&{"CORE​::GLOBAL​::caller"} if defined
&{"CORE​::GLOBAL​::caller"};
- return;
+ return defined &{"CORE​::GLOBAL​::caller"} ?
\&{"CORE​::GLOBAL​::caller"} : undef;

That would change what the function returns in list context​: a list
containing an undef rather than an empty list.

Now it may well be that function could never be called in list
context.
But to verify your patch, somebody has to go and check, and convince
themselves that this change wouldn't cause any problems.

It isn't that changes like this make the code worse. It isn't even
that
you couldn't make a case for why this style is an improvement.

It's that merely making unnecessary changes like this increases the
cognitive burden on people reviewing your patches, and increases the
chance that a bug slips through.

Smylers

@p5pRT
Copy link
Author

p5pRT commented Oct 13, 2017

From @bdraco

0001-Optimize-format_arg-and-_cgc-calls-in-Carp.pm.patch
From 0a97074a77bd722316a782f3b55e5a50fa2de060 Mon Sep 17 00:00:00 2001
From: "J. Nick Koston" <nick@cpanel.net>
Date: Thu, 12 Oct 2017 01:57:36 -0500
Subject: [PATCH] Optimize format_arg and _cgc calls in Carp.pm

---
 dist/Carp/Changes           | 12 ++++++++++++
 dist/Carp/lib/Carp.pm       | 10 +++++-----
 dist/Carp/lib/Carp/Heavy.pm |  2 +-
 3 files changed, 18 insertions(+), 6 deletions(-)

diff --git a/dist/Carp/Changes b/dist/Carp/Changes
index 0498eeb885..ad523ddd48 100644
--- a/dist/Carp/Changes
+++ b/dist/Carp/Changes
@@ -1,3 +1,15 @@
+version 1.44
+
+  * Optimize format_arg when arguments contain many references
+
+     The format_arg call now avoids the expensive logic for
+     checking each argument if the argument will not have
+     CARP_TRACE such as a simple hashref or arrayref.
+     In testing this decreased the Carp backtrace time by about
+     35% in production code.
+
+  * Reduce overhead of checking for caller() being overridden
+
 version 1.43
 
   * fix problems introduced by the partial EBCDIC support from version
diff --git a/dist/Carp/lib/Carp.pm b/dist/Carp/lib/Carp.pm
index 6127b26f54..06b9051bec 100644
--- a/dist/Carp/lib/Carp.pm
+++ b/dist/Carp/lib/Carp.pm
@@ -116,7 +116,7 @@ BEGIN {
 	;
 }
 
-our $VERSION = '1.43';
+our $VERSION = '1.44';
 $VERSION =~ tr/_//d;
 
 our $MaxEvalLen = 0;
@@ -280,11 +280,11 @@ sub caller_info {
 # Transform an argument to a function into a string.
 our $in_recurse;
 sub format_arg {
-    my $arg = shift;
+    my ($arg) = @_;
 
     if ( ref($arg) ) {
          # legitimate, let's not leak it.
-        if (!$in_recurse &&
+        if (!$in_recurse && UNIVERSAL::isa( $arg, 'UNIVERSAL' ) &&
 	    do {
                 local $@;
 	        local $in_recurse = 1;
@@ -409,9 +409,9 @@ sub get_subname {
 sub long_error_loc {
     my $i;
     my $lvl = $CarpLevel;
+    my $cgc = _cgc();
     {
         ++$i;
-        my $cgc = _cgc();
         my @caller = $cgc ? $cgc->($i) : caller($i);
         my $pkg = $caller[0];
         unless ( defined($pkg) ) {
@@ -508,8 +508,8 @@ sub short_error_loc {
     my $cache = {};
     my $i     = 1;
     my $lvl   = $CarpLevel;
+    my $cgc = _cgc();
     {
-        my $cgc = _cgc();
         my $called = $cgc ? $cgc->($i) : caller($i);
         $i++;
         my $caller = $cgc ? $cgc->($i) : caller($i);
diff --git a/dist/Carp/lib/Carp/Heavy.pm b/dist/Carp/lib/Carp/Heavy.pm
index 4b8cbe1b94..84b1106545 100644
--- a/dist/Carp/lib/Carp/Heavy.pm
+++ b/dist/Carp/lib/Carp/Heavy.pm
@@ -2,7 +2,7 @@ package Carp::Heavy;
 
 use Carp ();
 
-our $VERSION = '1.43';
+our $VERSION = '1.44';
 $VERSION =~ tr/_//d;
 
 # Carp::Heavy was merged into Carp in version 1.12.  Any mismatched versions
-- 
2.14.2

@p5pRT
Copy link
Author

p5pRT commented Nov 15, 2017

From zefram@fysh.org

J. Nick Koston via RT wrote​:

I have reduced the noise in the patch and re-attached.

This still has a bunch of noise. The *only* parts of the patch that are
OK are the one-line change adding the UNIVERSAL​::isa() call (which is
half of one hunk of that patch) and the $VERSION bumps. An addition to
Changes should also be included, but should refer only to the one change
actually being made, and should be briefer, conforming to the existing
Changes style.

-zefram

@p5pRT
Copy link
Author

p5pRT commented Nov 15, 2017

From @atoomic

I came with a very minimal patch, readable online p5h/perl5demo#31

On Thu, 12 Oct 2017 20​:31​:55 -0700, bdraco wrote​:

Hi Smylers,

Thank you for the explanation.

I have reduced the noise in the patch and re-attached.

-Nick

On Thu, 12 Oct 2017 14​:59​:44 -0700, smylers@​stripey.com wrote​:

J. Nick Koston via RT writes​:

I have re-worked the patch and removed the downgrade optimization.

Hi, Nick. Unfortunately your latest patch still has some trivial
coding-style changes in it of the sort that Zefram mentioned as being
distracting.

This one stood out to me​:

- return \&{"CORE​::GLOBAL​::caller"} if defined
&{"CORE​::GLOBAL​::caller"};
- return;
+ return defined &{"CORE​::GLOBAL​::caller"} ?
\&{"CORE​::GLOBAL​::caller"} : undef;

That would change what the function returns in list context​: a list
containing an undef rather than an empty list.

Now it may well be that function could never be called in list
context.
But to verify your patch, somebody has to go and check, and convince
themselves that this change wouldn't cause any problems.

It isn't that changes like this make the code worse. It isn't even
that
you couldn't make a case for why this style is an improvement.

It's that merely making unnecessary changes like this increases the
cognitive burden on people reviewing your patches, and increases the
chance that a bug slips through.

Smylers

@p5pRT
Copy link
Author

p5pRT commented Nov 15, 2017

From @atoomic

0001-Carp-optimize-format_arg-when-arguments-contain-many.patch
From cf420df5c15793318fbe4811a8a1900e8d4eb874 Mon Sep 17 00:00:00 2001
From: "J. Nick Koston" <nick@cpanel.net>
Date: Thu, 12 Oct 2017 01:57:36 -0500
Subject: [PATCH] Carp: optimize format_arg when arguments contain many
 references

RT #132274

This is a very minimal patch after RT discussion.
---
 dist/Carp/Changes     | 4 ++++
 dist/Carp/lib/Carp.pm | 2 +-
 2 files changed, 5 insertions(+), 1 deletion(-)

diff --git a/dist/Carp/Changes b/dist/Carp/Changes
index 0498eeb885..db187e9443 100644
--- a/dist/Carp/Changes
+++ b/dist/Carp/Changes
@@ -1,3 +1,7 @@
+version 1.44
+
+  * Optimize format_arg when arguments contain many references
+
 version 1.43
 
   * fix problems introduced by the partial EBCDIC support from version
diff --git a/dist/Carp/lib/Carp.pm b/dist/Carp/lib/Carp.pm
index 623558aada..08dc73e439 100644
--- a/dist/Carp/lib/Carp.pm
+++ b/dist/Carp/lib/Carp.pm
@@ -284,7 +284,7 @@ sub format_arg {
 
     if ( ref($arg) ) {
          # legitimate, let's not leak it.
-        if (!$in_recurse &&
+        if (!$in_recurse && UNIVERSAL::isa( $arg, 'UNIVERSAL' ) &&
 	    do {
                 local $@;
 	        local $in_recurse = 1;
-- 
2.13.6 (Apple Git-96)

@p5pRT
Copy link
Author

p5pRT commented Nov 15, 2017

From @atoomic

note version bump is not required as it already occurred since v5.27.5 release

On Wed, 15 Nov 2017 11​:01​:02 -0800, atoomic@​cpan.org wrote​:

I came with a very minimal patch, readable online
p5h/perl5demo#31

On Thu, 12 Oct 2017 20​:31​:55 -0700, bdraco wrote​:

Hi Smylers,

Thank you for the explanation.

I have reduced the noise in the patch and re-attached.

-Nick

On Thu, 12 Oct 2017 14​:59​:44 -0700, smylers@​stripey.com wrote​:

J. Nick Koston via RT writes​:

I have re-worked the patch and removed the downgrade
optimization.

Hi, Nick. Unfortunately your latest patch still has some trivial
coding-style changes in it of the sort that Zefram mentioned as
being
distracting.

This one stood out to me​:

- return \&{"CORE​::GLOBAL​::caller"} if defined
&{"CORE​::GLOBAL​::caller"};
- return;
+ return defined &{"CORE​::GLOBAL​::caller"} ?
\&{"CORE​::GLOBAL​::caller"} : undef;

That would change what the function returns in list context​: a list
containing an undef rather than an empty list.

Now it may well be that function could never be called in list
context.
But to verify your patch, somebody has to go and check, and
convince
themselves that this change wouldn't cause any problems.

It isn't that changes like this make the code worse. It isn't even
that
you couldn't make a case for why this style is an improvement.

It's that merely making unnecessary changes like this increases the
cognitive burden on people reviewing your patches, and increases
the
chance that a bug slips through.

Smylers

@p5pRT
Copy link
Author

p5pRT commented Nov 15, 2017

From @xsawyerx

On 11/15/2017 09​:25 AM, Zefram wrote​:

J. Nick Koston via RT wrote​:

I have reduced the noise in the patch and re-attached.
This still has a bunch of noise.

Can you please clarify this statement?

The *only* parts of the patch that are
OK [...]

What do you mean by "OK"? Do you mean "relevant" or "correct" or "can be
applied without alteration"?

@p5pRT
Copy link
Author

p5pRT commented Nov 16, 2017

From zefram@fysh.org

Sawyer X wrote​:

What do you mean by "OK"? Do you mean "relevant" or "correct" or "can be
applied without alteration"?

I mean "suitable to be applied". Of the other parts, the Changes patch
is actually incorrect in ways that I described, and the rest is churn
which doesn't change any behaviour but would obscure the real effect of
the patch and impede attribution.

The various no-op parts of the patches that have been proposed on this
ticket seem to be cruft from a longer history of privately editing Carp.
There were other historical artifacts in the earlier patches too.
We are not trying to import that whole history here; we want a clean
patch that makes sense in the present context.

-zefram

@p5pRT
Copy link
Author

p5pRT commented Nov 16, 2017

From @atoomic

so the minimal patch still breaks UNIVERSAL​::isa on CPAN...
it's not so easy to detect that we are using that rogue version... I was thinking to use a check on UNIVERSAL​::isa->can( "original_isa" ) but this came with its own problems...
so I decided to go with something much more easier, and simply check if $VERSION is defined
"my $isa = $UNIVERSAL​::isa​::VERSION ? sub { 1 } : \&UNIVERSAL​::isa;"

I will also submit the extra patch to UNIVERSAL​::isa to avoid the infinite loop on Carp....

If no one has objections on this minor&light patch I will merge it in the next day.

thanks
nicolas

On Wed, 15 Nov 2017 11​:01​:02 -0800, atoomic@​cpan.org wrote​:

I came with a very minimal patch, readable online
p5h/perl5demo#31

On Thu, 12 Oct 2017 20​:31​:55 -0700, bdraco wrote​:

Hi Smylers,

Thank you for the explanation.

I have reduced the noise in the patch and re-attached.

-Nick

On Thu, 12 Oct 2017 14​:59​:44 -0700, smylers@​stripey.com wrote​:

J. Nick Koston via RT writes​:

I have re-worked the patch and removed the downgrade
optimization.

Hi, Nick. Unfortunately your latest patch still has some trivial
coding-style changes in it of the sort that Zefram mentioned as
being
distracting.

This one stood out to me​:

- return \&{"CORE​::GLOBAL​::caller"} if defined
&{"CORE​::GLOBAL​::caller"};
- return;
+ return defined &{"CORE​::GLOBAL​::caller"} ?
\&{"CORE​::GLOBAL​::caller"} : undef;

That would change what the function returns in list context​: a list
containing an undef rather than an empty list.

Now it may well be that function could never be called in list
context.
But to verify your patch, somebody has to go and check, and
convince
themselves that this change wouldn't cause any problems.

It isn't that changes like this make the code worse. It isn't even
that
you couldn't make a case for why this style is an improvement.

It's that merely making unnecessary changes like this increases the
cognitive burden on people reviewing your patches, and increases
the
chance that a bug slips through.

Smylers

@p5pRT
Copy link
Author

p5pRT commented Nov 16, 2017

From @atoomic

0001-Carp-optimize-format_arg-when-arguments-contain-many.patch
From dd951f261eaf8b800d00d3cf8f6ea5ce5b2eee6e Mon Sep 17 00:00:00 2001
From: "J. Nick Koston" <nick@cpanel.net>
Date: Thu, 12 Oct 2017 01:57:36 -0500
Subject: [PATCH] Carp: optimize format_arg when arguments contain many
 references

RT #132274

This is a very minimal patch after RT discussion.
Note version bump is not required as it already occurred
since v5.27.5 release.
---
 dist/Carp/Changes     | 4 ++++
 dist/Carp/lib/Carp.pm | 7 ++++++-
 2 files changed, 10 insertions(+), 1 deletion(-)

diff --git a/dist/Carp/Changes b/dist/Carp/Changes
index 0498eeb885..db187e9443 100644
--- a/dist/Carp/Changes
+++ b/dist/Carp/Changes
@@ -1,3 +1,7 @@
+version 1.44
+
+  * Optimize format_arg when arguments contain many references
+
 version 1.43
 
   * fix problems introduced by the partial EBCDIC support from version
diff --git a/dist/Carp/lib/Carp.pm b/dist/Carp/lib/Carp.pm
index 623558aada..3c5764cefc 100644
--- a/dist/Carp/lib/Carp.pm
+++ b/dist/Carp/lib/Carp.pm
@@ -283,8 +283,13 @@ sub format_arg {
     my $arg = shift;
 
     if ( ref($arg) ) {
+
+        # lazy check if the CPAN module UNIVERSAL::isa is used or not
+        #   if we use a rogue version of UNIVERSAL this would lead to infinite loop
+        my $isa = $UNIVERSAL::isa::VERSION ? sub { 1 } : \&UNIVERSAL::isa;
+
          # legitimate, let's not leak it.
-        if (!$in_recurse &&
+        if (!$in_recurse && $isa->( $arg, 'UNIVERSAL' ) &&
 	    do {
                 local $@;
 	        local $in_recurse = 1;
-- 
2.13.6 (Apple Git-96)

@p5pRT
Copy link
Author

p5pRT commented Nov 21, 2017

From @atoomic

merged to blead with 915a681

On Wed, 15 Nov 2017 22​:01​:37 -0800, atoomic@​cpan.org wrote​:

so the minimal patch still breaks UNIVERSAL​::isa on CPAN...
it's not so easy to detect that we are using that rogue version... I
was thinking to use a check on UNIVERSAL​::isa->can( "original_isa" )
but this came with its own problems...
so I decided to go with something much more easier, and simply check
if $VERSION is defined
"my $isa = $UNIVERSAL​::isa​::VERSION ? sub { 1 } : \&UNIVERSAL​::isa;"

I will also submit the extra patch to UNIVERSAL​::isa to avoid the
infinite loop on Carp....

If no one has objections on this minor&light patch I will merge it in
the next day.

thanks
nicolas

On Wed, 15 Nov 2017 11​:01​:02 -0800, atoomic@​cpan.org wrote​:

I came with a very minimal patch, readable online
p5h/perl5demo#31

On Thu, 12 Oct 2017 20​:31​:55 -0700, bdraco wrote​:

Hi Smylers,

Thank you for the explanation.

I have reduced the noise in the patch and re-attached.

-Nick

On Thu, 12 Oct 2017 14​:59​:44 -0700, smylers@​stripey.com wrote​:

J. Nick Koston via RT writes​:

I have re-worked the patch and removed the downgrade
optimization.

Hi, Nick. Unfortunately your latest patch still has some trivial
coding-style changes in it of the sort that Zefram mentioned as
being
distracting.

This one stood out to me​:

- return \&{"CORE​::GLOBAL​::caller"} if defined
&{"CORE​::GLOBAL​::caller"};
- return;
+ return defined &{"CORE​::GLOBAL​::caller"} ?
\&{"CORE​::GLOBAL​::caller"} : undef;

That would change what the function returns in list context​: a
list
containing an undef rather than an empty list.

Now it may well be that function could never be called in list
context.
But to verify your patch, somebody has to go and check, and
convince
themselves that this change wouldn't cause any problems.

It isn't that changes like this make the code worse. It isn't
even
that
you couldn't make a case for why this style is an improvement.

It's that merely making unnecessary changes like this increases
the
cognitive burden on people reviewing your patches, and increases
the
chance that a bug slips through.

Smylers

@p5pRT
Copy link
Author

p5pRT commented Nov 21, 2017

@atoomic - Status changed from 'open' to 'pending release'

@p5pRT
Copy link
Author

p5pRT commented Nov 21, 2017

From @atoomic

fixed up the release version after 5.27.6.... via 8510c6c

On Tue, 21 Nov 2017 13​:37​:30 -0800, atoomic@​cpan.org wrote​:

merged to blead with 915a681

On Wed, 15 Nov 2017 22​:01​:37 -0800, atoomic@​cpan.org wrote​:

so the minimal patch still breaks UNIVERSAL​::isa on CPAN...
it's not so easy to detect that we are using that rogue version... I
was thinking to use a check on UNIVERSAL​::isa->can( "original_isa" )
but this came with its own problems...
so I decided to go with something much more easier, and simply check
if $VERSION is defined
"my $isa = $UNIVERSAL​::isa​::VERSION ? sub { 1 } : \&UNIVERSAL​::isa;"

I will also submit the extra patch to UNIVERSAL​::isa to avoid the
infinite loop on Carp....

If no one has objections on this minor&light patch I will merge it in
the next day.

thanks
nicolas

On Wed, 15 Nov 2017 11​:01​:02 -0800, atoomic@​cpan.org wrote​:

I came with a very minimal patch, readable online
p5h/perl5demo#31

On Thu, 12 Oct 2017 20​:31​:55 -0700, bdraco wrote​:

Hi Smylers,

Thank you for the explanation.

I have reduced the noise in the patch and re-attached.

-Nick

On Thu, 12 Oct 2017 14​:59​:44 -0700, smylers@​stripey.com wrote​:

J. Nick Koston via RT writes​:

I have re-worked the patch and removed the downgrade
optimization.

Hi, Nick. Unfortunately your latest patch still has some trivial
coding-style changes in it of the sort that Zefram mentioned as
being
distracting.

This one stood out to me​:

- return \&{"CORE​::GLOBAL​::caller"} if defined
&{"CORE​::GLOBAL​::caller"};
- return;
+ return defined &{"CORE​::GLOBAL​::caller"} ?
\&{"CORE​::GLOBAL​::caller"} : undef;

That would change what the function returns in list context​: a
list
containing an undef rather than an empty list.

Now it may well be that function could never be called in list
context.
But to verify your patch, somebody has to go and check, and
convince
themselves that this change wouldn't cause any problems.

It isn't that changes like this make the code worse. It isn't
even
that
you couldn't make a case for why this style is an improvement.

It's that merely making unnecessary changes like this increases
the
cognitive burden on people reviewing your patches, and increases
the
chance that a bug slips through.

Smylers

@p5pRT
Copy link
Author

p5pRT commented Jun 23, 2018

From @khwilliamson

Thank you for filing this report. You have helped make Perl better.

With the release yesterday of Perl 5.28.0, this and 185 other issues have been
resolved.

Perl 5.28.0 may be downloaded via​:
https://metacpan.org/release/XSAWYERX/perl-5.28.0

If you find that the problem persists, feel free to reopen this ticket.

@p5pRT
Copy link
Author

p5pRT commented Jun 23, 2018

@khwilliamson - Status changed from 'pending release' to 'resolved'

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Projects
None yet
Development

No branches or pull requests

1 participant