fix punctuation
[gitmo/Moose.git] / t / roles / role.t
CommitLineData
e185c027 1#!/usr/bin/perl
2
3use strict;
4use warnings;
5
a28e50e4 6use Test::More;
b10dde3a 7use Test::Fatal;
e185c027 8
38f1204c 9=pod
10
11NOTE:
12
13Should we be testing here that the has & override
d03bd989 14are injecting their methods correctly? In other
38f1204c 15words, should 'has_method' return true for them?
16
17=cut
18
e185c027 19{
20 package FooRole;
e185c027 21 use Moose::Role;
d03bd989 22
e185c027 23 our $VERSION = '0.01';
d03bd989 24
e185c027 25 has 'bar' => (is => 'rw', isa => 'Foo');
d03bd989 26 has 'baz' => (is => 'ro');
27
e185c027 28 sub foo { 'FooRole::foo' }
d03bd989 29 sub boo { 'FooRole::boo' }
30
0558683c 31 before 'boo' => sub { "FooRole::boo:before" };
d03bd989 32
33 after 'boo' => sub { "FooRole::boo:after1" };
34 after 'boo' => sub { "FooRole::boo:after2" };
35
36 around 'boo' => sub { "FooRole::boo:around" };
37
38 override 'bling' => sub { "FooRole::bling:override" };
39 override 'fling' => sub { "FooRole::fling:override" };
40
b10dde3a 41 ::isnt( ::exception { extends() }, undef, '... extends() is not supported' );
42 ::isnt( ::exception { augment() }, undef, '... augment() is not supported' );
43 ::isnt( ::exception { inner() }, undef, '... inner() is not supported' );
fd75e12b 44
45 no Moose::Role;
e185c027 46}
47
48my $foo_role = FooRole->meta;
49isa_ok($foo_role, 'Moose::Meta::Role');
68efb014 50isa_ok($foo_role, 'Class::MOP::Module');
e185c027 51
52is($foo_role->name, 'FooRole', '... got the right name of FooRole');
53is($foo_role->version, '0.01', '... got the right version of FooRole');
54
55# methods ...
56
57ok($foo_role->has_method('foo'), '... FooRole has the foo method');
093b12c2 58is($foo_role->get_method('foo')->body, \&FooRole::foo, '... FooRole got the foo method');
e185c027 59
a7d0cd00 60isa_ok($foo_role->get_method('foo'), 'Moose::Meta::Role::Method');
61
bdabd620 62ok($foo_role->has_method('boo'), '... FooRole has the boo method');
093b12c2 63is($foo_role->get_method('boo')->body, \&FooRole::boo, '... FooRole got the boo method');
bdabd620 64
65isa_ok($foo_role->get_method('boo'), 'Moose::Meta::Role::Method');
66
e185c027 67is_deeply(
bdabd620 68 [ sort $foo_role->get_method_list() ],
a8547bc0 69 [ 'boo', 'foo', 'meta' ],
e185c027 70 '... got the right method list');
fa476537 71
72ok(FooRole->can('foo'), "locally defined methods are still there");
73ok(!FooRole->can('has'), "sugar was unimported");
74
e185c027 75# attributes ...
76
77is_deeply(
78 [ sort $foo_role->get_attribute_list() ],
79 [ 'bar', 'baz' ],
80 '... got the right attribute list');
81
82ok($foo_role->has_attribute('bar'), '... FooRole does have the bar attribute');
83
eca0df24 84my $bar_attr = $foo_role->get_attribute('bar');
85is($bar_attr->{is}, 'rw',
86 'bar attribute is rw');
87is($bar_attr->{isa}, 'Foo',
88 'bar attribute isa Foo');
89is(ref($bar_attr->{definition_context}), 'HASH',
90 'bar\'s definition context is a hash');
91is($bar_attr->{definition_context}->{package}, 'FooRole',
92 'bar was defined in FooRole');
e185c027 93
94ok($foo_role->has_attribute('baz'), '... FooRole does have the baz attribute');
95
eca0df24 96my $baz_attr = $foo_role->get_attribute('baz');
97is($baz_attr->{is}, 'ro',
98 'baz attribute is ro');
99is(ref($baz_attr->{definition_context}), 'HASH',
100 'bar\'s definition context is a hash');
101is($baz_attr->{definition_context}->{package}, 'FooRole',
102 'baz was defined in FooRole');
e185c027 103
0558683c 104# method modifiers
105
106ok($foo_role->has_before_method_modifiers('boo'), '... now we have a boo:before modifier');
d03bd989 107is(($foo_role->get_before_method_modifiers('boo'))[0]->(),
108 "FooRole::boo:before",
0558683c 109 '... got the right method back');
110
111is_deeply(
112 [ $foo_role->get_method_modifier_list('before') ],
113 [ 'boo' ],
114 '... got the right list of before method modifiers');
115
116ok($foo_role->has_after_method_modifiers('boo'), '... now we have a boo:after modifier');
d03bd989 117is(($foo_role->get_after_method_modifiers('boo'))[0]->(),
118 "FooRole::boo:after1",
119 '... got the right method back');
120is(($foo_role->get_after_method_modifiers('boo'))[1]->(),
121 "FooRole::boo:after2",
0558683c 122 '... got the right method back');
0558683c 123
124is_deeply(
125 [ $foo_role->get_method_modifier_list('after') ],
126 [ 'boo' ],
127 '... got the right list of after method modifiers');
d03bd989 128
0558683c 129ok($foo_role->has_around_method_modifiers('boo'), '... now we have a boo:around modifier');
d03bd989 130is(($foo_role->get_around_method_modifiers('boo'))[0]->(),
131 "FooRole::boo:around",
0558683c 132 '... got the right method back');
133
134is_deeply(
135 [ $foo_role->get_method_modifier_list('around') ],
136 [ 'boo' ],
137 '... got the right list of around method modifiers');
138
139## overrides
140
141ok($foo_role->has_override_method_modifier('bling'), '... now we have a bling:override modifier');
d03bd989 142is($foo_role->get_override_method_modifier('bling')->(),
143 "FooRole::bling:override",
0558683c 144 '... got the right method back');
145
146ok($foo_role->has_override_method_modifier('fling'), '... now we have a fling:override modifier');
d03bd989 147is($foo_role->get_override_method_modifier('fling')->(),
148 "FooRole::fling:override",
0558683c 149 '... got the right method back');
150
151is_deeply(
152 [ sort $foo_role->get_method_modifier_list('override') ],
153 [ 'bling', 'fling' ],
154 '... got the right list of override method modifiers');
155
a28e50e4 156done_testing;