From: Jesse Luehrs <doy@tozt.net>
Date: Sun, 11 Oct 2009 22:11:11 +0000 (-0500)
Subject: preserve aliasing for delegated methods
X-Git-Tag: 0.93~26
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c279b82ffd1a06a550f2cfa623382d0335dbc39a;p=gitmo%2FMoose.git

preserve aliasing for delegated methods
---

diff --git a/Changes b/Changes
index 8229942..377e0de 100644
--- a/Changes
+++ b/Changes
@@ -7,6 +7,9 @@ for, noteworthy changes.
 
     * replace two more eval { } calls with try { } (doy)
 
+    * Moose::Meta::Method::Delegation
+      - preserve aliasing for delegated methods (doy)
+
 0.92 Tue, Sep 22, 2009
     * Moose::Util::TypeConstraints
       - added the match_on_type operator (Stevan)
diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm
index 8f638f7..55cb2c6 100644
--- a/lib/Moose/Meta/Attribute.pm
+++ b/lib/Moose/Meta/Attribute.pm
@@ -741,11 +741,6 @@ sub delegation_metaclass { 'Moose::Meta::Method::Delegation' }
 sub _make_delegation_method {
     my ( $self, $handle_name, $method_to_call ) = @_;
 
-    my $method_body;
-
-    $method_body = $method_to_call
-        if 'CODE' eq ref($method_to_call);
-
     my @curried_arguments;
 
     ($method_to_call, @curried_arguments) = @$method_to_call
diff --git a/lib/Moose/Meta/Method/Delegation.pm b/lib/Moose/Meta/Method/Delegation.pm
index 7513e75..32e7f9c 100644
--- a/lib/Moose/Meta/Method/Delegation.pm
+++ b/lib/Moose/Meta/Method/Delegation.pm
@@ -104,8 +104,8 @@ sub _initialize_body {
                 object      => $instance
             );
         }
-        my @args = (@{ $self->curried_arguments }, @_);
-        $proxy->$method_to_call(@args);
+        unshift @_, @{ $self->curried_arguments };
+        $proxy->$method_to_call(@_);
     };
 }
 
diff --git a/t/020_attributes/032_delegation_arg_aliasing.t b/t/020_attributes/032_delegation_arg_aliasing.t
new file mode 100644
index 0000000..4e1ec42
--- /dev/null
+++ b/t/020_attributes/032_delegation_arg_aliasing.t
@@ -0,0 +1,39 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More tests => 3;
+
+{
+    package Foo;
+    use Moose;
+
+    sub aliased {
+        my $self = shift;
+        $_[1] = $_[0];
+    }
+}
+
+{
+    package HasFoo;
+    use Moose;
+
+    has foo => (
+        is  => 'ro',
+        isa => 'Foo',
+        handles => {
+            foo_aliased => 'aliased',
+            foo_aliased_curried => ['aliased', 'bar'],
+        }
+    );
+}
+
+my $hasfoo = HasFoo->new(foo => Foo->new);
+my $x;
+$hasfoo->foo->aliased('foo', $x);
+is($x, 'foo', "direct aliasing works");
+undef $x;
+$hasfoo->foo_aliased('foo', $x);
+is($x, 'foo', "delegated aliasing works");
+undef $x;
+$hasfoo->foo_aliased_curried($x);
+is($x, 'bar', "delegated aliasing with currying works");