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
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
|
use Moo::_strictures;
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)";
}
{
package Some::Class;
use Moo;
sub foo { 1 }
}
like exception {
Moo::Role->apply_roles_to_package('EmptyClass', 'Some::Class');
}, qr/Some::Class is not a Moo::Role/,
'apply_roles_to_package throws error on non-role';
like exception {
Moo::Role->apply_single_role_to_package('EmptyClass', 'Some::Class');
}, qr/Some::Class is not a Moo::Role/,
'apply_single_role_to_package throws error on non-role';
like exception {
Moo::Role->create_class_with_roles('EmptyClass', 'Some::Class');
}, qr/Some::Class is not a Moo::Role/,
'can only create class with roles';
delete Moo->_constructor_maker_for('Some::Class')->{attribute_specs};
is exception {
Moo::Role->apply_roles_to_package('Some::Class', 'RoleWithAttr');
}, undef,
'apply_roles_to_package copes with missing attribute specs';
{
package Non::Moo::Class;
sub new { bless {}, $_[0] }
}
Moo::Role->apply_roles_to_package('Non::Moo::Class', 'RoleWithAttr');
ok +Non::Moo::Class->can('attr1'),
'can apply role with attributes to non Moo class';
done_testing;
|
