From: Matt S Trout Date: Tue, 26 Jun 2012 19:16:21 +0000 (+0000) Subject: extra test from FAIL_modify_lazy_handlers X-Git-Tag: v0.091010~5 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=777fcfcff3848b24533e0b064b1a246e2ff76b16;p=gitmo%2FMoo.git extra test from FAIL_modify_lazy_handlers --- diff --git a/t/lib/ClassicObject.pm b/t/lib/ClassicObject.pm new file mode 100644 index 0000000..1df3a04 --- /dev/null +++ b/t/lib/ClassicObject.pm @@ -0,0 +1,10 @@ +package ClassicObject; + +sub new { + my ($class, %args) = @_; + bless \%args, 'ClassicObject'; +} + +sub connect { 'a' } + +1; diff --git a/t/lib/MooObjectWithDelegate.pm b/t/lib/MooObjectWithDelegate.pm new file mode 100644 index 0000000..db2be38 --- /dev/null +++ b/t/lib/MooObjectWithDelegate.pm @@ -0,0 +1,27 @@ +package MooObjectWithDelegate; +use ClassicObject; +use Moo; + +has 'delegated' => ( + is => 'ro', + isa => sub { + do { $_[0] && blessed($_[0]) } + or die "Not an Object!"; + }, + lazy => 1, + builder => '_build_delegated', + handles => [qw/connect/], +); + +sub _build_delegated { + my $self = shift; + return ClassicObject->new; +} + +around 'connect', sub { + my ($orig, $self, @args) = @_; + return $self->$orig(@args) . 'b'; +}; + + +1; diff --git a/t/modify_lazy_handlers.t b/t/modify_lazy_handlers.t new file mode 100644 index 0000000..b52ddac --- /dev/null +++ b/t/modify_lazy_handlers.t @@ -0,0 +1,23 @@ +use strictures 1; +use Test::More; +use lib qw(t/lib); + +use_ok 'MooObjectWithDelegate'; + +{ + package MooObjectWithDelegate; + use Moo; + + around 'connect', sub { + my ($orig, $self, @args) = @_; + return $self->$orig(@args) . 'c'; + }; +} + +ok my $moo_object = MooObjectWithDelegate->new, + 'got object'; + +is $moo_object->connect, 'abc', + 'got abc'; + +done_testing;