Carp now handles objects with string overloads.

It also allows objects to specify how they appear in the stack dump with
a CARP_TRACE method, and also allows the user to specify their own
formatter for objects without CARP_TRACE as well as other references.
[perl #92446]

Minor fix, commit message reformatting and manifest update by Tony Cook.

4 files changed, 178 insertions, 3 deletions

diff --git a/MANIFEST b/MANIFEST
index b7da05e83e..68925b718d 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -2905,6 +2905,7 @@ dist/bignum/t/scope_r.t			See if no bigrat works
 dist/Carp/lib/Carp/Heavy.pm	Error message retired workhorse
 dist/Carp/lib/Carp.pm		Error message extension
 dist/Carp/Makefile.PL		makefile writer for Carp
+dist/Carp/t/Carp_overload.t		See if Carp handles overloads
 dist/Carp/t/Carp.t		See if Carp works
 dist/Carp/t/heavy.t		See if Carp::Heavy works
 dist/Carp/t/stash_deletion.t		See if Carp handles stash deletion
diff --git a/dist/Carp/lib/Carp.pm b/dist/Carp/lib/Carp.pm
index bb557ddf00..a9b8f29760 100644
--- a/dist/Carp/lib/Carp.pm
+++ b/dist/Carp/lib/Carp.pm
@@ -24,13 +24,14 @@ BEGIN {
     }
 }
 
-our $VERSION = '1.30';
+our $VERSION = '1.31';
 
 our $MaxEvalLen = 0;
 our $Verbose    = 0;
 our $CarpLevel  = 0;
 our $MaxArgLen  = 64;    # How much of each argument to print. 0 = all.
 our $MaxArgNums = 8;     # How many arguments to print. 0 = all.
+our $RefArgFormatter = undef; # allow caller to format reference arguments
 
 require Exporter;
 our @ISA       = ('Exporter');
@@ -185,10 +186,44 @@ sub caller_info {
 }
 
 # Transform an argument to a function into a string.
+our $no_recurse;
 sub format_arg {
     my $arg = shift;
+    die "recursion\n" if $no_recurse;
+
     if ( ref($arg) ) {
-        $arg = defined($overload::VERSION) ? overload::StrVal($arg) : "$arg";
+        local $SIG{__DIE__} = sub{}; # legitimate, let's not leak it.
+        if (do {
+                local $@; 
+                eval {$arg->can('CARP_TRACE') }
+            })
+        {
+            $arg = $arg->CARP_TRACE();
+        }
+        elsif (do {
+                local $@;
+                eval {$arg = $RefArgFormatter->($arg); 1}
+                })
+        {
+            1;
+        }
+        elsif (defined($overload::VERSION))
+        {
+            do {
+                local $@;
+                eval {
+                    local $no_recurse = 1;
+                    $arg = "$arg";
+                    1;
+                }
+            } or do {
+                $arg = overload::StrVal($arg);
+            };
+        }
+        else
+        {
+            $arg = "$arg";
+        }
     }
     if ( defined($arg) ) {
         $arg =~ s/'/\\'/g;
@@ -565,6 +600,50 @@ environment variable.
 Alternately, you can set the global variable C<$Carp::Verbose> to true.
 See the C<GLOBAL VARIABLES> section below.
 
+=head2 Stack Trace formatting
+
+At each stack level, the subroutine's name is displayed along with
+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.
+
+=over 4
+
+=item 1.
+
+For objects, a method, C<CARP_TRACE>, will be called, if it exists.  If
+this method doesn't exist, 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 and the string returned is used.  It is recommended
+that the object's type is part of the string to make debugging easier.
+
+=item 2.
+
+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 
+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.
+
+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.
+
+=back
+
 =head1 GLOBAL VARIABLES
 
 =head2 $Carp::MaxEvalLen
@@ -597,6 +676,17 @@ is implemented internally.
 
 Defaults to C<0>.
 
+=head2 $Carp::RefArgFormatter
+
+This variable sets a general argument formatter to display references.
+Plain scalars and objects that implement C<CARP_TRACE> will not go through
+this formatter.  Calling C<Carp> from within this function is not supported.
+
+local $Carp::RefArgFormatter = sub {
+    require Data::Dumper;
+    Data::Dumper::Dump($_[0]); # not necessarily safe
+};
+
 =head2 @CARP_NOT
 
 This variable, I<in your package>, says which packages are I<not> to be
diff --git a/dist/Carp/lib/Carp/Heavy.pm b/dist/Carp/lib/Carp/Heavy.pm
index db8b4532b5..a7a3327387 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.30';
+our $VERSION = '1.31';
 
 1;
 
diff --git a/dist/Carp/t/Carp_overload.t b/dist/Carp/t/Carp_overload.t
new file mode 100644
index 0000000000..98749edaee
--- /dev/null
+++ b/dist/Carp/t/Carp_overload.t
@@ -0,0 +1,84 @@
+use warnings;
+no warnings 'once';
+use Test::More 0.98 tests => 9;
+
+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/'HASH\(0x[[:xdigit:]]+\)'/, "HASH *not* stringified");
+
+{
+    my $called;
+
+    local $Carp::RefArgFormatter = sub {
+        $called++;
+        join '', explain $_[0];
+    };
+
+    $msg = call(\&with_longmess, $o, {bar => 'buzz'});
+    ok($called, "Called private formatter");
+    like($msg, qr/bar.*buzz/m, 'HASH stringified');
+}
+
+$o = CarpTracable->new(key => 'Bax');
+$msg = call(\&with_longmess, $o, {bar => 'buzz'});
+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;
+
+sub call
+{
+    my $func = shift;
+    $func->(@_);
+}
+
+sub with_longmess
+{
+    my $g = shift;
+    Carp::longmess("longmess:\n");
+}
+
+package Stringable;
+
+use overload
+    q[""] => 'as_string';
+
+sub new { my $class = shift; return bless {@_}, $class }
+
+sub as_string
+{
+    my $self = shift;
+    join '=', ref $self, $self->{key} || '<no key>';
+}
+
+package CarpTracable;
+
+use parent -norequire => 'Stringable';
+
+sub CARP_TRACE
+{
+    my $self = shift;
+    $self->{called}++;
+    "TRACE:" . $self; # use string overload
+}
+
+package CarpBad;
+
+use parent -norequire => 'Stringable';
+
+sub as_string
+{
+    Carp::cluck("woops, this isn't allowed");
+    "THIS SHOULD NEVER HAPPEN";
+}
+
+