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