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
|
#!/usr/bin/perl
use strict;
use warnings;
use Test::More tests => 40;
use Test::Exception;
use lib 't/lib';
use Test::Mouse;
use MooseCompat;
=pod
NOTE:
Should we be testing here that the has & override
are injecting their methods correctly? In other
words, should 'has_method' return true for them?
=cut
{
package FooRole;
use Mouse::Role;
our $VERSION = '0.01';
has 'bar' => (is => 'rw', isa => 'Foo');
has 'baz' => (is => 'ro');
sub foo { 'FooRole::foo' }
sub boo { 'FooRole::boo' }
before 'boo' => sub { "FooRole::boo:before" };
after 'boo' => sub { "FooRole::boo:after1" };
after 'boo' => sub { "FooRole::boo:after2" };
around 'boo' => sub { "FooRole::boo:around" };
override 'bling' => sub { "FooRole::bling:override" };
override 'fling' => sub { "FooRole::fling:override" };
::dies_ok { extends() } '... extends() is not supported';
::dies_ok { augment() } '... augment() is not supported';
::dies_ok { inner() } '... inner() is not supported';
no Mouse::Role;
}
my $foo_role = FooRole->meta;
isa_ok($foo_role, 'Mouse::Meta::Role');
#isa_ok($foo_role, 'Class::MOP::Module');
is($foo_role->name, 'FooRole', '... got the right name of FooRole');
is($foo_role->version, '0.01', '... got the right version of FooRole');
# methods ...
ok($foo_role->has_method('foo'), '... FooRole has the foo method');
is($foo_role->get_method('foo')->body, \&FooRole::foo, '... FooRole got the foo method');
isa_ok($foo_role->get_method('foo'), 'Mouse::Meta::Role::Method');
ok($foo_role->has_method('boo'), '... FooRole has the boo method');
is($foo_role->get_method('boo')->body, \&FooRole::boo, '... FooRole got the boo method');
isa_ok($foo_role->get_method('boo'), 'Mouse::Meta::Role::Method');
is_deeply(
[ sort $foo_role->get_method_list() ],
[ 'boo', 'foo', 'meta' ],
'... got the right method list');
ok(FooRole->can('foo'), "locally defined methods are still there");
ok(!FooRole->can('has'), "sugar was unimported");
# attributes ...
is_deeply(
[ sort $foo_role->get_attribute_list() ],
[ 'bar', 'baz' ],
'... got the right attribute list');
ok($foo_role->has_attribute('bar'), '... FooRole does have the bar attribute');
my $bar_attr = $foo_role->get_attribute('bar');
is($bar_attr->{is}, 'rw',
'bar attribute is rw');
is($bar_attr->{isa}, 'Foo',
'bar attribute isa Foo');
{
local $TODO = 'definition_context is not yet implemented';
is(ref($bar_attr->{definition_context}), 'HASH',
'bar\'s definition context is a hash');
is($bar_attr->{definition_context}->{package}, 'FooRole',
'bar was defined in FooRole');
}
ok($foo_role->has_attribute('baz'), '... FooRole does have the baz attribute');
my $baz_attr = $foo_role->get_attribute('baz');
is($baz_attr->{is}, 'ro',
'baz attribute is ro');
{
local $TODO = 'definition_context is not yet implemented';
is(ref($baz_attr->{definition_context}), 'HASH',
'bar\'s definition context is a hash');
is($baz_attr->{definition_context}->{package}, 'FooRole',
'baz was defined in FooRole');
}
# method modifiers
ok($foo_role->has_before_method_modifiers('boo'), '... now we have a boo:before modifier');
is(($foo_role->get_before_method_modifiers('boo'))[0]->(),
"FooRole::boo:before",
'... got the right method back');
is_deeply(
[ $foo_role->get_method_modifier_list('before') ],
[ 'boo' ],
'... got the right list of before method modifiers');
ok($foo_role->has_after_method_modifiers('boo'), '... now we have a boo:after modifier');
is(($foo_role->get_after_method_modifiers('boo'))[0]->(),
"FooRole::boo:after1",
'... got the right method back');
is(($foo_role->get_after_method_modifiers('boo'))[1]->(),
"FooRole::boo:after2",
'... got the right method back');
is_deeply(
[ $foo_role->get_method_modifier_list('after') ],
[ 'boo' ],
'... got the right list of after method modifiers');
ok($foo_role->has_around_method_modifiers('boo'), '... now we have a boo:around modifier');
is(($foo_role->get_around_method_modifiers('boo'))[0]->(),
"FooRole::boo:around",
'... got the right method back');
is_deeply(
[ $foo_role->get_method_modifier_list('around') ],
[ 'boo' ],
'... got the right list of around method modifiers');
## overrides
ok($foo_role->has_override_method_modifier('bling'), '... now we have a bling:override modifier');
is($foo_role->get_override_method_modifier('bling')->(),
"FooRole::bling:override",
'... got the right method back');
ok($foo_role->has_override_method_modifier('fling'), '... now we have a fling:override modifier');
is($foo_role->get_override_method_modifier('fling')->(),
"FooRole::fling:override",
'... got the right method back');
is_deeply(
[ sort $foo_role->get_method_modifier_list('override') ],
[ 'bling', 'fling' ],
'... got the right list of override method modifiers');
|
