From f7c3eab38662fba5cbdbc44e67acb1fc596f9412 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Mon, 19 Aug 2013 13:58:07 +1000
Subject: [PATCH] [perl #92446] don't use overloaded string values in the
 backtrace

Allowing string overloading caused some CPAN module tests to fail.

While it seems reasonable to allow "" overloading for the backtrace, it has
several problems:

- the overloaded stringification may be suitable for end-users, but not
  for debugging, the raw reference display at least allows for identifying
  which object is involved

- the overload may not be suitable for calling in an exception, eg. it may
  call parts of Carp itself internally, or throw its own exception

- the overload may not be intended for use, eg. deprecation

This changes fixes the failures for Data-Hive and Contextual-Return
reported in [perl #119321]
---
 dist/Carp/lib/Carp.pm       | 36 ++++++------------------------------
 dist/Carp/t/Carp_overload.t | 38 +++-----------------------------------
 2 files changed, 9 insertions(+), 65 deletions(-)

diff --git a/dist/Carp/lib/Carp.pm b/dist/Carp/lib/Carp.pm
index 4365808..8225028 100644
--- a/dist/Carp/lib/Carp.pm
+++ b/dist/Carp/lib/Carp.pm
@@ -213,24 +213,9 @@ sub format_arg {
         {
             1;
         }
-        elsif (defined(&overload::StrVal))
-        {
-	    if ($in_recurse ||
-		!do {
-                    local $@;
-	            local $in_recurse = 1;
-		    local $SIG{__DIE__} = sub{};
-                    eval {
-                        $arg = "$arg";
-                        1;
-                    }
-                }) {
-	        $arg = overload::StrVal($arg);
-            }
-        }
         else
         {
-            $arg = "$arg";
+            $arg = defined($overload::VERSION) ? overload::StrVal($arg) : "$arg";
         }
     }
     if ( defined($arg) ) {
@@ -615,7 +600,7 @@ its parameters.  For simple scalars, this is sufficient.  For complex
 data types, such as objects and other references, this can simply
 display C<'HASH(0x1ab36d8)'>.
 
-Carp gives three ways to control this.
+Carp gives two ways to control this.
 
 =over 4
 
@@ -633,22 +618,13 @@ For any type of reference, C<$Carp::RefArgFormatter> is checked (see below).
 This variable is expected to be a code reference, and the current parameter
 is passed in.  If this function doesn't exist (the variable is undef), or
 it recurses into C<Carp>, or it otherwise throws an exception, this is
-skipped, and Carp moves on to the next option, otherwise checking stops 
+skipped, and Carp moves on to the next option, otherwise checking stops
 and the string returned is used.
 
-=item 3.
-
-The reference is stringified.  If overloading is being used on the object,
-that overloading is called.  If that overload recurses into C<Carp>, or it
-otherwise throws an exception, this is skipped, and Carp moves on to the next
-option, otherwise checking stops and the string returned is used.
-
-=item 4.
+=item 3
 
-To get this far, L<overload> must be loaded because the object failed
-to stringify normally.  L<overload>::StrVal is called to stringify the
-object without any overloading to produce a value where all of the above
-has failed.
+Otherwise, if neither C<CARP_TRACE> nor C<$Carp::RefArgFormatter> is
+available, stringify the value ignoring any overloading.
 
 =back
 
diff --git a/dist/Carp/t/Carp_overload.t b/dist/Carp/t/Carp_overload.t
index 18d3997..8915a60 100644
--- a/dist/Carp/t/Carp_overload.t
+++ b/dist/Carp/t/Carp_overload.t
@@ -1,13 +1,14 @@
 use warnings;
 no warnings 'once';
-use Test::More 0.98 tests => 10;
+use Test::More 0.98 tests => 7;
 
 use Carp;
 
 my $o = Stringable->new(key => 'Baz');
 
 my $msg = call(\&with_longmess, $o, {bar => 'buzz'});
-like($msg, qr/'Stringable=Baz'/, "Stringable object stringified");
+like($msg, qr/'Stringable=HASH\(0x[[:xdigit:]]+\)'/,
+	    "Stringable object not overload stringified");
 like($msg, qr/'HASH\(0x[[:xdigit:]]+\)'/, "HASH *not* stringified");
 
 {
@@ -29,20 +30,6 @@ 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");
 
-{
-    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
 {
     my $func = shift;
@@ -79,22 +66,3 @@ sub CARP_TRACE
     "TRACE:" . $self; # use string overload
 }
 
-package CarpBad;
-
-use parent -norequire => 'Stringable';
-
-sub as_string
-{
-    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