diff options
| -rw-r--r-- | lib/MooseX/Bread/Board.pm | 11 | ||||
| -rw-r--r-- | lib/MooseX/Bread/Board/Meta/Role/Attribute.pm | 1 | ||||
| -rw-r--r-- | t/21-roles.t | 152 |
3 files changed, 161 insertions, 3 deletions
diff --git a/lib/MooseX/Bread/Board.pm b/lib/MooseX/Bread/Board.pm index fbf536b..2f4c4b8 100644 --- a/lib/MooseX/Bread/Board.pm +++ b/lib/MooseX/Bread/Board.pm @@ -8,6 +8,9 @@ my (undef, undef, $init_meta) = Moose::Exporter->build_import_methods( class => ['MooseX::Bread::Board::Meta::Role::Class'], instance => ['MooseX::Bread::Board::Meta::Role::Instance'], }, + #role_metaroles => { + #applied_attribute => ['MooseX::Bread::Board::Meta::Role::Attribute'], + #}, base_class_roles => ['MooseX::Bread::Board::Role::Object'], ); @@ -15,9 +18,11 @@ sub init_meta { my $package = shift; my %options = @_; if (my $meta = Class::MOP::class_of($options{for_class})) { - my @supers = $meta->superclasses; - $meta->superclasses('Bread::Board::Container') - if @supers == 1 && $supers[0] eq 'Moose::Object'; + if ($meta->isa('Class::MOP::Class')) { + my @supers = $meta->superclasses; + $meta->superclasses('Bread::Board::Container') + if @supers == 1 && $supers[0] eq 'Moose::Object'; + } } $package->$init_meta(%options); } diff --git a/lib/MooseX/Bread/Board/Meta/Role/Attribute.pm b/lib/MooseX/Bread/Board/Meta/Role/Attribute.pm index 19492ae..eae04cc 100644 --- a/lib/MooseX/Bread/Board/Meta/Role/Attribute.pm +++ b/lib/MooseX/Bread/Board/Meta/Role/Attribute.pm @@ -1,5 +1,6 @@ package MooseX::Bread::Board::Meta::Role::Attribute; use Moose::Role; +Moose::Util::meta_attribute_alias('Service'); use Bread::Board::Types; use List::MoreUtils qw(any); diff --git a/t/21-roles.t b/t/21-roles.t new file mode 100644 index 0000000..5be41fd --- /dev/null +++ b/t/21-roles.t @@ -0,0 +1,152 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; + +{ + package Role1; + use Moose::Role; + use MooseX::Bread::Board; + + has role1 => ( + traits => ['Service'], + is => 'ro', + isa => 'Str', + value => 'ROLE1', + ); +} + +{ + package Parent; + use Moose; + use MooseX::Bread::Board; + + with 'Role1'; + + has foo => ( + is => 'ro', + isa => 'Str', + value => 'FOO', + ); + + has bar => ( + is => 'ro', + isa => 'Str', + block => sub { + my $s = shift; + return $s->param('foo') . 'BAR' . $s->param('role1'); + }, + dependencies => ['foo', 'role1'], + ); +} + +{ + package Role2; + use Moose::Role; + use MooseX::Bread::Board; + + has role2 => ( + traits => ['Service'], + is => 'ro', + isa => 'Str', + value => 'ROLE2', + ); +} + +{ + package Child; + use Moose; + use MooseX::Bread::Board; + + extends 'Parent'; + with 'Role2'; + + has baz => ( + is => 'ro', + isa => 'Str', + value => 'BAZ', + ); + + has quux => ( + is => 'ro', + isa => 'Str', + block => sub { + my $s = shift; + return $s->param('foo') + . $s->param('bar') + . $s->param('baz') + . $s->param('role1') + . $s->param('role2') + . 'QUUX'; + }, + dependencies => ['foo', 'bar', 'baz', 'role1', 'role2'], + ); +} + +{ + my $parent = Parent->new; + isa_ok($parent, 'Bread::Board::Container'); + is($parent->role1, 'ROLE1'); + is($parent->foo, 'FOO'); + is($parent->bar, 'FOOBARROLE1'); +} + +{ + my $parent = Parent->new(role1 => '1ELOR', foo => 'OOF', bar => 'RAB'); + isa_ok($parent, 'Bread::Board::Container'); + is($parent->role1, '1ELOR'); + is($parent->foo, 'OOF'); + is($parent->bar, 'RAB'); +} + +{ + my $parent = Parent->new(role1 => '1ELOR', foo => 'OOF'); + isa_ok($parent, 'Bread::Board::Container'); + is($parent->role1, '1ELOR'); + is($parent->foo, 'OOF'); + is($parent->bar, 'OOFBAR1ELOR'); +} + +{ + my $child = Child->new; + is($child->role1, 'ROLE1'); + is($child->foo, 'FOO'); + is($child->bar, 'FOOBARROLE1'); + is($child->role2, 'ROLE2'); + is($child->baz, 'BAZ'); + is($child->quux, 'FOOFOOBARROLE1BAZROLE1ROLE2QUUX'); +} + +{ + my $child = Child->new( + role1 => '1ELOR', + foo => 'OOF', + bar => 'RAB', + role2 => '2ELOR', + baz => 'ZAB', + quux => 'XUUQ', + ); + is($child->role1, '1ELOR'); + is($child->foo, 'OOF'); + is($child->bar, 'RAB'); + is($child->role2, '2ELOR'); + is($child->baz, 'ZAB'); + is($child->quux, 'XUUQ'); +} + +{ + my $child = Child->new( + role1 => '1ELOR', + foo => 'OOF', + role2 => '2ELOR', + baz => 'ZAB', + ); + is($child->role1, '1ELOR'); + is($child->foo, 'OOF'); + is($child->bar, 'OOFBAR1ELOR'); + is($child->role2, '2ELOR'); + is($child->baz, 'ZAB'); + is($child->quux, 'OOFOOFBAR1ELORZAB1ELOR2ELORQUUX'); +} + +done_testing; |