6 use Test::More tests => 86;
13 has 'bar' => ( is => 'rw', isa => 'FooClass' );
14 has 'baz' => ( is => 'ro' );
16 sub goo {'FooRole::goo'}
17 sub foo {'FooRole::foo'}
19 override 'boo' => sub { 'FooRole::boo -> ' . super() };
21 around 'blau' => sub {
23 'FooRole::blau -> ' . $c->();
30 sub woot {'BarRole::woot'}
37 sub boo {'BarClass::boo'}
38 sub foo {'BarClass::foo'} # << the role overrides this ...
48 sub blau {'FooClass::blau'} # << the role wraps this ...
50 sub goo {'FooClass::goo'} # << overrides the one from the role ...
58 with 'FooRole', 'BarRole';
61 my $foo_class_meta = FooClass->meta;
62 isa_ok( $foo_class_meta, 'Moose::Meta::Class' );
64 my $foobar_class_meta = FooBarClass->meta;
65 isa_ok( $foobar_class_meta, 'Moose::Meta::Class' );
68 $foo_class_meta->does_role();
70 '... does_role requires a role name';
73 $foo_class_meta->add_role();
75 '... apply_role requires a role';
78 $foo_class_meta->add_role( bless( {} => 'Fail' ) );
80 '... apply_role requires a role';
82 ok( $foo_class_meta->does_role('FooRole'),
83 '... the FooClass->meta does_role FooRole' );
84 ok( !$foo_class_meta->does_role('OtherRole'),
85 '... the FooClass->meta !does_role OtherRole' );
87 ok( $foobar_class_meta->does_role('FooRole'),
88 '... the FooBarClass->meta does_role FooRole' );
89 ok( $foobar_class_meta->does_role('BarRole'),
90 '... the FooBarClass->meta does_role BarRole' );
91 ok( !$foobar_class_meta->does_role('OtherRole'),
92 '... the FooBarClass->meta !does_role OtherRole' );
94 foreach my $method_name (qw(bar baz foo boo blau goo)) {
95 ok( $foo_class_meta->has_method($method_name),
96 '... FooClass has the method ' . $method_name );
97 ok( $foobar_class_meta->has_method($method_name),
98 '... FooBarClass has the method ' . $method_name );
101 ok( !$foo_class_meta->has_method('woot'),
102 '... FooClass lacks the method woot' );
103 ok( $foobar_class_meta->has_method('woot'),
104 '... FooBarClass has the method woot' );
106 foreach my $attr_name (qw(bar baz)) {
107 ok( $foo_class_meta->has_attribute($attr_name),
108 '... FooClass has the attribute ' . $attr_name );
109 ok( $foobar_class_meta->has_attribute($attr_name),
110 '... FooBarClass has the attribute ' . $attr_name );
113 can_ok( 'FooClass', 'does' );
114 ok( FooClass->does('FooRole'), '... the FooClass does FooRole' );
115 ok( !FooClass->does('BarRole'), '... the FooClass does not do BarRole' );
116 ok( !FooClass->does('OtherRole'), '... the FooClass does not do OtherRole' );
118 can_ok( 'FooBarClass', 'does' );
119 ok( FooBarClass->does('FooRole'), '... the FooClass does FooRole' );
120 ok( FooBarClass->does('BarRole'), '... the FooBarClass does FooBarRole' );
121 ok( !FooBarClass->does('OtherRole'),
122 '... the FooBarClass does not do OtherRole' );
124 my $foo = FooClass->new();
125 isa_ok( $foo, 'FooClass' );
127 my $foobar = FooBarClass->new();
128 isa_ok( $foobar, 'FooBarClass' );
130 is( $foo->goo, 'FooClass::goo', '... got the right value of goo' );
131 is( $foobar->goo, 'FooRole::goo', '... got the right value of goo' );
133 is( $foo->boo, 'FooRole::boo -> BarClass::boo',
134 '... got the right value from ->boo' );
135 is( $foobar->boo, 'FooRole::boo -> FooRole::boo -> BarClass::boo',
136 '... got the right value from ->boo (double wrapped)' );
138 is( $foo->blau, 'FooRole::blau -> FooClass::blau',
139 '... got the right value from ->blau' );
140 is( $foobar->blau, 'FooRole::blau -> FooRole::blau -> FooClass::blau',
141 '... got the right value from ->blau' );
143 foreach my $foo ( $foo, $foobar ) {
144 can_ok( $foo, 'does' );
145 ok( $foo->does('FooRole'), '... an instance of FooClass does FooRole' );
146 ok( !$foo->does('OtherRole'),
147 '... and instance of FooClass does not do OtherRole' );
149 can_ok( $foobar, 'does' );
150 ok( $foobar->does('FooRole'),
151 '... an instance of FooBarClass does FooRole' );
152 ok( $foobar->does('BarRole'),
153 '... an instance of FooBarClass does BarRole' );
154 ok( !$foobar->does('OtherRole'),
155 '... and instance of FooBarClass does not do OtherRole' );
157 for my $method (qw/bar baz foo boo goo blau/) {
158 can_ok( $foo, $method );
161 is( $foo->foo, 'FooRole::foo', '... got the right value of foo' );
163 ok( !defined( $foo->baz ), '... $foo->baz is undefined' );
164 ok( !defined( $foo->bar ), '... $foo->bar is undefined' );
169 '... baz is a read-only accessor';
174 '... bar is a read-write accessor with a type constraint';
176 my $foo2 = FooClass->new();
177 isa_ok( $foo2, 'FooClass' );
182 '... bar is a read-write accessor with a type constraint';
184 is( $foo->bar, $foo2, '... got the right value for bar now' );