Commit | Line | Data |
78cd1d3b |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
d443cad0 |
6 | use Test::More tests => 87; |
78cd1d3b |
7 | use Test::Exception; |
d443cad0 |
8 | use Test::Output; |
78cd1d3b |
9 | |
78cd1d3b |
10 | { |
11 | package FooRole; |
78cd1d3b |
12 | use Moose::Role; |
0be0b30e |
13 | |
14 | has 'bar' => ( is => 'rw', isa => 'FooClass' ); |
15 | has 'baz' => ( is => 'ro' ); |
16 | |
17 | sub goo {'FooRole::goo'} |
18 | sub foo {'FooRole::foo'} |
19 | |
20 | override 'boo' => sub { 'FooRole::boo -> ' . super() }; |
21 | |
22 | around 'blau' => sub { |
0558683c |
23 | my $c = shift; |
24 | 'FooRole::blau -> ' . $c->(); |
0be0b30e |
25 | }; |
26 | } |
78cd1d3b |
27 | |
0be0b30e |
28 | { |
3f562dd9 |
29 | package BarRole; |
30 | use Moose::Role; |
0be0b30e |
31 | sub woot {'BarRole::woot'} |
32 | } |
33 | |
34 | { |
78cd1d3b |
35 | package BarClass; |
78cd1d3b |
36 | use Moose; |
8ecb1fa0 |
37 | |
0be0b30e |
38 | sub boo {'BarClass::boo'} |
39 | sub foo {'BarClass::foo'} # << the role overrides this ... |
0be0b30e |
40 | } |
41 | |
42 | { |
78cd1d3b |
43 | package FooClass; |
78cd1d3b |
44 | use Moose; |
0be0b30e |
45 | |
78cd1d3b |
46 | extends 'BarClass'; |
d443cad0 |
47 | |
48 | ::stderr_like { |
49 | with 'FooRole'; |
50 | } qr/The FooClass class has implicitly overridden the method \(goo\) from role FooRole\. If this is intentional, please exclude the method from composition to silence this warning \(see Moose::Cookbook::Roles::Recipe2\)/; |
0be0b30e |
51 | |
52 | sub blau {'FooClass::blau'} # << the role wraps this ... |
53 | |
54 | sub goo {'FooClass::goo'} # << overrides the one from the role ... |
0be0b30e |
55 | } |
56 | |
57 | { |
3f562dd9 |
58 | package FooBarClass; |
59 | use Moose; |
0be0b30e |
60 | |
3f562dd9 |
61 | extends 'FooClass'; |
0be0b30e |
62 | with 'FooRole', 'BarRole'; |
78cd1d3b |
63 | } |
64 | |
65 | my $foo_class_meta = FooClass->meta; |
0be0b30e |
66 | isa_ok( $foo_class_meta, 'Moose::Meta::Class' ); |
78cd1d3b |
67 | |
3f562dd9 |
68 | my $foobar_class_meta = FooBarClass->meta; |
0be0b30e |
69 | isa_ok( $foobar_class_meta, 'Moose::Meta::Class' ); |
3f562dd9 |
70 | |
bbd2fe69 |
71 | dies_ok { |
0be0b30e |
72 | $foo_class_meta->does_role(); |
73 | } |
74 | '... does_role requires a role name'; |
bbd2fe69 |
75 | |
76 | dies_ok { |
e016145b |
77 | $foo_class_meta->add_role(); |
0be0b30e |
78 | } |
79 | '... apply_role requires a role'; |
bbd2fe69 |
80 | |
81 | dies_ok { |
e016145b |
82 | $foo_class_meta->add_role( bless( {} => 'Fail' ) ); |
0be0b30e |
83 | } |
84 | '... apply_role requires a role'; |
bbd2fe69 |
85 | |
0be0b30e |
86 | ok( $foo_class_meta->does_role('FooRole'), |
87 | '... the FooClass->meta does_role FooRole' ); |
88 | ok( !$foo_class_meta->does_role('OtherRole'), |
89 | '... the FooClass->meta !does_role OtherRole' ); |
ef333f17 |
90 | |
0be0b30e |
91 | ok( $foobar_class_meta->does_role('FooRole'), |
92 | '... the FooBarClass->meta does_role FooRole' ); |
93 | ok( $foobar_class_meta->does_role('BarRole'), |
94 | '... the FooBarClass->meta does_role BarRole' ); |
95 | ok( !$foobar_class_meta->does_role('OtherRole'), |
96 | '... the FooBarClass->meta !does_role OtherRole' ); |
3f562dd9 |
97 | |
0558683c |
98 | foreach my $method_name (qw(bar baz foo boo blau goo)) { |
0be0b30e |
99 | ok( $foo_class_meta->has_method($method_name), |
100 | '... FooClass has the method ' . $method_name ); |
101 | ok( $foobar_class_meta->has_method($method_name), |
102 | '... FooBarClass has the method ' . $method_name ); |
78cd1d3b |
103 | } |
104 | |
0be0b30e |
105 | ok( !$foo_class_meta->has_method('woot'), |
106 | '... FooClass lacks the method woot' ); |
107 | ok( $foobar_class_meta->has_method('woot'), |
108 | '... FooBarClass has the method woot' ); |
3f562dd9 |
109 | |
78cd1d3b |
110 | foreach my $attr_name (qw(bar baz)) { |
0be0b30e |
111 | ok( $foo_class_meta->has_attribute($attr_name), |
112 | '... FooClass has the attribute ' . $attr_name ); |
113 | ok( $foobar_class_meta->has_attribute($attr_name), |
114 | '... FooBarClass has the attribute ' . $attr_name ); |
78cd1d3b |
115 | } |
116 | |
0be0b30e |
117 | can_ok( 'FooClass', 'does' ); |
118 | ok( FooClass->does('FooRole'), '... the FooClass does FooRole' ); |
119 | ok( !FooClass->does('BarRole'), '... the FooClass does not do BarRole' ); |
120 | ok( !FooClass->does('OtherRole'), '... the FooClass does not do OtherRole' ); |
ef333f17 |
121 | |
0be0b30e |
122 | can_ok( 'FooBarClass', 'does' ); |
123 | ok( FooBarClass->does('FooRole'), '... the FooClass does FooRole' ); |
124 | ok( FooBarClass->does('BarRole'), '... the FooBarClass does FooBarRole' ); |
125 | ok( !FooBarClass->does('OtherRole'), |
126 | '... the FooBarClass does not do OtherRole' ); |
3f562dd9 |
127 | |
78cd1d3b |
128 | my $foo = FooClass->new(); |
0be0b30e |
129 | isa_ok( $foo, 'FooClass' ); |
78cd1d3b |
130 | |
3f562dd9 |
131 | my $foobar = FooBarClass->new(); |
0be0b30e |
132 | isa_ok( $foobar, 'FooBarClass' ); |
133 | |
134 | is( $foo->goo, 'FooClass::goo', '... got the right value of goo' ); |
135 | is( $foobar->goo, 'FooRole::goo', '... got the right value of goo' ); |
136 | |
137 | is( $foo->boo, 'FooRole::boo -> BarClass::boo', |
138 | '... got the right value from ->boo' ); |
139 | is( $foobar->boo, 'FooRole::boo -> FooRole::boo -> BarClass::boo', |
140 | '... got the right value from ->boo (double wrapped)' ); |
141 | |
142 | is( $foo->blau, 'FooRole::blau -> FooClass::blau', |
143 | '... got the right value from ->blau' ); |
144 | is( $foobar->blau, 'FooRole::blau -> FooRole::blau -> FooClass::blau', |
145 | '... got the right value from ->blau' ); |
146 | |
147 | foreach my $foo ( $foo, $foobar ) { |
148 | can_ok( $foo, 'does' ); |
149 | ok( $foo->does('FooRole'), '... an instance of FooClass does FooRole' ); |
150 | ok( !$foo->does('OtherRole'), |
151 | '... and instance of FooClass does not do OtherRole' ); |
152 | |
153 | can_ok( $foobar, 'does' ); |
154 | ok( $foobar->does('FooRole'), |
155 | '... an instance of FooBarClass does FooRole' ); |
156 | ok( $foobar->does('BarRole'), |
157 | '... an instance of FooBarClass does BarRole' ); |
158 | ok( !$foobar->does('OtherRole'), |
159 | '... and instance of FooBarClass does not do OtherRole' ); |
78cd1d3b |
160 | |
fb1e11d5 |
161 | for my $method (qw/bar baz foo boo goo blau/) { |
0be0b30e |
162 | can_ok( $foo, $method ); |
fb1e11d5 |
163 | } |
78cd1d3b |
164 | |
0be0b30e |
165 | is( $foo->foo, 'FooRole::foo', '... got the right value of foo' ); |
78cd1d3b |
166 | |
0be0b30e |
167 | ok( !defined( $foo->baz ), '... $foo->baz is undefined' ); |
168 | ok( !defined( $foo->bar ), '... $foo->bar is undefined' ); |
78cd1d3b |
169 | |
fb1e11d5 |
170 | dies_ok { |
0be0b30e |
171 | $foo->baz(1); |
172 | } |
173 | '... baz is a read-only accessor'; |
78cd1d3b |
174 | |
fb1e11d5 |
175 | dies_ok { |
0be0b30e |
176 | $foo->bar(1); |
177 | } |
178 | '... bar is a read-write accessor with a type constraint'; |
78cd1d3b |
179 | |
fb1e11d5 |
180 | my $foo2 = FooClass->new(); |
0be0b30e |
181 | isa_ok( $foo2, 'FooClass' ); |
06b30515 |
182 | |
fb1e11d5 |
183 | lives_ok { |
0be0b30e |
184 | $foo->bar($foo2); |
185 | } |
186 | '... 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 | } |