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
|
sub clean_die {
use warnings;
die @_;
}
use Moo::_strictures;
use Test::More;
use Test::Fatal;
{
package Foo;
use Moo;
sub DEMOLISH {
die "Error in DEMOLISH";
}
}
my @warnings;
my @looped_exceptions;
my $o = Foo->new;
{
local $SIG{__WARN__} = sub {
push @warnings, $_[0];
};
# make sure we don't loop infinitely
my $last_die;
local $SIG{__DIE__} = sub {
my $location = join(':', caller);
if ($last_die && $last_die eq $location) {
push @looped_exceptions, $_[0];
clean_die(@_);
}
$last_die = $location;
};
{
no warnings FATAL => 'misc';
use warnings 'misc';
undef $o;
# if undef is the last statement in a block, its effect is delayed until
# after the block is cleaned up (and our warning settings won't be applied)
1;
}
}
like $warnings[0], qr/\(in cleanup\) Error in DEMOLISH/,
'error in DEMOLISH converted to warning';
is scalar @warnings, 1,
'no other warnings generated';
is scalar @looped_exceptions, 0,
'no infinitely looping exception in DESTROY';
done_testing;
|
