use strict;
use warnings;
-use Test::More tests => 88; # it's really 124 with kolibrie's tests;
+use Test::More tests => 88;
use Test::Exception;
=pod
use Mouse::Role;
requires 'foo';
-
+
sub bar { 'Role::Foo::bar' }
-
+
package Role::Bar;
use Mouse::Role;
-
+
requires 'bar';
-
- sub foo { 'Role::Bar::foo' }
+
+ sub foo { 'Role::Bar::foo' }
}
{
package My::Test1;
use Mouse;
-
+
::lives_ok {
with 'Role::Foo', 'Role::Bar';
} '... our mutually recursive roles combine okay';
-
+
package My::Test2;
use Mouse;
-
+
::lives_ok {
with 'Role::Bar', 'Role::Foo';
- } '... our mutually recursive roles combine okay (no matter what order)';
+ } '... our mutually recursive roles combine okay (no matter what order)';
}
my $test1 = My::Test1->new;
# check some meta-stuff
-TODO: { todo_skip "Mouse: not yet implemented" => 4;
ok(Role::Foo->meta->has_method('bar'), '... it still has the bar method');
ok(Role::Foo->meta->requires_method('foo'), '... it still has the required foo method');
ok(Role::Bar->meta->has_method('foo'), '... it still has the foo method');
ok(Role::Bar->meta->requires_method('bar'), '... it still has the required bar method');
-}
=pod
{
package Role::Bling;
use Mouse::Role;
-
+
sub bling { 'Role::Bling::bling' }
-
+
package Role::Bling::Bling;
use Mouse::Role;
-
- sub bling { 'Role::Bling::Bling::bling' }
+
+ sub bling { 'Role::Bling::Bling::bling' }
}
{
package My::Test3;
use Mouse;
-
+
::throws_ok {
with 'Role::Bling', 'Role::Bling::Bling';
- } qr/requires the method \'bling\' to be implemented/, '... role methods conflicted and method was required';
-
+ } qr/Due to a method name conflict in roles 'Role::Bling' and 'Role::Bling::Bling', the method 'bling' must be implemented or excluded by 'My::Test3'/, '... role methods conflict and method was required';
+
package My::Test4;
use Mouse;
-
+
::lives_ok {
with 'Role::Bling';
with 'Role::Bling::Bling';
- } '... role methods didnt conflict when manually combined';
-
+ } '... role methods didnt conflict when manually combined';
+
package My::Test5;
use Mouse;
-
+
::lives_ok {
with 'Role::Bling::Bling';
with 'Role::Bling';
- } '... role methods didnt conflict when manually combined (in opposite order)';
-
+ } '... role methods didnt conflict when manually combined (in opposite order)';
+
package My::Test6;
use Mouse;
-
+
::lives_ok {
with 'Role::Bling::Bling', 'Role::Bling';
- } '... role methods didnt conflict when manually resolved';
-
+ } '... role methods didnt conflict when manually resolved';
+
sub bling { 'My::Test6::bling' }
}
-TODO: { todo_skip "Mouse: not yet implemented" => 4;
ok(!My::Test3->meta->has_method('bling'), '... we didnt get any methods in the conflict');
ok(My::Test4->meta->has_method('bling'), '... we did get the method when manually dealt with');
ok(My::Test5->meta->has_method('bling'), '... we did get the method when manually dealt with');
ok(My::Test6->meta->has_method('bling'), '... we did get the method when manually dealt with');
-}
ok(!My::Test3->does('Role::Bling'), '... our class does() the correct roles');
ok(!My::Test3->does('Role::Bling::Bling'), '... our class does() the correct roles');
{
package Role::Bling::Bling::Bling;
use Mouse::Role;
-
+
with 'Role::Bling::Bling';
-
- sub bling { 'Role::Bling::Bling::Bling::bling' }
+
+ sub bling { 'Role::Bling::Bling::Bling::bling' }
}
-TODO: { todo_skip "Mouse: not yet implemented" => 1;
ok(Role::Bling::Bling->meta->has_method('bling'), '... still got the bling method in Role::Bling::Bling');
- }
ok(Role::Bling::Bling->meta->does_role('Role::Bling::Bling'), '... our role correctly does() the other role');
-TODO: { todo_skip "Mouse: not yet implemented" => 2;
ok(Role::Bling::Bling::Bling->meta->has_method('bling'), '... dont have the bling method in Role::Bling::Bling::Bling');
-is(Role::Bling::Bling::Bling->meta->get_method('bling')->(),
+is(Role::Bling::Bling::Bling->meta->get_method('bling')->(),
'Role::Bling::Bling::Bling::bling',
'... still got the bling method in Role::Bling::Bling::Bling');
-}
+
=pod
{
package Role::Boo;
use Mouse::Role;
-
+
has 'ghost' => (is => 'ro', default => 'Role::Boo::ghost');
-
+
package Role::Boo::Hoo;
use Mouse::Role;
-
+
has 'ghost' => (is => 'ro', default => 'Role::Boo::Hoo::ghost');
}
{
package My::Test7;
use Mouse;
-
+
::throws_ok {
with 'Role::Boo', 'Role::Boo::Hoo';
- } qr/We have encountered an attribute conflict/,
- '... role attrs conflicted and method was required';
+ } qr/We have encountered an attribute conflict/,
+ '... role attrs conflict and method was required';
package My::Test8;
use Mouse;
with 'Role::Boo';
with 'Role::Boo::Hoo';
} '... role attrs didnt conflict when manually combined';
-
+
package My::Test9;
use Mouse;
::lives_ok {
with 'Role::Boo::Hoo';
with 'Role::Boo';
- } '... role attrs didnt conflict when manually combined';
+ } '... role attrs didnt conflict when manually combined';
package My::Test10;
use Mouse;
-
- has 'ghost' => (is => 'ro', default => 'My::Test10::ghost');
-
+
+ has 'ghost' => (is => 'ro', default => 'My::Test10::ghost');
+
::throws_ok {
with 'Role::Boo', 'Role::Boo::Hoo';
- } qr/We have encountered an attribute conflict/,
- '... role attrs conflicted and cannot be manually disambiguted';
+ } qr/We have encountered an attribute conflict/,
+ '... role attrs conflict and cannot be manually disambiguted';
}
{
package Role::Plot;
use Mouse::Role;
-
+
override 'twist' => sub {
super() . ' -> Role::Plot::twist';
};
-
+
package Role::Truth;
use Mouse::Role;
-
+
override 'twist' => sub {
super() . ' -> Role::Truth::twist';
};
{
package My::Test::Base;
use Mouse;
-
+
sub twist { 'My::Test::Base::twist' }
-
+
package My::Test11;
use Mouse;
-
+
extends 'My::Test::Base';
::lives_ok {
with 'Role::Truth';
} '... composed the role with override okay';
-
+
package My::Test12;
use Mouse;
extends 'My::Test::Base';
- ::lives_ok {
+ ::lives_ok {
with 'Role::Plot';
} '... composed the role with override okay';
-
+
package My::Test13;
use Mouse;
::dies_ok {
- with 'Role::Plot';
+ with 'Role::Plot';
} '... cannot compose it because we have no superclass';
-
+
package My::Test14;
use Mouse;
extends 'My::Test::Base';
::throws_ok {
- with 'Role::Plot', 'Role::Truth';
- } qr/Two \'override\' methods of the same name encountered/,
- '... cannot compose it because we have no superclass';
+ with 'Role::Plot', 'Role::Truth';
+ } qr/Two \'override\' methods of the same name encountered/,
+ '... cannot compose it because we have no superclass';
}
ok(My::Test11->meta->has_method('twist'), '... the twist method has been added');
package Role::Reality;
use Mouse::Role;
- ::throws_ok {
+ ::throws_ok {
with 'Role::Plot';
- } qr/A local method of the same name as been found/,
+ } qr/A local method of the same name as been found/,
'... could not compose roles here, it dies';
sub twist {
'Role::Reality::twist';
}
-}
+}
ok(Role::Reality->meta->has_method('twist'), '... the twist method has not been added');
-ok(!Role::Reality->meta->does_role('Role::Plot'), '... our role does() the correct roles');
-is(Role::Reality->meta->get_method('twist')->(),
- 'Role::Reality::twist',
+#ok(!Role::Reality->meta->does_role('Role::Plot'), '... our role does() the correct roles');
+is(Role::Reality->meta->get_method('twist')->(),
+ 'Role::Reality::twist',
'... the twist method returns the right value');
+# Ovid's test case from rt.cpan.org #44
+{
+ package Role1;
+ use Mouse::Role;
+
+ sub foo {}
+}
+{
+ package Role2;
+ use Mouse::Role;
+
+ sub foo {}
+}
+{
+ package Conflicts;
+ use Mouse;
+
+ ::throws_ok {
+ with qw(Role1 Role2);
+ } qr/Due to a method name conflict in roles 'Role1' and 'Role2', the method 'foo' must be implemented or excluded by 'Conflicts'/;
+}
+
=pod
Role conflicts between attributes and methods
{
package Role::Method;
use Mouse::Role;
-
+
sub ghost { 'Role::Method::ghost' }
package Role::Method2;
use Mouse::Role;
-
+
sub ghost { 'Role::Method2::ghost' }
package Role::Attribute;
use Mouse::Role;
-
+
has 'ghost' => (is => 'ro', default => 'Role::Attribute::ghost');
package Role::Attribute2;
use Mouse::Role;
-
+
has 'ghost' => (is => 'ro', default => 'Role::Attribute2::ghost');
}
package My::Test15;
use Mouse;
- ::lives_ok {
+ ::lives_ok {
with 'Role::Method';
} '... composed the method role into the method class';
-{
+{
# test no conflicts here
package Role::A;
use Mouse::Role;
package Role::C;
use Mouse::Role;
-
+
::lives_ok {
with qw(Role::A Role::B); # no conflict here
} "define role C";
::lives_ok {
with qw(Role::C);
} "define class A";
-
+
sub zot { 'Class::A::zot' }
}
{
# check that when a role is added to another role
- # and they conflict and the method they conflicted
- # with is then required.
-
+ # and they conflict and the method they conflict
+ # with is then required.
+
package Role::A::Conflict;
use Mouse::Role;
-
+
with 'Role::A';
-
+
sub bar { 'Role::A::Conflict::bar' }
-
+
package Class::A::Conflict;
use Mouse;
-
+
::throws_ok {
with 'Role::A::Conflict';
- } qr/requires.*'bar'/, '... did not fufill the requirement of &bar method';
-
+ } qr/Due to a method name conflict in roles 'Role::A' and 'Role::A::Conflict', the method 'bar' must be implemented or excluded by 'Class::A::Conflict'/, '... did not fufill the requirement of &bar method';
+
package Class::A::Resolved;
use Mouse;
-
+
::lives_ok {
with 'Role::A::Conflict';
- } '... did fufill the requirement of &bar method';
-
+ } '... did fufill the requirement of &bar method';
+
sub bar { 'Class::A::Resolved::bar' }
}
{
# check that when two roles are composed, they conflict
# but the composing role can resolve that conflict
-
+
package Role::D;
use Mouse::Role;
sub foo { 'Role::D::foo' }
- sub bar { 'Role::D::bar' }
+ sub bar { 'Role::D::bar' }
package Role::E;
use Mouse::Role;
::lives_ok {
with qw(Role::D Role::E); # conflict between 'foo's here
} "define role Role::F";
-
+
sub foo { 'Role::F::foo' }
- sub zot { 'Role::F::zot' }
-
+ sub zot { 'Role::F::zot' }
+
package Class::B;
use Mouse;
-
+
::lives_ok {
with qw(Role::F);
} "define class Class::B";
-
+
sub zot { 'Class::B::zot' }
}
{
# check that a conflict can be resolved
- # by a role, but also new ones can be
+ # by a role, but also new ones can be
# created just as easily ...
-
+
package Role::D::And::E::Conflict;
use Mouse::Role;
::lives_ok {
with qw(Role::D Role::E); # conflict between 'foo's here
} "... define role Role::D::And::E::Conflict";
-
+
sub foo { 'Role::D::And::E::Conflict::foo' } # this overrides ...
-
- # but these conflict
- sub xxy { 'Role::D::And::E::Conflict::xxy' }
- sub bar { 'Role::D::And::E::Conflict::bar' }
+
+ # but these conflict
+ sub xxy { 'Role::D::And::E::Conflict::xxy' }
+ sub bar { 'Role::D::And::E::Conflict::bar' }
}
{
# conflict propagation
-
+
package Role::H;
use Mouse::Role;
sub foo { 'Role::H::foo' }
- sub bar { 'Role::H::bar' }
+ sub bar { 'Role::H::bar' }
package Role::J;
use Mouse::Role;
::lives_ok {
with qw(Role::J Role::H); # conflict between 'foo's here
} "define role Role::I";
-
+
sub zot { 'Role::I::zot' }
sub zzy { 'Role::I::zzy' }
package Class::C;
use Mouse;
-
+
::throws_ok {
with qw(Role::I);
- } qr/requires.*'foo'/, "defining class Class::C fails";
+ } qr/Due to a method name conflict in roles 'Role::H' and 'Role::J', the method 'foo' must be implemented or excluded by 'Class::C'/, "defining class Class::C fails";
sub zot { 'Class::C::zot' }
::lives_ok {
with qw(Role::I);
- } "resolved with method";
+ } "resolved with method";
sub foo { 'Class::E::foo' }
- sub zot { 'Class::E::zot' }
+ sub zot { 'Class::E::zot' }
}
can_ok( Class::E->new, qw(foo bar xxy zot) );
{
package Foo::Role;
use Mouse::Role;
-
+
sub foo { 'Foo::Role::foo' }
-
+
package Bar::Role;
use Mouse::Role;
-
- sub foo { 'Bar::Role::foo' }
+
+ sub foo { 'Bar::Role::foo' }
package Baz::Role;
use Mouse::Role;
-
- sub foo { 'Baz::Role::foo' }
-
+
+ sub foo { 'Baz::Role::foo' }
+
package My::Foo::Class;
use Mouse;
-
+
::lives_ok {
with 'Foo::Role' => { excludes => 'foo' },
- 'Bar::Role' => { excludes => 'foo' },
+ 'Bar::Role' => { excludes => 'foo' },
'Baz::Role';
} '... composed our roles correctly';
-
+
package My::Foo::Class::Broken;
use Mouse;
-
+
::throws_ok {
with 'Foo::Role',
- 'Bar::Role' => { excludes => 'foo' },
+ 'Bar::Role' => { excludes => 'foo' },
'Baz::Role';
- } qr/\'Foo::Role\|Bar::Role\|Baz::Role\' requires the method \'foo\' to be implemented by \'My::Foo::Class::Broken\'/,
- '... composed our roles correctly';
+ } qr/Due to a method name conflict in roles 'Baz::Role' and 'Foo::Role', the method 'foo' must be implemented or excluded by 'My::Foo::Class::Broken'/,
+ '... composed our roles correctly';
}
{
::lives_ok {
with 'Foo::Role' => { excludes => 'foo' },
- 'Bar::Role' => { excludes => 'foo' },
+ 'Bar::Role' => { excludes => 'foo' },
'Baz::Role';
} '... composed our roles correctly';
}
::lives_ok {
with 'Foo::Role',
- 'Bar::Role' => { excludes => 'foo' },
+ 'Bar::Role' => { excludes => 'foo' },
'Baz::Role';
} '... composed our roles correctly';
}
sub foo { 'Foo::foo' }
sub bar { 'Foo::bar' }
sub baz { 'Foo::baz' }
-
+
requires 'role_bar';
package My::Class;
::lives_ok {
with 'My::Role' => { alias => { bar => 'role_bar' } };
} '... this succeeds';
-
+
package My::Class::Failure;
use Mouse;
::throws_ok {
with 'My::Role' => { alias => { bar => 'role_bar' } };
- } qr/Cannot create a method alias if a local method of the same name exists/, '... this succeeds';
-
+ } qr/Cannot create a method alias if a local method of the same name exists/, '... this succeeds';
+
sub role_bar { 'FAIL' }
}
} '... this succeeds';
sub bar { 'My::OtherRole::bar' }
-
+
package My::OtherRole::Failure;
use Mouse::Role;
::throws_ok {
with 'My::Role' => { alias => { bar => 'role_bar' } };
- } qr/Cannot create a method alias if a local method of the same name exists/, '... this succeeds';
-
- sub role_bar { 'FAIL' }
+ } qr/Cannot create a method alias if a local method of the same name exists/, '... this succeeds';
+
+ sub role_bar { 'FAIL' }
}
ok(My::OtherRole->meta->has_method($_), "we have a $_ method") for qw(foo baz role_bar);
{
package Foo::Role;
use Mouse::Role;
-
+
sub foo { 'Foo::Role::foo' }
-
+
package Bar::Role;
use Mouse::Role;
-
- sub foo { 'Bar::Role::foo' }
+
+ sub foo { 'Bar::Role::foo' }
package Baz::Role;
use Mouse::Role;
-
- sub foo { 'Baz::Role::foo' }
-
+
+ sub foo { 'Baz::Role::foo' }
+
package My::Foo::Class;
use Mouse;
-
+
::lives_ok {
with 'Foo::Role' => { alias => { 'foo' => 'foo_foo' }, excludes => 'foo' },
- 'Bar::Role' => { alias => { 'foo' => 'bar_foo' }, excludes => 'foo' },
+ 'Bar::Role' => { alias => { 'foo' => 'bar_foo' }, excludes => 'foo' },
'Baz::Role';
- } '... composed our roles correctly';
-
+ } '... composed our roles correctly';
+
package My::Foo::Class::Broken;
use Mouse;
-
+
::throws_ok {
with 'Foo::Role' => { alias => { 'foo' => 'foo_foo' }, excludes => 'foo' },
- 'Bar::Role' => { alias => { 'foo' => 'foo_foo' }, excludes => 'foo' },
+ 'Bar::Role' => { alias => { 'foo' => 'foo_foo' }, excludes => 'foo' },
'Baz::Role';
- } qr/\'Foo::Role\|Bar::Role\|Baz::Role\' requires the method \'foo_foo\' to be implemented by \'My::Foo::Class::Broken\'/,
- '... composed our roles correctly';
+ } qr/Due to a method name conflict in roles 'Bar::Role' and 'Foo::Role', the method 'foo_foo' must be implemented or excluded by 'My::Foo::Class::Broken'/,
+ '... composed our roles correctly';
}
{
isa_ok($foo, 'My::Foo::Class');
can_ok($foo, $_) for qw/foo foo_foo bar_foo/;
is($foo->foo, 'Baz::Role::foo', '... got the right method');
- is($foo->foo_foo, 'Foo::Role::foo', '... got the right method');
- is($foo->bar_foo, 'Bar::Role::foo', '... got the right method');
+ is($foo->foo_foo, 'Foo::Role::foo', '... got the right method');
+ is($foo->bar_foo, 'Bar::Role::foo', '... got the right method');
}
{
::lives_ok {
with 'Foo::Role' => { alias => { 'foo' => 'foo_foo' }, excludes => 'foo' },
- 'Bar::Role' => { alias => { 'foo' => 'bar_foo' }, excludes => 'foo' },
+ 'Bar::Role' => { alias => { 'foo' => 'bar_foo' }, excludes => 'foo' },
'Baz::Role';
} '... composed our roles correctly';
}
::lives_ok {
with 'Foo::Role' => { alias => { 'foo' => 'foo_foo' }, excludes => 'foo' },
- 'Bar::Role' => { alias => { 'foo' => 'foo_foo' }, excludes => 'foo' },
+ 'Bar::Role' => { alias => { 'foo' => 'foo_foo' }, excludes => 'foo' },
'Baz::Role';
} '... composed our roles correctly';
}