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
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
|
use strictures 1;
use Test::More;
use Test::Fatal;
{
package One; use Role::Tiny;
around foo => sub { my $orig = shift; (__PACKAGE__, $orig->(@_)) };
package Two; use Role::Tiny;
around foo => sub { my $orig = shift; (__PACKAGE__, $orig->(@_)) };
package Three; use Role::Tiny;
around foo => sub { my $orig = shift; (__PACKAGE__, $orig->(@_)) };
package Four; use Role::Tiny;
around foo => sub { my $orig = shift; (__PACKAGE__, $orig->(@_)) };
package Base; sub foo { __PACKAGE__ }
}
foreach my $combo (
[ qw(One Two Three Four) ],
[ qw(Two Four Three) ],
[ qw(One Two) ]
) {
my $combined = Role::Tiny->create_class_with_roles('Base', @$combo);
is_deeply(
[ $combined->foo ], [ reverse(@$combo), 'Base' ],
"${combined} ok"
);
my $object = bless({}, 'Base');
Role::Tiny->apply_roles_to_object($object, @$combo);
is(ref($object), $combined, 'Object reblessed into correct class');
}
{
package RoleWithAttr;
use Moo::Role;
has attr1 => (is => 'ro', default => -1);
package RoleWithAttr2;
use Moo::Role;
has attr2 => (is => 'ro', default => -2);
package ClassWithAttr;
use Moo;
has attr3 => (is => 'ro', default => -3);
}
Moo::Role->apply_roles_to_package('ClassWithAttr', 'RoleWithAttr', 'RoleWithAttr2');
my $o = ClassWithAttr->new(attr1 => 1, attr2 => 2, attr3 => 3);
is($o->attr1, 1, 'attribute from role works');
is($o->attr2, 2, 'attribute from role 2 works');
is($o->attr3, 3, 'attribute from base class works');
{
package SubClassWithoutAttr;
use Moo;
extends 'ClassWithAttr';
}
my $o2 = Moo::Role->create_class_with_roles(
'SubClassWithoutAttr', 'RoleWithAttr')->new;
is($o2->attr3, -3, 'constructor includes base class');
is($o2->attr2, -2, 'constructor includes role');
{
package AccessorExtension;
use Moo::Role;
around 'generate_method' => sub {
my $orig = shift;
my $me = shift;
my ($into, $name) = @_;
$me->$orig(@_);
no strict 'refs';
*{"${into}::_${name}_marker"} = sub { };
};
}
{
package RoleWithReq;
use Moo::Role;
requires '_attr1_marker';
}
is exception {
package ClassWithExtension;
use Moo;
Moo::Role->apply_roles_to_object(
Moo->_accessor_maker_for(__PACKAGE__),
'AccessorExtension');
with qw(RoleWithAttr RoleWithReq);
}, undef, 'apply_roles_to_object correctly calls accessor generator';
{
package EmptyClass;
use Moo;
}
{
package RoleWithReq2;
use Moo::Role;
requires 'attr2';
}
is exception {
Moo::Role->create_class_with_roles(
'EmptyClass', 'RoleWithReq2', 'RoleWithAttr2');
}, undef, 'create_class_with_roles accepts attributes for requirements';
like exception {
Moo::Role->create_class_with_roles(
'EmptyClass', 'RoleWithReq2', 'RoleWithAttr');
}, qr/Can't apply .* missing attr2/,
'create_class_with_roles accepts attributes for requirements';
{
package RoleWith2Attrs;
use Moo::Role;
has attr1 => (is => 'ro', default => -1);
has attr2 => (is => 'ro', default => -2);
}
foreach my $combo (
[qw(RoleWithAttr RoleWithAttr2)],
[qw(RoleWith2Attrs)],
) {
is exception {
my $o = Moo::Role->apply_roles_to_object(
EmptyClass->new, @$combo);
is($o->attr1, -1, 'first attribute works');
is($o->attr2, -2, 'second attribute works');
}, undef, "apply_roles_to_object with multiple attrs with defaults (@$combo)";
}
done_testing;
|
