From: Jesse Luehrs <doy@tozt.net>
Date: Thu, 8 Apr 2010 23:35:11 +0000 (-0500)
Subject: fix instance application not passing along role args (lsm)
X-Git-Tag: 1.02~10
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f315aab389b68172c5139d3f270e2a1e13930ea8;p=gitmo%2FMoose.git

fix instance application not passing along role args (lsm)
---

diff --git a/Changes b/Changes
index 26cb1b3..778de2a 100644
--- a/Changes
+++ b/Changes
@@ -14,6 +14,8 @@ for, noteworthy changes.
     Moose tests with user that didn't have permission to write to the
     t/ directory. (Chris Weyl, Ævar Arnfjörð Bjarmason)
 
+  * Pass role arguments along when applying roles to instances. (doy, lsm)
+
 1.01 Fri, Mar 26, 2010
 
   [NEW FEATURES]
diff --git a/lib/Moose/Meta/Role.pm b/lib/Moose/Meta/Role.pm
index 29d10fc..4e63f63 100644
--- a/lib/Moose/Meta/Role.pm
+++ b/lib/Moose/Meta/Role.pm
@@ -399,7 +399,7 @@ sub alias_method {
 ## ------------------------------------------------------------------
 
 sub apply {
-    my ($self, $other, @args) = @_;
+    my ($self, $other, %args) = @_;
 
     (blessed($other))
         || Moose->throw_error("You must pass in an blessed instance");
@@ -416,7 +416,7 @@ sub apply {
     }
 
     Class::MOP::load_class($application_class);
-    return $application_class->new(@args)->apply($self, $other);
+    return $application_class->new(%args)->apply($self, $other, \%args);
 }
 
 sub composition_class_roles { }
diff --git a/lib/Moose/Meta/Role/Application/ToInstance.pm b/lib/Moose/Meta/Role/Application/ToInstance.pm
index a54cb1a..d0d864e 100644
--- a/lib/Moose/Meta/Role/Application/ToInstance.pm
+++ b/lib/Moose/Meta/Role/Application/ToInstance.pm
@@ -18,7 +18,7 @@ __PACKAGE__->meta->add_attribute('rebless_params' => (
 ));
 
 sub apply {
-    my ( $self, $role, $object ) = @_;
+    my ( $self, $role, $object, $args ) = @_;
 
     my $obj_meta = Class::MOP::class_of($object) || 'Moose::Meta::Class';
 
@@ -30,7 +30,7 @@ sub apply {
 
     my $class = $obj_meta->create_anon_class(
         superclasses => [ blessed($object) ],
-        roles => [ $role ],
+        roles => [ $role, keys(%$args) ? ($args) : () ],
         cache => 1,
     );
 
diff --git a/t/100_bugs/029_instance_application_role_args.t b/t/100_bugs/029_instance_application_role_args.t
new file mode 100755
index 0000000..9c29a0e
--- /dev/null
+++ b/t/100_bugs/029_instance_application_role_args.t
@@ -0,0 +1,52 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+use Test::More;
+use Test::Exception;
+
+{
+    package Point;
+    use Moose;
+
+    with qw/DoesNegated DoesTranspose/;
+
+    has x => ( isa => 'Int', is => 'rw' );
+    has y => ( isa => 'Int', is => 'rw' );
+
+    sub inspect { [$_[0]->x, $_[0]->y] }
+
+    no Moose;
+}
+
+{
+    package DoesNegated;
+    use Moose::Role;
+
+    sub negated {
+        my $self = shift;
+        $self->new( x => -$self->x, y => -$self->y );
+    }
+
+    no Moose::Role;
+}
+
+{
+    package DoesTranspose;
+    use Moose::Role;
+
+    sub transpose {
+        my $self = shift;
+        $self->new( x => $self->y, y => $self->x );
+    }
+
+    no Moose::Role;
+}
+
+my $p = Point->new( x => 4, y => 3 );
+
+DoesTranspose->meta->apply( $p, alias => { transpose => 'negated' } );
+
+is_deeply($p->negated->inspect, [3, 4]);
+is_deeply($p->transpose->inspect, [3, 4]);
+
+done_testing;