15 has 'bar' => ( is => 'rw', isa => 'FooClass' );
16 has 'baz' => ( is => 'ro' );
18 sub goo {'FooRole::goo'}
19 sub foo {'FooRole::foo'}
21 override 'boo' => sub { 'FooRole::boo -> ' . super() };
23 around 'blau' => sub {
25 'FooRole::blau -> ' . $c->();
32 sub woot {'BarRole::woot'}
39 sub boo {'BarClass::boo'}
40 sub foo {'BarClass::foo'} # << the role overrides this ...
49 ::like( ::exception { with 'FooRole' => { -version => 42 } }, qr/FooRole version 42 required--this is only version 23/, 'applying role with unsatisfied version requirement' );
51 ::is( ::exception { with 'FooRole' => { -version => 13 } }, undef, 'applying role with satisfied version requirement' );
53 sub blau {'FooClass::blau'} # << the role wraps this ...
55 sub goo {'FooClass::goo'} # << overrides the one from the role ...
63 with 'FooRole', 'BarRole';
68 sub new { return bless {}, __PACKAGE__; }
71 my $foo_class_meta = FooClass->meta;
72 isa_ok( $foo_class_meta, 'Moose::Meta::Class' );
74 my $foobar_class_meta = FooBarClass->meta;
75 isa_ok( $foobar_class_meta, 'Moose::Meta::Class' );
78 $foo_class_meta->does_role();
79 }, undef, '... does_role requires a role name' );
82 $foo_class_meta->add_role();
83 }, undef, '... apply_role requires a role' );
86 $foo_class_meta->add_role( bless( {} => 'Fail' ) );
87 }, undef, '... apply_role requires a role' );
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' );
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' );
101 foreach my $method_name (qw(bar baz foo boo blau goo)) {
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 );
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' );
113 foreach my $attr_name (qw(bar baz)) {
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 );
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' );
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' );
131 my $foo = FooClass->new();
132 isa_ok( $foo, 'FooClass' );
134 my $foobar = FooBarClass->new();
135 isa_ok( $foobar, 'FooBarClass' );
137 is( $foo->goo, 'FooClass::goo', '... got the right value of goo' );
138 is( $foobar->goo, 'FooRole::goo', '... got the right value of goo' );
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)' );
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' );
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' );
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' );
164 for my $method (qw/bar baz foo boo goo blau/) {
165 can_ok( $foo, $method );
168 is( $foo->foo, 'FooRole::foo', '... got the right value of foo' );
170 ok( !defined( $foo->baz ), '... $foo->baz is undefined' );
171 ok( !defined( $foo->bar ), '... $foo->bar is undefined' );
175 }, undef, '... baz is a read-only accessor' );
179 }, undef, '... bar is a read-write accessor with a type constraint' );
181 my $foo2 = FooClass->new();
182 isa_ok( $foo2, 'FooClass' );
186 }, undef, '... bar is a read-write accessor with a type constraint' );
188 is( $foo->bar, $foo2, '... got the right value for bar now' );
205 use Moose::Meta::Class;
207 use Moose::Util qw(apply_all_roles);
209 my $class = Moose::Meta::Class->create( 'Class' => (
210 superclasses => [ 'Moose::Object' ],
213 apply_all_roles($class, MRole->meta, MRole2->meta);
215 ok(Class->can('meth'), "can meth");
216 ok(Class->can('meth2'), "can meth2");
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');