1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
|
use warnings;
no warnings 'once';
use Test::More tests => 7;
use Carp;
my $o = Stringable->new(key => 'Baz');
my $msg = call(\&with_longmess, $o, {bar => 'buzz'});
like($msg, qr/, Stringable=HASH\(0x[[:xdigit:]]+\),/,
"Stringable object not overload 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");
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
}
|
