X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Fcompose-roles.t;h=26c35a1649e638052858a6395da970e262ce1101;hb=master;hp=ead1f116af6643a06fb11d667693601c4b71c620;hpb=e95d3981f31c078147fa6e3f5b61ff16683703ac;p=gitmo%2FMoo.git diff --git a/t/compose-roles.t b/t/compose-roles.t index ead1f11..26c35a1 100644 --- a/t/compose-roles.t +++ b/t/compose-roles.t @@ -1,5 +1,6 @@ use strictures 1; use Test::More; +use Test::Fatal; { package One; use Role::Tiny; @@ -62,4 +63,56 @@ my $o2 = Moo::Role->create_class_with_roles( is($o2->attr3, -3, 'constructor includes base class'); is($o2->attr2, -2, 'constructor includes role'); +{ + package AccessorExtension; + use Moo::Role; + around 'generate_method' => sub { + my $orig = shift; + my $me = shift; + my ($into, $name) = @_; + $me->$orig(@_); + no strict 'refs'; + *{"${into}::_${name}_marker"} = sub { }; + }; +} + +{ + package RoleWithReq; + use Moo::Role; + requires '_attr1_marker'; +} + +is exception { + package ClassWithExtension; + use Moo; + Moo::Role->apply_roles_to_object( + Moo->_accessor_maker_for(__PACKAGE__), + 'AccessorExtension'); + + with qw(RoleWithAttr RoleWithReq); +}, undef, 'apply_roles_to_object correctly calls accessor generator'; + +{ + package EmptyClass; + use Moo; +} + +{ + package RoleWithReq2; + use Moo::Role; + requires 'attr2'; +} + +is exception { + Moo::Role->create_class_with_roles( + 'EmptyClass', 'RoleWithReq2', 'RoleWithAttr2'); +}, undef, 'create_class_with_roles accepts attributes for requirements'; + +like exception { + Moo::Role->create_class_with_roles( + 'EmptyClass', 'RoleWithReq2', 'RoleWithAttr'); +}, qr/Can't apply .* missing attr2/, + 'create_class_with_roles accepts attributes for requirements'; + + done_testing;