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->();
29 sub woot { 'BarRole::woot' }
35 sub boo { 'BarClass::boo' }
36 sub foo { 'BarClass::foo' } # << the role overrides this ...
38 __PACKAGE__->meta->make_immutable(debug => 0);
47 sub blau { 'FooClass::blau' } # << the role wraps this ...
49 sub goo { 'FooClass::goo' } # << overrides the one from the role ...
51 __PACKAGE__->meta->make_immutable(debug => 0);
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()
69 } '... does_role requires a role name';
72 $foo_class_meta->apply_role()
73 } '... apply_role requires a role';
76 $foo_class_meta->apply_role(bless({} => 'Fail'))
77 } '... apply_role requires a role';
79 ok($foo_class_meta->does_role('FooRole'), '... the FooClass->meta does_role FooRole');
80 ok(!$foo_class_meta->does_role('OtherRole'), '... the FooClass->meta !does_role OtherRole');
82 ok($foobar_class_meta->does_role('FooRole'), '... the FooBarClass->meta does_role FooRole');
83 ok($foobar_class_meta->does_role('BarRole'), '... the FooBarClass->meta does_role BarRole');
84 ok(!$foobar_class_meta->does_role('OtherRole'), '... the FooBarClass->meta !does_role OtherRole');
86 foreach my $method_name (qw(bar baz foo boo blau goo)) {
87 ok($foo_class_meta->has_method($method_name), '... FooClass has the method ' . $method_name);
88 ok($foobar_class_meta->has_method($method_name), '... FooBarClass has the method ' . $method_name);
91 ok(!$foo_class_meta->has_method('woot'), '... FooClass lacks the method woot');
92 ok($foobar_class_meta->has_method('woot'), '... FooBarClass has the method woot');
94 foreach my $attr_name (qw(bar baz)) {
95 ok($foo_class_meta->has_attribute($attr_name), '... FooClass has the attribute ' . $attr_name);
96 ok($foobar_class_meta->has_attribute($attr_name), '... FooBarClass has the attribute ' . $attr_name);
99 can_ok('FooClass', 'does');
100 ok(FooClass->does('FooRole'), '... the FooClass does FooRole');
101 ok(!FooClass->does('BarRole'), '... the FooClass does not do BarRole');
102 ok(!FooClass->does('OtherRole'), '... the FooClass does not do OtherRole');
104 can_ok('FooBarClass', 'does');
105 ok(FooBarClass->does('FooRole'), '... the FooClass does FooRole');
106 ok(FooBarClass->does('BarRole'), '... the FooBarClass does FooBarRole');
107 ok(!FooBarClass->does('OtherRole'), '... the FooBarClass does not do OtherRole');
109 my $foo = FooClass->new();
110 isa_ok($foo, 'FooClass');
112 my $foobar = FooBarClass->new();
113 isa_ok($foobar, 'FooBarClass');
115 is($foo->goo, 'FooClass::goo', '... got the right value of goo');
116 is($foobar->goo, 'FooRole::goo', '... got the right value of goo');
118 is($foo->boo, 'FooRole::boo -> BarClass::boo', '... got the right value from ->boo');
119 is($foobar->boo, 'FooRole::boo -> FooRole::boo -> BarClass::boo', '... got the right value from ->boo (double wrapped)');
121 is($foo->blau, 'FooRole::blau -> FooClass::blau', '... got the right value from ->blau');
122 is($foobar->blau, 'FooRole::blau -> FooRole::blau -> FooClass::blau', '... got the right value from ->blau');
124 foreach my $foo ($foo, $foobar) {
125 can_ok($foo, 'does');
126 ok($foo->does('FooRole'), '... an instance of FooClass does FooRole');
127 ok(!$foo->does('OtherRole'), '... and instance of FooClass does not do OtherRole');
129 can_ok($foobar, 'does');
130 ok($foobar->does('FooRole'), '... an instance of FooBarClass does FooRole');
131 ok($foobar->does('BarRole'), '... an instance of FooBarClass does BarRole');
132 ok(!$foobar->does('OtherRole'), '... and instance of FooBarClass does not do OtherRole');
134 for my $method (qw/bar baz foo boo goo blau/) {
135 can_ok($foo, $method);
138 is($foo->foo, 'FooRole::foo', '... got the right value of foo');
140 ok(!defined($foo->baz), '... $foo->baz is undefined');
141 ok(!defined($foo->bar), '... $foo->bar is undefined');
145 } '... baz is a read-only accessor';
149 } '... bar is a read-write accessor with a type constraint';
151 my $foo2 = FooClass->new();
152 isa_ok($foo2, 'FooClass');
156 } '... bar is a read-write accessor with a type constraint';
158 is($foo->bar, $foo2, '... got the right value for bar now');