From: Stevan Little <stevan@localhost.(none)>
Date: Tue, 18 Aug 2009 16:27:24 +0000 (-0400)
Subject: delegated methods now working properly if the accessor has modifiers
X-Git-Tag: 0.90~28
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=53b3e21446585bd3fab6142a124718e8bb1c59c5;p=gitmo%2FMoose.git

delegated methods now working properly if the accessor has modifiers
---

diff --git a/lib/Moose/Meta/Method/Delegation.pm b/lib/Moose/Meta/Method/Delegation.pm
index 351db5c..00392ed 100644
--- a/lib/Moose/Meta/Method/Delegation.pm
+++ b/lib/Moose/Meta/Method/Delegation.pm
@@ -111,10 +111,22 @@ sub _initialize_body {
 
 sub _get_delegate_accessor {
     my $self = shift;
-
-    my $accessor = $self->associated_attribute->get_read_method_ref;
-
-    $accessor = $accessor->body if blessed $accessor;
+    my $attr = $self->associated_attribute;
+
+    # NOTE:
+    # always use a named method when
+    # possible, if you use the method
+    # ref and there are modifiers on
+    # the accessors then it will not
+    # pick up the modifiers too. Only
+    # the named method will assure that
+    # we also have any modifiers run.
+    # - SL
+    my $accessor = $attr->has_read_method
+        ? $attr->get_read_method
+        : $attr->get_read_method_ref;
+
+    $accessor = $accessor->body if Scalar::Util::blessed $accessor;
 
     return $accessor;
 }
diff --git a/t/020_attributes/029_delegation_and_modifiers.t b/t/020_attributes/029_delegation_and_modifiers.t
new file mode 100644
index 0000000..78ab291
--- /dev/null
+++ b/t/020_attributes/029_delegation_and_modifiers.t
@@ -0,0 +1,63 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 5;
+use Test::Exception;
+
+{
+    package Bar;
+    use Moose;
+
+    sub baz   { 'Bar::baz' }
+    sub gorch { 'Bar::gorch' }
+
+    package Foo;
+    use Moose;
+
+    has 'bar' => (
+        is      => 'ro',
+        isa     => 'Bar',
+        lazy    => 1,
+        default => sub { Bar->new },
+        handles => [qw[ baz gorch ]]
+    );
+
+    package Foo::Extended;
+    use Moose;
+
+    extends 'Foo';
+
+    has 'test' => (
+        is      => 'rw',
+        isa     => 'Bool',
+        default => sub { 0 },
+    );
+
+    around 'bar' => sub {
+        my $next = shift;
+        my $self = shift;
+
+        $self->test(1);
+        $self->$next();
+    };
+}
+
+my $foo = Foo::Extended->new;
+isa_ok($foo, 'Foo::Extended');
+isa_ok($foo, 'Foo');
+
+ok(!$foo->test, '... the test value has not been changed');
+
+is($foo->baz, 'Bar::baz', '... got the right delegated method');
+
+ok($foo->test, '... the test value has now been changed');
+
+
+
+
+
+
+
+