fix Perl #132828 - dont use overload to bypass overloads

the internals don't need overload.pm to be loaded to enable overloads
which means that Carp needs to defend against overload without checking
if overload.pm is loaded either.

One odd thing about this change is that if I remove the "eval" that
wraps the "require" then we fail tests in dist/Carp/t/vivify_stash.t
which defies expectation as the require is never actually executed
from that code.

This patch doesn't have tests yet as it can segfault perl.

3 files changed, 25 insertions, 11 deletions

diff --git a/dist/Carp/lib/Carp.pm b/dist/Carp/lib/Carp.pm
index 74715715b4..8f93af11ac 100644
--- a/dist/Carp/lib/Carp.pm
+++ b/dist/Carp/lib/Carp.pm
@@ -116,7 +116,7 @@ BEGIN {
 	;
 }
 
-our $VERSION = '1.47_01';
+our $VERSION = '1.47_02';
 $VERSION =~ tr/_//d;
 
 our $MaxEvalLen = 0;
@@ -306,7 +306,7 @@ our $in_recurse;
 sub format_arg {
     my $arg = shift;
 
-    if ( ref($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
@@ -336,8 +336,22 @@ sub format_arg {
         }
         else
         {
-	    my $sub = _fetch_sub(overload => 'StrVal');
-	    return $sub ? &$sub($arg) : "$arg";
+            # this particular bit of magic looking code is responsible for disabling overloads
+            # while we are stringifing arguments, otherwise if an overload calls a Carp sub we
+            # could end up in infinite recursion, which means we will exhaust the C stack and
+            # then segfault. Calling Carp obviously should not trigger an untrappable exception
+            # from Carp itself! - Yves
+            if ($pack->can("((")) {
+                # this eval is required, or fail the overload test
+                # in dist/Carp/t/vivify_stash.t, which is really quite weird.
+                # Even if we never enter this block, the presence of the require
+                # causes the test to fail. This seems like it might be a bug
+                # in require. Needs further investigation - Yves
+                eval "require overload; 1"
+                    or return "use overload failed";
+            }
+            my $sub = _fetch_sub(overload => 'StrVal');
+            return $sub ? &$sub($arg) : "$arg";
         }
     }
     return "undef" if !defined($arg);
diff --git a/dist/Carp/lib/Carp/Heavy.pm b/dist/Carp/lib/Carp/Heavy.pm
index a82325f4ce..75ca4c5225 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.47';
+our $VERSION = '1.47_02';
 $VERSION =~ tr/_//d;
 
 # Carp::Heavy was merged into Carp in version 1.12.  Any mismatched versions
diff --git a/dist/Carp/t/vivify_stash.t b/dist/Carp/t/vivify_stash.t
index 455aded7c1..46e0b637e9 100644
--- a/dist/Carp/t/vivify_stash.t
+++ b/dist/Carp/t/vivify_stash.t
@@ -8,20 +8,20 @@ our $has_UNIVERSAL_isa; BEGIN { $has_UNIVERSAL_isa = exists($UNIVERSAL::{"isa::"
 use Carp;
 sub { sub { Carp::longmess("x") }->() }->(\1, "\x{2603}", qr/\x{2603}/);
 
-print !(exists($::{"utf8::"}) xor $has_utf8) ? "" : "not ", "ok 1\n";
-print !(exists($::{"overload::"}) xor $has_overload) ? "" : "not ", "ok 2\n";
-print !(exists($::{"B::"}) xor $has_B) ? "" : "not ", "ok 3\n";
-print !(exists($UNIVERSAL::{"isa::"}) xor $has_UNIVERSAL_isa) ? "" : "not ", "ok 4\n";
+print !(exists($::{"utf8::"}) xor $has_utf8) ? "" : "not ", "ok 1 # used utf8\n";
+print !(exists($::{"overload::"}) xor $has_overload) ? "" : "not ", "ok 2 # used overload\n";
+print !(exists($::{"B::"}) xor $has_B) ? "" : "not ", "ok 3 # used B\n";
+print !(exists($UNIVERSAL::{"isa::"}) xor $has_UNIVERSAL_isa) ? "" : "not ", "ok 4 # used UNIVERSAL::isa\n";
 
 # Autovivify $::{"overload::"}
 () = \$::{"overload::"};
 () = \$::{"utf8::"};
 eval { sub { Carp::longmess() }->(\1) };
-print $@ eq '' ? "ok 5\n" : "not ok 5\n# $@";
+print $@ eq '' ? "ok 5 # longmess check1\n" : "not ok 5 # longmess check1\n# $@";
 
 # overload:: glob without hash
 undef *{"overload::"};
 eval { sub { Carp::longmess() }->(\1) };
-print $@ eq '' ? "ok 6\n" : "not ok 6\n# $@";
+print $@ eq '' ? "ok 6 # longmess check2\n" : "not ok 6 # longmess check2\n# $@";
 
 1;