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
|
use Moo::_strictures;
use Test::More;
use Test::Fatal;
BEGIN {
package AddOverrides;
$INC{"AddOverrides.pm"} = __FILE__;
use Carp ();
sub import {
my $package = caller;
for my $sub (
'defined',
'join',
'ref',
'die',
'shift',
'sort',
'undef',
) {
my $proto = prototype "CORE::$sub";
no strict 'refs';
*{"${package}::$sub"} = \&{"${package}::$sub"};
eval "sub ${package}::$sub ".($proto ? "($proto)" : '') . ' { Carp::confess("local '.$sub.'") }; 1'
or die $@;
}
}
}
{
package Foo;
use Moo;
sub welp { 1 }
}
{
package WithOverridden;
use AddOverrides;
use Moo;
sub BUILD { 1 }
sub DEMOLISH { CORE::die "demolish\n" if $::FATAL_DEMOLISH }
around BUILDARGS => sub {
my $orig = CORE::shift();
my $self = CORE::shift();
$self->$orig(@_);
};
has attr1 => (is => 'ro', required => 1, handles => ['welp']);
has attr2 => (is => 'ro', default => CORE::undef());
has attr3 => (is => 'rw', isa => sub { CORE::die "nope" } );
}
unlike exception { WithOverridden->new(1) }, qr/local/,
'bad constructor arguments error ignores local functions';
unlike exception { WithOverridden->new }, qr/local/,
'missing attributes error ignores local functions';
unlike exception { WithOverridden->new(attr1 => 1, attr3 => 1) }, qr/local/,
'constructor isa checks ignores local functions';
my $o;
is exception { $o = WithOverridden->new(attr1 => Foo->new) }, undef,
'constructor without error ignores local functions';
unlike exception { $o->attr3(1) }, qr/local/,
'isa checks ignores local functions';
is exception { $o->welp }, undef,
'delegates ignores local functions';
{
no warnings FATAL => 'all';
use warnings 'all';
my $w = '';
local $SIG{__WARN__} = sub { $w .= $_[0] };
local $::FATAL_DEMOLISH = 1;
undef $o;
unlike $w, qr/local/,
'destroy ignores local functions';
}
done_testing;
|
