In perl.git, the branch blead has been updated
<https://perl5.git.perl.org/perl.git/commitdiff/7276ff5bb307b4639027305f3db927826089f646?hp=52c17dc66edf9b267b592425fbd10e39c5606e26>
- Log -----------------------------------------------------------------
commit 7276ff5bb307b4639027305f3db927826089f646
Author: Father Chrysostomos <spr...@cpan.org>
Date: Tue Feb 27 11:24:09 2018 -0800
Carp: Speed up longmess some more
Commit 915a6810d added a UNIVERSAL::isa check to format_arg (used by
longmess, which generates stack traces) to see whether an argument is
blessed before trying CARP_TRACE, to speed things up when the argu-
ment is not blessed.
Because this would cause infinite recursion when the UNIVERSAL::isa
module is loaded, a check was put in place to avoid this problem. But
the check was a run-time check, and so the speed-up was minimal.
If we move the check to compile time (and save the original
&UNIVERSAL::isa in case the module gets loaded later), then the speed-
up is signifant. That is what this patch does.
Before this patch, the following one-liner runs on my machine in 6
seconds on average:
$ ./perl -MCarp -Ilib -e 'sub f { my $c = shift; if ($c == 100) {
Carp::longmess() } else { f($c+1,{}) } } f(0,{}) for 1..500'
If I disable the isa check (just to see how much it was speeding
things up), it averages 6.5 seconds, not much of a difference.
If I move the $UNIVERSAL::isa::VERSION safety check to compile time
instead of run time, I can reduce the time to 4.9 seconds.
-----------------------------------------------------------------------
Summary of changes:
dist/Carp/lib/Carp.pm | 33 ++++++++++++++++++++-------------
1 file changed, 20 insertions(+), 13 deletions(-)
diff --git a/dist/Carp/lib/Carp.pm b/dist/Carp/lib/Carp.pm
index 10509d4339..25ba942ad1 100644
--- a/dist/Carp/lib/Carp.pm
+++ b/dist/Carp/lib/Carp.pm
@@ -130,6 +130,22 @@ sub _univ_mod_loaded {
}
}
+# _maybe_isa() is usually the UNIVERSAL::isa function. We have to avoid
+# the latter if the UNIVERSAL::isa module has been loaded, to avoid infi-
+# nite recursion; in that case _maybe_isa simply returns true.
+my $isa;
+BEGIN {
+ if (_univ_mod_loaded('isa')) {
+ *_maybe_isa = sub { 1 }
+ }
+ else {
+ # Since we have already done the check, record $isa for use below
+ # when defining _StrVal.
+ *_maybe_isa = $isa = _fetch_sub(UNIVERSAL => "isa");
+ }
+}
+
+
# We need an overload::StrVal or equivalent function, but we must avoid
# loading any modules on demand, as Carp is used from __DIE__ handlers and
# may be invoked after a syntax error.
@@ -165,18 +181,15 @@ BEGIN {
# _blessed is either UNIVERAL::isa(...), or, in the presence of an
# override, a hideous, but fairly reliable, workaround.
- *_blessed = _univ_mod_loaded('isa')
- ? sub {
+ *_blessed = $isa
+ ? sub { &$isa($_[0], "UNIVERSAL") }
+ : sub {
my $probe = "UNIVERSAL::Carp_probe_" . rand;
no strict 'refs';
local *$probe = sub { "unlikely string" };
local $@;
local $SIG{__DIE__} = sub{};
(eval { $_[0]->$probe } || '') eq 'unlikely string'
- }
- : do {
- my $isa = _fetch_sub(qw/UNIVERSAL isa/);
- sub { &$isa($_[0], "UNIVERSAL") }
};
*_StrVal = sub {
@@ -387,14 +400,8 @@ sub format_arg {
if ( my $pack= 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 = _univ_mod_loaded('isa')
- ? sub { 1 }
- : _fetch_sub(UNIVERSAL => "isa");
-
# legitimate, let's not leak it.
- if (!$in_recurse && $isa->( $arg, 'UNIVERSAL' ) &&
+ if (!$in_recurse && _maybe_isa( $arg, 'UNIVERSAL' ) &&
do {
local $@;
local $in_recurse = 1;
--
Perl5 Master Repository
