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
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
|
use strict;
use warnings;
use Test::More tests => 14;
use Devel::Confess ();
use Scalar::Util qw(blessed);
sub DEFAULT { die "DEFAULT\n" }
sub IGNORE { die "IGNORE\n" }
sub string { die "string\n" }
sub stub;
sub Namespaced::string { die "Namespaced::string\n" }
{
no strict 'refs';
*{"main::0"} = sub { die "zero\n" };
}
my $coderef = sub { die "coderef\n" };
{
package CodeOverload;
use overload '&{}' => sub { sub { die "CodeOverload\n" } };
sub new { bless {} }
}
{
package StringOverload;
use overload '""' => sub { "StringOverload::named" };
sub named { die "StringOverload::named\n" }
sub new { bless {} }
}
{
package FalseOverload;
use overload
'bool' => sub { 0 },
'&{}' => sub { sub { die "FalseOverload\n" } },
;
sub new { bless {} }
}
sub _ex (&) {
my $sub = $_[0];
local $@;
eval { $sub->(); 1 } and return undef;
my $e = $@;
$e =~ s/(?: at .*? line [0-9]+\.)?\n//;
return $e;
}
sub check_find {
my $sub = do {
no warnings 'uninitialized';
local $SIG{__DIE__} = $_[0];
Devel::Confess::_find_sig($SIG{__DIE__});
};
return "none"
if !defined $sub;
_ex {
(\&$sub)->("welp");
};
}
sub check_sig {
no warnings 'uninitialized';
local $SIG{__DIE__} = $_[0];
_ex {
die "none\n";
};
}
for my $sig (
undef,
0,
{},
'',
$coderef,
'DEFAULT',
'IGNORE',
'string',
'stub',
'Namespaced::string',
'nonexistant',
CodeOverload->new,
StringOverload->new,
FalseOverload->new,
) {
my $name
= blessed $sig ? (blessed($sig) . " instance")
: ref $sig ? (ref($sig) . " ref")
: defined $sig ? qq{"$sig"}
: 'undef';
is(check_find($sig), check_sig($sig),
"correct signal handler for $name"
);
}
|
