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