use strict;
use warnings;
-use Test::More no_plan => 1; #skip_all => "provisional test";
+use Test::More no_plan => 1;
use Test::Exception;
BEGIN {
use_ok('Moose');
}
-{
- # no conflicts, this doesn't actually test the new behavior, it's just an example
-
- lives_ok {
- package Role::A;
- use Moose::Role;
-
- use constant;
- BEGIN { constant->import($_ => __PACKAGE__ . "::$_") for qw(bar) };
- } "define role A";
+{
+ # test no conflicts here
+ package Role::A;
+ use Moose::Role;
- lives_ok {
- package Role::B;
- use Moose::Role;
+ sub bar { 'Role::A::bar' }
- use constant;
- BEGIN { constant->import($_ => __PACKAGE__ . "::$_") for qw(xxy) };
- } "define role B";
+ package Role::B;
+ use Moose::Role;
- lives_ok {
- package Role::C;
- use Moose::Role;
+ sub xxy { 'Role::B::xxy' }
- with qw(Role::A Role::B); # conflict between 'foo's here
-
- use constant;
- BEGIN { constant->import($_ => __PACKAGE__ . "::$_") for qw(foo zot) };
+ package Role::C;
+ use Moose::Role;
+
+ ::lives_ok {
+ with qw(Role::A Role::B); # no conflict here
} "define role C";
- lives_ok {
- package Class::A;
- use Moose;
+ sub foo { 'Role::C::foo' }
+ sub zot { 'Role::C::zot' }
- with qw(Role::C);
+ package Class::A;
+ use Moose;
- use constant;
- BEGIN { constant->import($_ => __PACKAGE__ . "::$_") for qw(zot) };
+ ::lives_ok {
+ with qw(Role::C);
} "define class A";
+
+ sub zot { 'Class::A::zot' }
+}
- can_ok( Class::A->new, qw(foo bar xxy zot) );
-
- is( eval { Class::A->new->foo }, "Role::C::foo", "foo" );
- is( eval { Class::A->new->zot }, "Class::A::zot", "zot" );
- is( eval { Class::A->new->bar }, "Role::A::bar", "bar" );
- is( eval { Class::A->new->xxy }, "Role::B::xxy", "xxy" );
+can_ok( Class::A->new, qw(foo bar xxy zot) );
-}
+is( Class::A->new->foo, "Role::C::foo", "... got the right foo method" );
+is( Class::A->new->zot, "Class::A::zot", "... got the right zot method" );
+is( Class::A->new->bar, "Role::A::bar", "... got the right bar method" );
+is( Class::A->new->xxy, "Role::B::xxy", "... got the right xxy method" );
{
- # conflict resolved by role, same result as prev
+ # check that when a role is added to another role
+ # and they conflict and the method they conflicted
+ # with is then required.
+
+ package Role::A::Conflict;
+ use Moose::Role;
+
+ with 'Role::A';
+
+ sub bar { 'Role::A::Conflict::bar' }
+
+ package Class::A::Conflict;
+ use Moose;
+
+ ::throws_ok {
+ with 'Role::A::Conflict';
+ } qr/requires.*'bar'/, '... did not fufill the requirement of &bar method';
+
+ package Class::A::Resolved;
+ use Moose;
+
+ ::lives_ok {
+ with 'Role::A::Conflict';
+ } '... did fufill the requirement of &bar method';
+
+ sub bar { 'Class::A::Resolved::bar' }
+}
- lives_ok {
- package Role::D;
- use Moose::Role;
+ok(Role::A::Conflict->meta->requires_method('bar'), '... Role::A::Conflict created the bar requirement');
- use constant;
- BEGIN { constant->import($_ => __PACKAGE__ . "::$_") for qw(foo bar) };
- } "define role Role::D";
+can_ok( Class::A::Resolved->new, qw(bar) );
- lives_ok {
- package Role::E;
- use Moose::Role;
+is( Class::A::Resolved->new->bar, 'Class::A::Resolved::bar', "... got the right bar method" );
- use constant;
- BEGIN { constant->import($_ => __PACKAGE__ . "::$_") for qw(foo xxy) };
- } "define role Role::E";
+{
+ # check that when two roles are composed, they conflict
+ # but the composing role can resolve that conflict
+
+ package Role::D;
+ use Moose::Role;
- lives_ok {
- package Role::F;
- use Moose::Role;
+ sub foo { 'Role::D::foo' }
+ sub bar { 'Role::D::bar' }
- with qw(Role::D Role::E); # conflict between 'foo's here
+ package Role::E;
+ use Moose::Role;
- use constant;
- BEGIN { constant->import($_ => __PACKAGE__ . "::$_") for qw(foo zot) };
- } "define role Role::F";
+ sub foo { 'Role::E::foo' }
+ sub xxy { 'Role::E::xxy' }
- lives_ok {
- package Class::B;
- use Moose;
+ package Role::F;
+ use Moose::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' }
+
+ package Class::B;
+ use Moose;
+
+ ::lives_ok {
with qw(Role::F);
-
- use constant;
- BEGIN { constant->import($_ => __PACKAGE__ . "::$_") for qw(zot) };
} "define class Class::B";
+
+ sub zot { 'Class::B::zot' }
+}
- can_ok( Class::B->new, qw(foo bar xxy zot) );
+can_ok( Class::B->new, qw(foo bar xxy zot) );
- is( eval { Class::B->new->foo }, "Role::F::foo", "foo" );
- is( eval { Class::B->new->zot }, "Class::B::zot", "zot" );
- is( eval { Class::B->new->bar }, "Role::D::bar", "bar" );
- is( eval { Class::B->new->xxy }, "Role::E::xxy", "xxy" );
+is( Class::B->new->foo, "Role::F::foo", "... got the &foo method okay" );
+is( Class::B->new->zot, "Class::B::zot", "... got the &zot method okay" );
+is( Class::B->new->bar, "Role::D::bar", "... got the &bar method okay" );
+is( Class::B->new->xxy, "Role::E::xxy", "... got the &xxy method okay" );
+
+ok(!Role::F->meta->requires_method('foo'), '... Role::F fufilled the &foo requirement');
+
+{
+ # check that a conflict can be resolved
+ # by a role, but also new ones can be
+ # created just as easily ...
+
+ package Role::D::And::E::Conflict;
+ use Moose::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' }
}
+ok(!Role::D::And::E::Conflict->meta->requires_method('foo'), '... Role::D::And::E::Conflict fufilled the &foo requirement');
+ok(Role::D::And::E::Conflict->meta->requires_method('xxy'), '... Role::D::And::E::Conflict adds the &xxy requirement');
+ok(Role::D::And::E::Conflict->meta->requires_method('bar'), '... Role::D::And::E::Conflict adds the &bar requirement');
+
{
# conflict propagation
+
+ package Role::H;
+ use Moose::Role;
- lives_ok {
- package Role::H;
- use Moose::Role;
+ sub foo { 'Role::H::foo' }
+ sub bar { 'Role::H::bar' }
- use constant;
- BEGIN { constant->import($_ => __PACKAGE__ . "::$_") for qw(foo bar) };
- } "define role Role::H";
+ package Role::J;
+ use Moose::Role;
- lives_ok {
- package Role::J;
- use Moose::Role;
+ sub foo { 'Role::J::foo' }
+ sub xxy { 'Role::J::xxy' }
- use constant;
- BEGIN { constant->import($_ => __PACKAGE__ . "::$_") for qw(foo xxy) };
- } "define role Role::J";
-
- lives_ok {
- package Role::I;
- use Moose::Role;
+ package Role::I;
+ use Moose::Role;
+ ::lives_ok {
with qw(Role::J Role::H); # conflict between 'foo's here
-
- use constant;
- BEGIN { constant->import($_ => __PACKAGE__ . "::$_") for qw(zot) };
} "define role Role::I";
+
+ sub zot { 'Role::I::zot' }
- throws_ok {
- package Class::C;
- use Moose;
-
+ package Class::C;
+ use Moose;
+
+ ::throws_ok {
with qw(Role::I);
-
- use constant;
- BEGIN { constant->import($_ => __PACKAGE__ . "::$_") for qw(zot) };
} qr/requires.*'foo'/, "defining class Class::C fails";
- lives_ok {
- package Class::E;
- use Moose;
+ sub zot { 'Class::C::zot' }
+ package Class::E;
+ use Moose;
+
+ ::lives_ok {
with qw(Role::I);
+ } "resolved with method";
+
+ sub foo { 'Class::E::foo' }
+ sub zot { 'Class::E::zot' }
+}
+
+can_ok( Class::E->new, qw(foo bar xxy zot) );
- use constant;
- BEGIN { constant->import($_ => __PACKAGE__ . "::$_") for qw(foo zot) };
- } "resolved with method";
+is( Class::E->new->foo, "Class::E::foo", "... got the right &foo method" );
+is( Class::E->new->zot, "Class::E::zot", "... got the right &zot method" );
+is( Class::E->new->bar, "Role::H::bar", "... got the right &bar method" );
+is( Class::E->new->xxy, "Role::J::xxy", "... got the right &xxy method" );
+ok(Role::I->meta->requires_method('foo'), '... Role::I still have the &foo requirement');
+
+{
# fix these later ...
TODO: {
- local $TODO = "TODO: add support for attribute methods fufilling reqs";
+ local $TODO = "add support for attribute methods fufilling reqs";
lives_ok {
package Class::D;
has foo => ( default => __PACKAGE__ . "::foo", is => "rw" );
- use constant;
- BEGIN { constant->import($_ => __PACKAGE__ . "::$_") for qw(zot) };
+ sub zot { 'Class::D::zot' }
with qw(Role::I);
+
} "resolved with attr";
can_ok( Class::D->new, qw(foo bar xxy zot) );
is( eval { Class::D->new->foo }, "Class::D::foo", "foo" );
is( eval { Class::D->new->zot }, "Class::D::zot", "zot" );
- can_ok( Class::E->new, qw(foo bar xxy zot) );
-
- is( eval { Class::E->new->foo }, "Class::E::foo", "foo" );
- is( eval { Class::E->new->zot }, "Class::E::zot", "zot" );
- is( eval { Class::E->new->bar }, "Role::H::bar", "bar" );
- is( eval { Class::E->new->xxy }, "Role::J::xxy", "xxy" );
-
}
projects / gitmo/Moose.git / blobdiff