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