Fix RT #52610: Carp: Do not crash when reading @DB::args

Trying to read values from array @DB::args can lead to perl fatal error
"Bizarre copy of ARRAY in scalar assignment". But missing, incomplete or
possible incorrect value in @DB::args is not a fatal error for Carp.

Carp is primary used for reporting warnings and errors from other
modules, so it should not crash perl when trying to print error message.

This patch safely iterates all elements of @DB::args array via eval { }
block and replace already freed scalars for Carp usage by string
"** argument not available anymore **".

This prevent crashing perl and allows to use Carp module. It it not a
proper fix but rather workaround for Carp module. At least it allows to
safely use Carp.

Patch amended by Yves Orton

3 files changed, 43 insertions, 8 deletions

diff --git a/dist/Carp/lib/Carp.pm b/dist/Carp/lib/Carp.pm
index eb7ad7bb06..74715715b4 100644
--- a/dist/Carp/lib/Carp.pm
+++ b/dist/Carp/lib/Carp.pm
@@ -116,7 +116,7 @@ BEGIN {
 	;
 }
 
-our $VERSION = '1.46';
+our $VERSION = '1.47_01';
 $VERSION =~ tr/_//d;
 
 our $MaxEvalLen = 0;
@@ -232,11 +232,22 @@ sub caller_info {
 
     my $sub_name = Carp::get_subname( \%call_info );
     if ( $call_info{has_args} ) {
-        my @args;
-        if (CALLER_OVERRIDE_CHECK_OK && @DB::args == 1
-            && ref $DB::args[0] eq ref \$i
-            && $DB::args[0] == \$i ) {
-            @DB::args = ();    # Don't let anyone see the address of $i
+        # guard our serialization of the stack from stack refcounting bugs
+        my @args = map {
+                my $arg;
+                local $@= $@;
+                eval {
+                    $arg = $_;
+                    1;
+                } or do {
+                    $arg = '** argument not available anymore **';
+                };
+                $arg;
+            } @DB::args;
+        if (CALLER_OVERRIDE_CHECK_OK && @args == 1
+            && ref $args[0] eq ref \$i
+            && $args[0] == \$i ) {
+            @args = ();    # Don't let anyone see the address of $i
             local $@;
             my $where = eval {
                 my $func    = $cgc or return '';
@@ -255,7 +266,6 @@ sub caller_info {
                 = "** Incomplete caller override detected$where; \@DB::args were not set **";
         }
         else {
-            @args = @DB::args;
             my $overflow;
             if ( $MaxArgNums and @args > $MaxArgNums )
             {    # More than we want to show?
diff --git a/dist/Carp/lib/Carp/Heavy.pm b/dist/Carp/lib/Carp/Heavy.pm
index 1d4bab613f..a82325f4ce 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.46';
+our $VERSION = '1.47';
 $VERSION =~ tr/_//d;
 
 # Carp::Heavy was merged into Carp in version 1.12.  Any mismatched versions
diff --git a/dist/Carp/t/rt52610_crash.t b/dist/Carp/t/rt52610_crash.t
new file mode 100644
index 0000000000..faa19cb890
--- /dev/null
+++ b/dist/Carp/t/rt52610_crash.t
@@ -0,0 +1,25 @@
+use warnings;
+use strict;
+
+use Test::More tests => 1;
+
+use Carp ();
+
+sub do_carp {
+    Carp::longmess;
+}
+
+sub call_with_args {
+    my ($arg_hash, $func) = @_;
+    $func->(@{$arg_hash->{'args'}});
+}
+
+my $msg;
+my $h = {};
+my $arg_hash = {'args' => [undef]};
+call_with_args($arg_hash, sub {
+    $arg_hash->{'args'} = [];
+    $msg = do_carp(sub { $h; });
+});
+
+like $msg, qr/^ at.+\b(?i:rt52610_crash\.t) line \d+\.\n\tmain::__ANON__\(.*\) called at.+\b(?i:rt52610_crash\.t) line \d+\n\tmain::call_with_args\(HASH\(0x[[:xdigit:]]+\), CODE\(0x[[:xdigit:]]+\)\) called at.+\b(?i:rt52610_crash\.t) line \d+$/;