#!/usr/bin/env perl
use strict;
use warnings;
use Test::More tests => 15;
use Carp;
{
my $sub = eval <<'EVAL';
package Die;
sub {
#line 1 foo
die "blah";
}
EVAL
ok(!$@);
eval { $sub->() };
like($@, qr/^blah at foo line 1/);
{
no strict 'refs';
delete ${'::'}{'Die::'};
}
eval { $sub->() };
like($@, qr/^blah at foo line 1/);
}
{
my $sub = eval <<'EVAL';
package Confess;
sub {
#line 1 foo
Carp::confess("blah");
}
EVAL
ok(!$@);
eval { $sub->() };
like($@, qr/^blah at foo line 1/);
{
no strict 'refs';
delete ${'::'}{'Confess::'};
}
eval { $sub->() };
like($@, qr/^blah at foo line 1/);
}
{
my $sub = eval <<'EVAL';
package CroakHelper;
sub x {
Carp::croak("blah");
}
package Croak;
sub {
#line 1 foo
CroakHelper::x();
}
EVAL
ok(!$@);
eval { $sub->() };
like($@, qr/^blah at foo line 1/);
{
no strict 'refs';
delete ${'::'}{'Croak::'};
}
eval { $sub->() };
like($@, qr/^blah at foo line 1/);
{
no strict 'refs';
delete ${'::'}{'CroakHelper::'};
}
eval { $sub->() };
like($@, qr/^blah at foo line 1/);
}
{
# the amount of information available and how it is displayed varies quite
# a bit depending on the version of perl (specifically, what caller returns
# in that version), so there is a bit of fiddling around required to handle
# that
my $unknown_pat = qr/__ANON__::/;
$unknown_pat = qr/$unknown_pat|\(unknown\)/
if $] < 5.014;
my $sub = eval <<'EVAL';
package SubHelper;
sub x {
Carp::confess("blah");
}
package Sub;
sub {
#line 1 foo
SubHelper::x();
}
EVAL
ok(!$@);
eval { $sub->() };
unlike($@, qr/$unknown_pat/);
{
no strict 'refs';
delete ${'::'}{'Sub::'};
}
eval { $sub->() };
like($@, qr/$unknown_pat|Sub::/);
unlike($@, qr/$unknown_pat.*$unknown_pat/s);
{
no strict 'refs';
delete ${'::'}{'SubHelper::'};
}
eval { $sub->() };
like($@, qr/(?:$unknown_pat|SubHelper::).*(?:$unknown_pat|Sub::)/s);
}