Gecko [ www.blackthorn-inc.com ]

Linux cpanel2.daytoncreative.net 2.6.32-754.29.2.el6.x86_64 #1 SMP Tue May 12 17:39:04 UTC 2020 x86_64
Apache/2.4.43 (cPanel) OpenSSL/1.1.1g mod_bwlimited/1.4
Server IP : 70.62.220.67 & Your IP : 216.73.216.193
Domains : Cant Read [ /etc/named.conf ]
User : michaelgreg

Name	Size	Permission	Date
Carp.t	10.98 KB	-r--r--r--	2014-12-27 11:48
Carp_overload.t	1.4 KB	-r--r--r--	2014-12-27 11:48
arg_regexp.t	2.69 KB	-r--r--r--	2014-12-27 11:48
arg_string.t	1.43 KB	-r--r--r--	2014-12-27 11:48
baduni.t	232 B	-r--r--r--	2014-12-27 11:48
baduni_warnings.t	269 B	-r--r--r--	2014-12-27 11:48
errno.t	1.23 KB	-r--r--r--	2014-12-27 11:48
heavy.t	294 B	-r--r--r--	2014-12-27 11:48
heavy_mismatch.t	276 B	-r--r--r--	2014-12-27 11:48
stash_deletion.t	2.08 KB	-r--r--r--	2014-12-27 11:48
swash.t	99 B	-r--r--r--	2014-12-27 11:48
vivify_gv.t	873 B	-r--r--r--	2014-12-27 11:48
vivify_stash.t	818 B	-r--r--r--	2014-12-27 11:48
with_warnings.t	168 B	-r--r--r--	2014-12-27 11:48

Rename

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
}