tests and changelogging

diff --git a/Changes b/Changes
index 0cb7c8e..73a6d2a 100644 (file)
--- a/Changes
+++ b/Changes
@@ -3,6 +3,13 @@ for, noteworthy changes.
 
 NEXT
 
+  [API CHANGES]
+
+  * Roles now have their own default attribute metaclass to use during
+    application to a class, rather than just using the class's
+    attribute_metaclass. This is also overridable via ::MetaRole, with the
+    applied_attribute key in the role_metaroles hashref (doy).
+
   [ENHANCEMENTS]
 
   * We now load the roles needed for native delegations only as needed. This

diff --git a/lib/Moose/Manual/Delta.pod b/lib/Moose/Manual/Delta.pod
index f4c2b5e..4a147c8 100644 (file)
--- a/lib/Moose/Manual/Delta.pod
+++ b/lib/Moose/Manual/Delta.pod
@@ -16,6 +16,34 @@ feature.  If you encounter a problem and have a solution but don't see
 it documented here, or think we missed an important feature, please
 send us a patch.
 
+=head1 NEXT
+
+=over 4
+
+=item Roles have their own default attribute metaclass
+
+Previously, when a role was applied to a class, it would use the attribute
+metaclass defined in the class when copying over the attributes in the role.
+This was wrong, because for instance, using L<MooseX::FollowPBP> in the class
+would end up renaming all of the accessors generated by the role, some of which
+may be being called in the role, causing it to break. Roles now keep track of
+their own attribute metaclass to use by default when being applied to a class
+(defaulting to Moose::Meta::Attribute). This is modifiable using
+L<Moose::Util::MetaRole> by passing the C<applied_attribute> key to the
+C<role_metaroles> option, as in:
+
+    Moose::Util::MetaRole::apply_metaroles(
+        for => __PACKAGE__,
+        class_metaroles => {
+            attribute => ['My::Meta::Role::Attribute'],
+        },
+        role_metaroles => {
+            applied_attribute => ['My::Meta::Role::Attribute'],
+        },
+    );
+
+=back
+
 =head1 1.16
 
 =over 4

diff --git a/t/030_roles/046_role_attr_application.t b/t/030_roles/046_role_attr_application.t
new file mode 100644 (file)
index 0000000..17b608a
--- /dev/null
+++ b/t/030_roles/046_role_attr_application.t
@@ -0,0 +1,204 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+
+{
+    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');
+}
+
+done_testing;