use strict; use warnings; use Test::More; use Test::Moose; use Moose::Util qw( does_role ); { package Foo::Meta::Attribute; use Moose::Role; } { package Foo::Meta::Attribute2; use Moose::Role; } { package Foo::Role; use Moose::Role; has foo => (is => 'ro'); } { package Foo; use Moose; Moose::Util::MetaRole::apply_metaroles( for => __PACKAGE__, class_metaroles => { attribute => ['Foo::Meta::Attribute'] }, role_metaroles => { applied_attribute => ['Foo::Meta::Attribute2'] }, ); with 'Foo::Role'; has bar => (is => 'ro'); } ok(Moose::Util::does_role(Foo->meta->get_attribute('bar'), 'Foo::Meta::Attribute'), "attrs defined in the class get the class metarole applied"); ok(!Moose::Util::does_role(Foo->meta->get_attribute('bar'), 'Foo::Meta::Attribute2'), "attrs defined in the class don't get the role metarole applied"); ok(!Moose::Util::does_role(Foo->meta->get_attribute('foo'), 'Foo::Meta::Attribute'), "attrs defined in the role don't get the metarole applied"); ok(!Moose::Util::does_role(Foo->meta->get_attribute('foo'), 'Foo::Meta::Attribute'), "attrs defined in the role don't get the role metarole defined in the class applied"); { package Bar::Meta::Attribute; use Moose::Role; } { package Bar::Meta::Attribute2; use Moose::Role; } { package Bar::Role; use Moose::Role; Moose::Util::MetaRole::apply_metaroles( for => __PACKAGE__, class_metaroles => { attribute => ['Bar::Meta::Attribute'] }, role_metaroles => { applied_attribute => ['Bar::Meta::Attribute2'] }, ); has foo => (is => 'ro'); } { package Bar; use Moose; with 'Bar::Role'; has bar => (is => 'ro'); } ok(!Moose::Util::does_role(Bar->meta->get_attribute('bar'), 'Bar::Meta::Attribute'), "attrs defined in the class don't get the class metarole from the role applied"); ok(!Moose::Util::does_role(Bar->meta->get_attribute('bar'), 'Bar::Meta::Attribute2'), "attrs defined in the class don't get the role metarole applied"); ok(Moose::Util::does_role(Bar->meta->get_attribute('foo'), 'Bar::Meta::Attribute2'), "attrs defined in the role get the role metarole applied"); ok(!Moose::Util::does_role(Bar->meta->get_attribute('foo'), 'Bar::Meta::Attribute'), "attrs defined in the role don't get the class metarole applied"); { package Baz::Meta::Attribute; use Moose::Role; } { package Baz::Meta::Attribute2; use Moose::Role; } { package Baz::Role; use Moose::Role; Moose::Util::MetaRole::apply_metaroles( for => __PACKAGE__, class_metaroles => { attribute => ['Baz::Meta::Attribute'] }, role_metaroles => { applied_attribute => ['Baz::Meta::Attribute2'] }, ); has foo => (is => 'ro'); } { package Baz; use Moose; Moose::Util::MetaRole::apply_metaroles( for => __PACKAGE__, class_metaroles => { attribute => ['Baz::Meta::Attribute'] }, role_metaroles => { applied_attribute => ['Baz::Meta::Attribute2'] }, ); with 'Baz::Role'; has bar => (is => 'ro'); } ok(Moose::Util::does_role(Baz->meta->get_attribute('bar'), 'Baz::Meta::Attribute'), "attrs defined in the class get the class metarole applied"); ok(!Moose::Util::does_role(Baz->meta->get_attribute('bar'), 'Baz::Meta::Attribute2'), "attrs defined in the class don't get the role metarole applied"); ok(Moose::Util::does_role(Baz->meta->get_attribute('foo'), 'Baz::Meta::Attribute2'), "attrs defined in the role get the role metarole applied"); ok(!Moose::Util::does_role(Baz->meta->get_attribute('foo'), 'Baz::Meta::Attribute'), "attrs defined in the role don't get the class metarole applied"); { package Accessor::Modifying::Role; use Moose::Role; around _process_options => sub { my $orig = shift; my $self = shift; my ($name, $params) = @_; $self->$orig(@_); $params->{reader} .= '_foo'; }; } { package Plain::Role; use Moose::Role; has foo => ( is => 'ro', isa => 'Str', ); } { package Class::With::Trait; use Moose; Moose::Util::MetaRole::apply_metaroles( for => __PACKAGE__, class_metaroles => { attribute => ['Accessor::Modifying::Role'], }, ); with 'Plain::Role'; has bar => ( is => 'ro', isa => 'Str', ); } { can_ok('Class::With::Trait', 'foo'); can_ok('Class::With::Trait', 'bar_foo'); } { package Role::With::Trait; use Moose::Role; Moose::Util::MetaRole::apply_metaroles( for => __PACKAGE__, role_metaroles => { applied_attribute => ['Accessor::Modifying::Role'], }, ); with 'Plain::Role'; has foo => ( is => 'ro', isa => 'Str', ); sub foo_test { my $self = shift; return $self->can('foo_foo'); } } { package Class::With::Role::With::Trait; use Moose; with 'Role::With::Trait'; has bar => ( is => 'ro', isa => 'Str', ); sub bar_test { my $self = shift; return $self->can('bar'); } } { can_ok('Class::With::Role::With::Trait', 'foo_foo'); can_ok('Class::With::Role::With::Trait', 'bar'); } { package Quux::Meta::Role::Attribute; use Moose::Role; } { package Quux::Role1; use Moose::Role; has foo => (traits => ['Quux::Meta::Role::Attribute'], is => 'ro'); has baz => (is => 'ro'); } { package Quux::Role2; use Moose::Role; Moose::Util::MetaRole::apply_metaroles( for => __PACKAGE__, role_metaroles => { applied_attribute => ['Quux::Meta::Role::Attribute'] }, ); has bar => (is => 'ro'); } { package Quux; use Moose; with 'Quux::Role1', 'Quux::Role2'; } { my $foo = Quux->meta->get_attribute('foo'); does_ok($foo, 'Quux::Meta::Role::Attribute', "individual attribute trait applied correctly"); my $baz = Quux->meta->get_attribute('baz'); ok(! does_role($baz, 'Quux::Meta::Role::Attribute'), "applied_attribute traits do not end up applying to attributes from other roles during composition"); my $bar = Quux->meta->get_attribute('bar'); does_ok($bar, 'Quux::Meta::Role::Attribute', "attribute metarole applied correctly"); } { package HasMeta; use Moose::Role; Moose::Util::MetaRole::apply_metaroles( for => __PACKAGE__, role_metaroles => { applied_attribute => ['Quux::Meta::Role::Attribute'] }, ); has foo => (is => 'ro'); } { package NoMeta; use Moose::Role; with 'HasMeta'; has bar => (is => 'ro'); } { package ConsumesBoth; use Moose; with 'HasMeta', 'NoMeta'; } { my $foo = ConsumesBoth->meta->get_attribute('foo'); does_ok($foo, 'Quux::Meta::Role::Attribute', 'applied_attribute traits are preserved when one role consumes another'); my $bar = ConsumesBoth->meta->get_attribute('bar'); ok(! does_role($bar, 'Quux::Meta::Role::Attribute'), "applied_attribute traits do not spill over from consumed role"); } done_testing;