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
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
|
use Moo::_strictures;
use Test::More;
{
package ClassA;
use Moo;
has 'foo' => ( is => 'ro');
has built => (is => 'rw', default => 0);
sub BUILD {
$_[0]->built($_[0]->built+1);
}
}
{
package ClassB;
our @ISA = 'ClassA';
sub blorp {};
sub new {
$_[0]->SUPER::new(@_[1..$#_]);
}
}
{
package ClassC;
use Moo;
extends 'ClassB';
has bar => (is => 'ro');
}
{
package ClassD;
our @ISA = 'ClassC';
}
my $o = ClassD->new(foo => 1, bar => 2);
isa_ok $o, 'ClassD';
is $o->foo, 1, 'superclass attribute has correct value';
is $o->bar, 2, 'subclass attribute has correct value';
is $o->built, 1, 'BUILD called correct number of times';
{
package ClassE;
sub new {
return ClassF->new;
}
}
{
package ClassF;
use Moo;
extends 'Moo::Object', 'ClassE';
}
{
my $o = eval { ClassF->new };
ok $o,
'explicit inheritence from Moo::Object works around broken constructor'
or diag $@;
isa_ok $o, 'ClassF';
}
{
package ClassG;
use Sub::Defer;
defer_sub __PACKAGE__.'::new' => sub { sub { bless {}, $_[0] } };
}
{
package ClassH;
use Moo;
extends 'ClassG';
}
{
my $o = eval { ClassH->new };
ok $o,
'inheriting from non-Moo with deferred new works'
or diag $@;
isa_ok $o, 'ClassH';
}
{
package ClassI;
sub new {
my $self = shift;
my $class = ref $self ? ref $self : $self;
bless {
(ref $self ? %$self : ()),
@_,
}, $class;
}
}
{
package ClassJ;
use Moo;
extends 'ClassI';
has 'attr' => (is => 'ro');
}
{
my $o1 = ClassJ->new(attr => 1);
my $o2 = $o1->new;
is $o2->attr, 1,
'original invoker passed to parent new';
}
done_testing;
|
