From: Dave Rolsky <autarch@urth.org>
Date: Mon, 14 Mar 2011 04:04:51 +0000 (-0500)
Subject: Store the role which first defines an attribute, and pass that along when cloning.
X-Git-Tag: 1.9905~10
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=3cfeb291568b14dcc76b78148363b4b5a5b8da6d;p=gitmo%2FMoose.git

Store the role which first defines an attribute, and pass that along when cloning.

Use the original role's applied_attribute_metaclass when we finally apply the
attribute, rather than the _current_ role's applied_attribute_metaclass.
---

diff --git a/lib/Moose/Meta/Role/Application/ToClass.pm b/lib/Moose/Meta/Role/Application/ToClass.pm
index d544f7f..2ec5531 100644
--- a/lib/Moose/Meta/Role/Application/ToClass.pm
+++ b/lib/Moose/Meta/Role/Application/ToClass.pm
@@ -125,7 +125,6 @@ sub check_required_attributes {
 
 sub apply_attributes {
     my ($self, $role, $class) = @_;
-    my $attr_metaclass = $role->applied_attribute_metaclass;
 
     foreach my $attribute_name ($role->get_attribute_list) {
         # it if it has one already
@@ -136,7 +135,7 @@ sub apply_attributes {
         }
         else {
             $class->add_attribute(
-                $role->get_attribute($attribute_name)->attribute_for_class($attr_metaclass)
+                $role->get_attribute($attribute_name)->attribute_for_class
             );
         }
     }
diff --git a/lib/Moose/Meta/Role/Attribute.pm b/lib/Moose/Meta/Role/Attribute.pm
index 9132f1e..15721da 100644
--- a/lib/Moose/Meta/Role/Attribute.pm
+++ b/lib/Moose/Meta/Role/Attribute.pm
@@ -22,6 +22,12 @@ __PACKAGE__->meta->add_attribute(
 );
 
 __PACKAGE__->meta->add_attribute(
+    '_original_role' => (
+        reader => '_original_role',
+    )
+);
+
+__PACKAGE__->meta->add_attribute(
     'is' => (
         reader => 'is',
     )
@@ -39,9 +45,12 @@ sub new {
     (defined $name)
         || confess "You must provide a name for the attribute";
 
+    my $role = delete $options{_original_role};
+
     return bless {
         name             => $name,
         original_options => \%options,
+        _original_role   => $role,
         %options,
     }, $class;
 }
@@ -56,9 +65,16 @@ sub attach_to_role {
     weaken( $self->{'associated_role'} = $role );
 }
 
+sub original_role {
+    my $self = shift;
+
+    return $self->_original_role || $self->associated_role;
+}
+
 sub attribute_for_class {
-    my $self      = shift;
-    my $metaclass = shift;
+    my $self = shift;
+
+    my $metaclass = $self->original_role->applied_attribute_metaclass;
 
     return $metaclass->interpolate_class_and_new(
         $self->name => %{ $self->original_options } );
@@ -67,7 +83,13 @@ sub attribute_for_class {
 sub clone {
     my $self = shift;
 
-    return ( ref $self )->new( $self->name, %{ $self->original_options } );
+    my $role = $self->original_role;
+
+    return ( ref $self )->new(
+        $self->name,
+        %{ $self->original_options },
+        _original_role => $role,
+    );
 }
 
 sub is_same_as {
@@ -123,6 +145,12 @@ Returns the option as passed to the constructor.
 
 Returns the L<Moose::Meta::Role> to which this attribute belongs, if any.
 
+=item B<< $attr->original_role >>
+
+Returns the L<Moose::Meta::Role> in which this attribute was first
+defined. This may not be the same as the value C<associated_role()> in the
+case of composite role, or the case where one role consumes other roles.
+
 =item B<< $attr->original_options >>
 
 Returns a hash reference of options passed to the constructor. This is used
diff --git a/t/roles/role_attr_application.t b/t/roles/role_attr_application.t
index 00fd53b..5c53ce5 100644
--- a/t/roles/role_attr_application.t
+++ b/t/roles/role_attr_application.t
@@ -243,10 +243,7 @@ ok(!Moose::Util::does_role(Baz->meta->get_attribute('foo'), 'Baz::Meta::Attribut
     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");
-}
 
-{
-    local $TODO = "applied_attribute metaroles are lost in role composition";
     my $bar = Quux->meta->get_attribute('bar');
     does_ok($bar, 'Quux::Meta::Role::Attribute',
             "attribute metarole applied correctly");