8 "This test requires Class::Method::Modifiers or Class::Method::Modifiers::Fast"
10 require Class::Method::Modifiers::Fast;
12 require Class::Method::Modifiers;
23 has 'bar' => ( is => 'rw', isa => 'FooClass' );
24 has 'baz' => ( is => 'ro' );
26 sub goo {'FooRole::goo'}
27 sub foo {'FooRole::foo'}
29 override 'boo' => sub { 'FooRole::boo -> ' . super() };
30 # sub boo { 'FooRole::boo -> ' . shift->SUPER::boo() }
32 around 'blau' => sub {
34 'FooRole::blau -> ' . $c->();
41 sub woot {'BarRole::woot'}
48 sub boo {'BarClass::boo'}
49 sub foo {'BarClass::foo'} # << the role overrides this ...
59 sub blau {'FooClass::blau'} # << the role wraps this ...
61 sub goo {'FooClass::goo'} # << overrides the one from the role ...
69 with 'FooRole', 'BarRole';
72 my $foo_class_meta = FooClass->meta;
73 isa_ok( $foo_class_meta, 'Mouse::Meta::Class' );
75 my $foobar_class_meta = FooBarClass->meta;
76 isa_ok( $foobar_class_meta, 'Mouse::Meta::Class' );
79 $foo_class_meta->does_role();
81 '... does_role requires a role name';
84 $foo_class_meta->add_role();
86 '... apply_role requires a role';
89 $foo_class_meta->add_role( bless( {} => 'Fail' ) );
91 '... apply_role requires a role';
93 ok( $foo_class_meta->does_role('FooRole'),
94 '... the FooClass->meta does_role FooRole' );
95 ok( !$foo_class_meta->does_role('OtherRole'),
96 '... the FooClass->meta !does_role OtherRole' );
98 ok( $foobar_class_meta->does_role('FooRole'),
99 '... the FooBarClass->meta does_role FooRole' );
100 ok( $foobar_class_meta->does_role('BarRole'),
101 '... the FooBarClass->meta does_role BarRole' );
102 ok( !$foobar_class_meta->does_role('OtherRole'),
103 '... the FooBarClass->meta !does_role OtherRole' );
105 foreach my $method_name (qw(bar baz foo boo blau goo)) {
106 # ok( $foo_class_meta->has_method($method_name), ## Mouse: no ->has_method
107 ok( FooClass->can($method_name),
108 '... FooClass has the method ' . $method_name );
109 # ok( $foobar_class_meta->has_method($method_name), ## Mouse: no ->has_method
110 ok( FooClass->can($method_name),
111 '... FooBarClass has the method ' . $method_name );
114 #ok( !$foo_class_meta->has_method('woot'), ## Mouse: no ->has_method
115 ok( !FooClass->can('woot'),
116 '... FooClass lacks the method woot' );
117 #ok( $foobar_class_meta->has_method('woot'), ## Mouse: no ->has_method
118 ok( FooBarClass->can('woot'),
119 '... FooBarClass has the method woot' );
121 foreach my $attr_name (qw(bar baz)) {
122 ok( $foo_class_meta->has_attribute($attr_name),
123 '... FooClass has the attribute ' . $attr_name );
124 ok( $foobar_class_meta->has_attribute($attr_name),
125 '... FooBarClass has the attribute ' . $attr_name );
128 can_ok( 'FooClass', 'does' );
129 ok( FooClass->does('FooRole'), '... the FooClass does FooRole' );
130 ok( !FooClass->does('BarRole'), '... the FooClass does not do BarRole' );
131 ok( !FooClass->does('OtherRole'), '... the FooClass does not do OtherRole' );
133 can_ok( 'FooBarClass', 'does' );
134 ok( FooBarClass->does('FooRole'), '... the FooClass does FooRole' );
135 ok( FooBarClass->does('BarRole'), '... the FooBarClass does FooBarRole' );
136 ok( !FooBarClass->does('OtherRole'),
137 '... the FooBarClass does not do OtherRole' );
139 my $foo = FooClass->new();
140 isa_ok( $foo, 'FooClass' );
142 my $foobar = FooBarClass->new();
143 isa_ok( $foobar, 'FooBarClass' );
145 is( $foo->goo, 'FooClass::goo', '... got the right value of goo' );
146 is( $foobar->goo, 'FooRole::goo', '... got the right value of goo' );
148 is( $foo->boo, 'FooRole::boo -> BarClass::boo',
149 '... got the right value from ->boo' );
150 is( $foobar->boo, 'FooRole::boo -> FooRole::boo -> BarClass::boo',
151 '... got the right value from ->boo (double wrapped)' );
153 is( $foo->blau, 'FooRole::blau -> FooClass::blau',
154 '... got the right value from ->blau' );
155 is( $foobar->blau, 'FooRole::blau -> FooRole::blau -> FooClass::blau',
156 '... got the right value from ->blau' );
158 foreach my $foo ( $foo, $foobar ) {
159 can_ok( $foo, 'does' );
160 ok( $foo->does('FooRole'), '... an instance of FooClass does FooRole' );
161 ok( !$foo->does('OtherRole'),
162 '... and instance of FooClass does not do OtherRole' );
164 can_ok( $foobar, 'does' );
165 ok( $foobar->does('FooRole'),
166 '... an instance of FooBarClass does FooRole' );
167 ok( $foobar->does('BarRole'),
168 '... an instance of FooBarClass does BarRole' );
169 ok( !$foobar->does('OtherRole'),
170 '... and instance of FooBarClass does not do OtherRole' );
172 for my $method (qw/bar baz foo boo goo blau/) {
173 can_ok( $foo, $method );
176 is( $foo->foo, 'FooRole::foo', '... got the right value of foo' );
178 ok( !defined( $foo->baz ), '... $foo->baz is undefined' );
179 ok( !defined( $foo->bar ), '... $foo->bar is undefined' );
184 '... baz is a read-only accessor';
189 '... bar is a read-write accessor with a type constraint';
191 my $foo2 = FooClass->new();
192 isa_ok( $foo2, 'FooClass' );
197 '... bar is a read-write accessor with a type constraint';
199 is( $foo->bar, $foo2, '... got the right value for bar now' );