Commit | Line | Data |
78cd1d3b |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
a28e50e4 |
6 | use Test::More; |
b10dde3a |
7 | use Test::Fatal; |
78cd1d3b |
8 | |
78cd1d3b |
9 | { |
10 | package FooRole; |
78cd1d3b |
11 | use Moose::Role; |
0be0b30e |
12 | |
2e7f6cf4 |
13 | our $VERSION = 23; |
14 | |
0be0b30e |
15 | has 'bar' => ( is => 'rw', isa => 'FooClass' ); |
16 | has 'baz' => ( is => 'ro' ); |
17 | |
18 | sub goo {'FooRole::goo'} |
19 | sub foo {'FooRole::foo'} |
20 | |
21 | override 'boo' => sub { 'FooRole::boo -> ' . super() }; |
22 | |
23 | around 'blau' => sub { |
0558683c |
24 | my $c = shift; |
25 | 'FooRole::blau -> ' . $c->(); |
0be0b30e |
26 | }; |
27 | } |
78cd1d3b |
28 | |
0be0b30e |
29 | { |
3f562dd9 |
30 | package BarRole; |
31 | use Moose::Role; |
0be0b30e |
32 | sub woot {'BarRole::woot'} |
33 | } |
34 | |
35 | { |
78cd1d3b |
36 | package BarClass; |
78cd1d3b |
37 | use Moose; |
8ecb1fa0 |
38 | |
0be0b30e |
39 | sub boo {'BarClass::boo'} |
40 | sub foo {'BarClass::foo'} # << the role overrides this ... |
0be0b30e |
41 | } |
42 | |
43 | { |
78cd1d3b |
44 | package FooClass; |
78cd1d3b |
45 | use Moose; |
0be0b30e |
46 | |
78cd1d3b |
47 | extends 'BarClass'; |
2e7f6cf4 |
48 | |
b10dde3a |
49 | ::like( ::exception { with 'FooRole' => { -version => 42 } }, qr/FooRole version 42 required--this is only version 23/, 'applying role with unsatisfied version requirement' ); |
2e7f6cf4 |
50 | |
b10dde3a |
51 | ::is( ::exception { with 'FooRole' => { -version => 13 } }, undef, 'applying role with satisfied version requirement' ); |
0be0b30e |
52 | |
53 | sub blau {'FooClass::blau'} # << the role wraps this ... |
54 | |
55 | sub goo {'FooClass::goo'} # << overrides the one from the role ... |
0be0b30e |
56 | } |
57 | |
58 | { |
3f562dd9 |
59 | package FooBarClass; |
60 | use Moose; |
0be0b30e |
61 | |
3f562dd9 |
62 | extends 'FooClass'; |
0be0b30e |
63 | with 'FooRole', 'BarRole'; |
78cd1d3b |
64 | } |
65 | |
eea9eb4d |
66 | { |
67 | package PlainJane; |
68 | sub new { return bless {}, __PACKAGE__; } |
69 | } |
70 | |
78cd1d3b |
71 | my $foo_class_meta = FooClass->meta; |
0be0b30e |
72 | isa_ok( $foo_class_meta, 'Moose::Meta::Class' ); |
78cd1d3b |
73 | |
3f562dd9 |
74 | my $foobar_class_meta = FooBarClass->meta; |
0be0b30e |
75 | isa_ok( $foobar_class_meta, 'Moose::Meta::Class' ); |
3f562dd9 |
76 | |
b10dde3a |
77 | isnt( exception { |
0be0b30e |
78 | $foo_class_meta->does_role(); |
b10dde3a |
79 | }, undef, '... does_role requires a role name' ); |
bbd2fe69 |
80 | |
b10dde3a |
81 | isnt( exception { |
e016145b |
82 | $foo_class_meta->add_role(); |
b10dde3a |
83 | }, undef, '... apply_role requires a role' ); |
bbd2fe69 |
84 | |
b10dde3a |
85 | isnt( exception { |
e016145b |
86 | $foo_class_meta->add_role( bless( {} => 'Fail' ) ); |
b10dde3a |
87 | }, undef, '... apply_role requires a role' ); |
bbd2fe69 |
88 | |
0be0b30e |
89 | ok( $foo_class_meta->does_role('FooRole'), |
90 | '... the FooClass->meta does_role FooRole' ); |
91 | ok( !$foo_class_meta->does_role('OtherRole'), |
92 | '... the FooClass->meta !does_role OtherRole' ); |
ef333f17 |
93 | |
0be0b30e |
94 | ok( $foobar_class_meta->does_role('FooRole'), |
95 | '... the FooBarClass->meta does_role FooRole' ); |
96 | ok( $foobar_class_meta->does_role('BarRole'), |
97 | '... the FooBarClass->meta does_role BarRole' ); |
98 | ok( !$foobar_class_meta->does_role('OtherRole'), |
99 | '... the FooBarClass->meta !does_role OtherRole' ); |
3f562dd9 |
100 | |
0558683c |
101 | foreach my $method_name (qw(bar baz foo boo blau goo)) { |
0be0b30e |
102 | ok( $foo_class_meta->has_method($method_name), |
103 | '... FooClass has the method ' . $method_name ); |
104 | ok( $foobar_class_meta->has_method($method_name), |
105 | '... FooBarClass has the method ' . $method_name ); |
78cd1d3b |
106 | } |
107 | |
0be0b30e |
108 | ok( !$foo_class_meta->has_method('woot'), |
109 | '... FooClass lacks the method woot' ); |
110 | ok( $foobar_class_meta->has_method('woot'), |
111 | '... FooBarClass has the method woot' ); |
3f562dd9 |
112 | |
78cd1d3b |
113 | foreach my $attr_name (qw(bar baz)) { |
0be0b30e |
114 | ok( $foo_class_meta->has_attribute($attr_name), |
115 | '... FooClass has the attribute ' . $attr_name ); |
116 | ok( $foobar_class_meta->has_attribute($attr_name), |
117 | '... FooBarClass has the attribute ' . $attr_name ); |
78cd1d3b |
118 | } |
119 | |
0be0b30e |
120 | can_ok( 'FooClass', 'does' ); |
121 | ok( FooClass->does('FooRole'), '... the FooClass does FooRole' ); |
122 | ok( !FooClass->does('BarRole'), '... the FooClass does not do BarRole' ); |
123 | ok( !FooClass->does('OtherRole'), '... the FooClass does not do OtherRole' ); |
ef333f17 |
124 | |
0be0b30e |
125 | can_ok( 'FooBarClass', 'does' ); |
126 | ok( FooBarClass->does('FooRole'), '... the FooClass does FooRole' ); |
127 | ok( FooBarClass->does('BarRole'), '... the FooBarClass does FooBarRole' ); |
128 | ok( !FooBarClass->does('OtherRole'), |
129 | '... the FooBarClass does not do OtherRole' ); |
3f562dd9 |
130 | |
78cd1d3b |
131 | my $foo = FooClass->new(); |
0be0b30e |
132 | isa_ok( $foo, 'FooClass' ); |
78cd1d3b |
133 | |
3f562dd9 |
134 | my $foobar = FooBarClass->new(); |
0be0b30e |
135 | isa_ok( $foobar, 'FooBarClass' ); |
136 | |
137 | is( $foo->goo, 'FooClass::goo', '... got the right value of goo' ); |
138 | is( $foobar->goo, 'FooRole::goo', '... got the right value of goo' ); |
139 | |
140 | is( $foo->boo, 'FooRole::boo -> BarClass::boo', |
141 | '... got the right value from ->boo' ); |
142 | is( $foobar->boo, 'FooRole::boo -> FooRole::boo -> BarClass::boo', |
143 | '... got the right value from ->boo (double wrapped)' ); |
144 | |
145 | is( $foo->blau, 'FooRole::blau -> FooClass::blau', |
146 | '... got the right value from ->blau' ); |
147 | is( $foobar->blau, 'FooRole::blau -> FooRole::blau -> FooClass::blau', |
148 | '... got the right value from ->blau' ); |
149 | |
150 | foreach my $foo ( $foo, $foobar ) { |
151 | can_ok( $foo, 'does' ); |
152 | ok( $foo->does('FooRole'), '... an instance of FooClass does FooRole' ); |
153 | ok( !$foo->does('OtherRole'), |
154 | '... and instance of FooClass does not do OtherRole' ); |
155 | |
156 | can_ok( $foobar, 'does' ); |
157 | ok( $foobar->does('FooRole'), |
158 | '... an instance of FooBarClass does FooRole' ); |
159 | ok( $foobar->does('BarRole'), |
160 | '... an instance of FooBarClass does BarRole' ); |
161 | ok( !$foobar->does('OtherRole'), |
162 | '... and instance of FooBarClass does not do OtherRole' ); |
78cd1d3b |
163 | |
fb1e11d5 |
164 | for my $method (qw/bar baz foo boo goo blau/) { |
0be0b30e |
165 | can_ok( $foo, $method ); |
fb1e11d5 |
166 | } |
78cd1d3b |
167 | |
0be0b30e |
168 | is( $foo->foo, 'FooRole::foo', '... got the right value of foo' ); |
78cd1d3b |
169 | |
0be0b30e |
170 | ok( !defined( $foo->baz ), '... $foo->baz is undefined' ); |
171 | ok( !defined( $foo->bar ), '... $foo->bar is undefined' ); |
78cd1d3b |
172 | |
b10dde3a |
173 | isnt( exception { |
0be0b30e |
174 | $foo->baz(1); |
b10dde3a |
175 | }, undef, '... baz is a read-only accessor' ); |
78cd1d3b |
176 | |
b10dde3a |
177 | isnt( exception { |
0be0b30e |
178 | $foo->bar(1); |
b10dde3a |
179 | }, undef, '... bar is a read-write accessor with a type constraint' ); |
78cd1d3b |
180 | |
fb1e11d5 |
181 | my $foo2 = FooClass->new(); |
0be0b30e |
182 | isa_ok( $foo2, 'FooClass' ); |
06b30515 |
183 | |
b10dde3a |
184 | is( exception { |
0be0b30e |
185 | $foo->bar($foo2); |
b10dde3a |
186 | }, undef, '... bar is a read-write accessor with a type constraint' ); |
fb1e11d5 |
187 | |
0be0b30e |
188 | is( $foo->bar, $foo2, '... got the right value for bar now' ); |
fb1e11d5 |
189 | } |
a28e50e4 |
190 | |
8e590ae4 |
191 | { |
192 | { |
193 | package MRole; |
194 | use Moose::Role; |
195 | sub meth { } |
196 | } |
197 | |
198 | { |
199 | package MRole2; |
200 | use Moose::Role; |
201 | sub meth2 { } |
202 | } |
203 | |
204 | { |
205 | use Moose::Meta::Class; |
206 | use Moose::Object; |
207 | use Moose::Util qw(apply_all_roles); |
208 | |
209 | my $class = Moose::Meta::Class->create( 'Class' => ( |
210 | superclasses => [ 'Moose::Object' ], |
211 | )); |
212 | |
213 | apply_all_roles($class, MRole->meta, MRole2->meta); |
214 | |
215 | ok(Class->can('meth'), "can meth"); |
216 | ok(Class->can('meth2'), "can meth2"); |
217 | } |
218 | } |
219 | |
eea9eb4d |
220 | { |
221 | ok(!Moose::Util::find_meta('PlainJane'), 'not initialized'); |
222 | Moose::Util::apply_all_roles('PlainJane', 'BarRole'); |
223 | ok(Moose::Util::find_meta('PlainJane'), 'initialized'); |
224 | ok(Moose::Util::find_meta('PlainJane')->does_role('BarRole'), 'does BarRole'); |
225 | my $pj = PlainJane->new(); |
226 | ok($pj->can('woot'), 'can woot'); |
227 | } |
228 | |
a28e50e4 |
229 | done_testing; |