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.

1 files 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;