1use warnings;
2no warnings 'once';
3use Test::More tests => 7;
4
5use Carp;
6
7use Data::Dumper ();
8sub _dump ($) {
9  Data::Dumper->new(\@_)->Indent(1)->Terse(1)->Dump;
10}
11
12my $o = Stringable->new(key => 'Baz');
13
14my $msg = call(\&with_longmess, $o, {bar => 'buzz'});
15like($msg, qr/, Stringable=HASH\(0x[[:xdigit:]]+\),/,
16	    "Stringable object not overload stringified");
17like($msg, qr/, HASH\(0x[[:xdigit:]]+\)\)/, "HASH *not* stringified");
18
19{
20    my $called;
21
22    local $Carp::RefArgFormatter = sub {
23        $called++;
24        join '', _dump $_[0];
25    };
26
27    $msg = call(\&with_longmess, $o, {bar => 'buzz'});
28    ok($called, "Called private formatter");
29    like($msg, qr/bar.*buzz/m, 'HASH stringified');
30}
31
32$o = CarpTracable->new(key => 'Bax');
33$msg = call(\&with_longmess, $o, {bar => 'buzz'});
34ok($o->{called}, "CARP_TRACE called");
35like($msg, qr/, TRACE:CarpTracable=Bax, /, "CARP_TRACE output used") or diag _dump $msg;
36like($msg, qr/, HASH\(0x[[:xdigit:]]+\)\)/, "HASH not stringified again");
37
38sub call
39{
40    my $func = shift;
41    $func->(@_);
42}
43
44sub with_longmess
45{
46    my $g = shift;
47    Carp::longmess("longmess:\n");
48}
49
50package Stringable;
51
52use overload
53    q[""] => 'as_string';
54
55sub new { my $class = shift; return bless {@_}, $class }
56
57sub as_string
58{
59    my $self = shift;
60    join '=', ref $self, $self->{key} || '<no key>';
61}
62
63package CarpTracable;
64
65# need to set inheritance of new() etc before the
66# CarpTracable->new calls higher up
67BEGIN { our @ISA = 'Stringable' }
68
69sub CARP_TRACE
70{
71    my $self = shift;
72    $self->{called}++;
73    "TRACE:" . $self; # use string overload
74}
75
76