X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=blobdiff_plain;f=t%2F020_attributes%2F031_delegation_and_modifiers.t;fp=t%2F020_attributes%2F031_delegation_and_modifiers.t;h=0fca0a7a61c56b2aec0c97bfcb2504e1a7d6dc3e;hp=0000000000000000000000000000000000000000;hb=1f5ce14ae261aa33d3920121f86a1b6a5a5b1b43;hpb=1eb43e0a41287a5b7de774527e379f9ed57e7e21 diff --git a/t/020_attributes/031_delegation_and_modifiers.t b/t/020_attributes/031_delegation_and_modifiers.t new file mode 100644 index 0000000..0fca0a7 --- /dev/null +++ b/t/020_attributes/031_delegation_and_modifiers.t @@ -0,0 +1,60 @@ +#!/usr/bin/perl +# This is automatically generated by author/import-moose-test.pl. +# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! +use t::lib::MooseCompat; + +use strict; +use warnings; + +use Test::More; +use Test::Exception; + +{ + package Bar; + use Mouse; + + sub baz { 'Bar::baz' } + sub gorch { 'Bar::gorch' } + + package Foo; + use Mouse; + + has 'bar' => ( + is => 'ro', + isa => 'Bar', + lazy => 1, + default => sub { Bar->new }, + handles => [qw[ baz gorch ]] + ); + + package Foo::Extended; + use Mouse; + + 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'); + +done_testing;