From fdf5fcde40864e583bbf86152b1cad6f9e834985 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Tue, 13 Aug 2013 16:38:50 +1000
Subject: [PATCH] [perl #92446] fix recursion introduced in original patch

Some of the other interfaces format_arg() calls can cluck(), confess() or
longmess().  Avoid infinite recursion in those cases.

Also, instead of die() on format_arg recursion, fallback to basic
CLASS=HASH(...) output.

This fixes issues with CGI-Application, Devel-TrackSIG and Class-Std.

- for CGI-Application we ended up calling can(CARP_TRACE) on a CGI.pm
  object, which instead of returning false, croak()s

- Devel-TrackSIG calls Carp::longmess when we set the __DIE__ handler
---
 dist/Carp/lib/Carp.pm       | 39 +++++++++++++++++++++++----------------
 dist/Carp/t/Carp_overload.t | 32 ++++++++++++++++++++++++--------
 2 files changed, 47 insertions(+), 24 deletions(-)

diff --git a/dist/Carp/lib/Carp.pm b/dist/Carp/lib/Carp.pm
index a9b8f29..9d480f8 100644
--- a/dist/Carp/lib/Carp.pm
+++ b/dist/Carp/lib/Carp.pm
@@ -186,22 +186,27 @@ sub caller_info {
 }
 
 # Transform an argument to a function into a string.
-our $no_recurse;
+our $in_recurse;
 sub format_arg {
     my $arg = shift;
-    die "recursion\n" if $no_recurse;
 
     if ( ref($arg) ) {
-        local $SIG{__DIE__} = sub{}; # legitimate, let's not leak it.
-        if (do {
-                local $@; 
+         # legitimate, let's not leak it.
+        if (!$in_recurse &&
+	    do {
+                local $@;
+	        local $in_recurse = 1;
+		local $SIG{__DIE__} = sub{};
                 eval {$arg->can('CARP_TRACE') }
             })
         {
             $arg = $arg->CARP_TRACE();
         }
-        elsif (do {
+        elsif (!$in_recurse &&
+	       do {
                 local $@;
+	        local $in_recurse = 1;
+		local $SIG{__DIE__} = sub{};
                 eval {$arg = $RefArgFormatter->($arg); 1}
                 })
         {
@@ -209,16 +214,18 @@ sub format_arg {
         }
         elsif (defined($overload::VERSION))
         {
-            do {
-                local $@;
-                eval {
-                    local $no_recurse = 1;
-                    $arg = "$arg";
-                    1;
-                }
-            } or do {
-                $arg = overload::StrVal($arg);
-            };
+	    if ($in_recurse ||
+		!do {
+                    local $@;
+	            local $in_recurse = 1;
+		    local $SIG{__DIE__} = sub{};
+                    eval {
+                        $arg = "$arg";
+                        1;
+                    }
+                }) {
+	        $arg = overload::StrVal($arg);
+            }
         }
         else
         {
diff --git a/dist/Carp/t/Carp_overload.t b/dist/Carp/t/Carp_overload.t
index 98749ed..18d3997 100644
--- a/dist/Carp/t/Carp_overload.t
+++ b/dist/Carp/t/Carp_overload.t
@@ -1,6 +1,6 @@
 use warnings;
 no warnings 'once';
-use Test::More 0.98 tests => 9;
+use Test::More 0.98 tests => 10;
 
 use Carp;
 
@@ -29,11 +29,19 @@ ok($o->{called}, "CARP_TRACE called");
 like($msg, qr/'TRACE:CarpTracable=Bax'/, "CARP_TRACE output used") or diag explain $msg;
 like($msg, qr/'HASH\(0x[[:xdigit:]]+\)'/, "HASH not stringified again");
 
-$o = CarpBad->new(key => 'Zoo');
-$msg = call(\&with_longmess, $o, {bar => 'kill'});
-unlike($msg, qr/THIS SHOULD NEVER HAPPEN|Zoo/, "Didn't get the as-string version");
-like($msg, qr/CarpBad=HASH/,"Normal non-overload string conversion");
-diag explain $msg;
+{
+    my @warn;
+    local $SIG{__WARN__} = sub { push @warn, "@_" };
+    $o = CarpBad->new(key => 'Zoo');
+    $msg = call(\&with_longmess, $o, {bar => 'kill'});
+    like($msg, qr/THIS CAN NOW HAPPEN|Zoo/, "Didn't get the as-string version");
+    like($warn[0], qr/this is now allowed/, "check warning produced");
+    @warn = ();
+
+    $o = CarpBad2->new(key => 'Apple');
+    $msg = call(\&with_longmess, $o, {bar => 'kill'});
+    like($msg, qr/CarpBad2=HASH/,"Normal non-overload string conversion");
+}
 
 sub call
 {
@@ -77,8 +85,16 @@ use parent -norequire => 'Stringable';
 
 sub as_string
 {
-    Carp::cluck("woops, this isn't allowed");
-    "THIS SHOULD NEVER HAPPEN";
+    Carp::cluck("this is now allowed");
+    "THIS CAN NOW HAPPEN";
 }
 
+package CarpBad2;
+
+use parent -norequire => 'Stringable';
 
+sub as_string
+{
+    confess("this should fallback");
+    "THIS SHOULD NEVER HAPPEN";
+}
-- 
2.7.4