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;
}
--- /dev/null
+#!/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');
+
+
+
+
+
+
+
+