[gitmo/Moose.git] / t / 020_attributes / 010_attribute_delegation.t

#!/usr/bin/perl

use strict;
use warnings;

use Test::More tests => 89;
use Test::Exception;


# -------------------------------------------------------------------
# HASH handles
# -------------------------------------------------------------------
# the canonical form of of the 'handles'
# option is the hash ref mapping a
# method name to the delegated method name

{
    package Foo;
    use Moose;

    has 'bar' => (is => 'rw', default => 10);

    package Bar;
    use Moose;

    has 'foo' => (
        is      => 'rw',
        default => sub { Foo->new },
        handles => {
            'foo_bar' => 'bar',
            'foo_bar_to_20' => [ bar => [ 20 ] ],
        }
    );
}

my $bar = Bar->new;
isa_ok($bar, 'Bar');

ok($bar->foo, '... we have something in bar->foo');
isa_ok($bar->foo, 'Foo');

my $meth = Bar->meta->get_method('foo_bar');
isa_ok($meth, 'Moose::Meta::Method::Delegation');
is($meth->associated_attribute->name, 'foo',
   'associated_attribute->name for this method is foo');

is($bar->foo->bar, 10, '... bar->foo->bar returned the right default');

can_ok($bar, 'foo_bar');
is($bar->foo_bar, 10, '... bar->foo_bar delegated correctly');

# change the value ...

$bar->foo->bar(30);

# and make sure the delegation picks it up

is($bar->foo->bar, 30, '... bar->foo->bar returned the right (changed) value');
is($bar->foo_bar, 30, '... bar->foo_bar delegated correctly');

# change the value through the delegation ...

$bar->foo_bar(50);

# and make sure everyone sees it

is($bar->foo->bar, 50, '... bar->foo->bar returned the right (changed) value');
is($bar->foo_bar, 50, '... bar->foo_bar delegated correctly');

# change the object we are delegating too

my $foo = Foo->new(bar => 25);
isa_ok($foo, 'Foo');

is($foo->bar, 25, '... got the right foo->bar');

lives_ok {
    $bar->foo($foo);
} '... assigned the new Foo to Bar->foo';

is($bar->foo, $foo, '... assigned bar->foo with the new Foo');

is($bar->foo->bar, 25, '... bar->foo->bar returned the right result');
is($bar->foo_bar, 25, '... and bar->foo_bar delegated correctly again');

# curried handles
$bar->foo_bar_to_20;
is($bar->foo_bar, 20, '... correctly curried a single argument');

# -------------------------------------------------------------------
# ARRAY handles
# -------------------------------------------------------------------
# we also support an array based format
# which assumes that the name is the same
# on either end

{
    package Engine;
    use Moose;

    sub go   { 'Engine::go'   }
    sub stop { 'Engine::stop' }

    package Car;
    use Moose;

    has 'engine' => (
        is      => 'rw',
        default => sub { Engine->new },
        handles => [ 'go', 'stop' ]
    );
}

my $car = Car->new;
isa_ok($car, 'Car');

isa_ok($car->engine, 'Engine');
can_ok($car->engine, 'go');
can_ok($car->engine, 'stop');

is($car->engine->go, 'Engine::go', '... got the right value from ->engine->go');
is($car->engine->stop, 'Engine::stop', '... got the right value from ->engine->stop');

can_ok($car, 'go');
can_ok($car, 'stop');

is($car->go, 'Engine::go', '... got the right value from ->go');
is($car->stop, 'Engine::stop', '... got the right value from ->stop');

# -------------------------------------------------------------------
# REGEXP handles
# -------------------------------------------------------------------
# and we support regexp delegation

{
    package Baz;
    use Moose;

    sub foo { 'Baz::foo' }
    sub bar { 'Baz::bar' }
    sub boo { 'Baz::boo' }

    package Baz::Proxy1;
    use Moose;

    has 'baz' => (
        is      => 'ro',
        isa     => 'Baz',
        default => sub { Baz->new },
        handles => qr/.*/
    );

    package Baz::Proxy2;
    use Moose;

    has 'baz' => (
        is      => 'ro',
        isa     => 'Baz',
        default => sub { Baz->new },
        handles => qr/.oo/
    );

    package Baz::Proxy3;
    use Moose;

    has 'baz' => (
        is      => 'ro',
        isa     => 'Baz',
        default => sub { Baz->new },
        handles => qr/b.*/
    );
}

{
    my $baz_proxy = Baz::Proxy1->new;
    isa_ok($baz_proxy, 'Baz::Proxy1');

    can_ok($baz_proxy, 'baz');
    isa_ok($baz_proxy->baz, 'Baz');

    can_ok($baz_proxy, 'foo');
    can_ok($baz_proxy, 'bar');
    can_ok($baz_proxy, 'boo');

    is($baz_proxy->foo, 'Baz::foo', '... got the right proxied return value');
    is($baz_proxy->bar, 'Baz::bar', '... got the right proxied return value');
    is($baz_proxy->boo, 'Baz::boo', '... got the right proxied return value');
}
{
    my $baz_proxy = Baz::Proxy2->new;
    isa_ok($baz_proxy, 'Baz::Proxy2');

    can_ok($baz_proxy, 'baz');
    isa_ok($baz_proxy->baz, 'Baz');

    can_ok($baz_proxy, 'foo');
    can_ok($baz_proxy, 'boo');

    is($baz_proxy->foo, 'Baz::foo', '... got the right proxied return value');
    is($baz_proxy->boo, 'Baz::boo', '... got the right proxied return value');
}
{
    my $baz_proxy = Baz::Proxy3->new;
    isa_ok($baz_proxy, 'Baz::Proxy3');

    can_ok($baz_proxy, 'baz');
    isa_ok($baz_proxy->baz, 'Baz');

    can_ok($baz_proxy, 'bar');
    can_ok($baz_proxy, 'boo');

    is($baz_proxy->bar, 'Baz::bar', '... got the right proxied return value');
    is($baz_proxy->boo, 'Baz::boo', '... got the right proxied return value');
}

# -------------------------------------------------------------------
# ROLE handles
# -------------------------------------------------------------------

{
    package Foo::Bar;
    use Moose::Role;

    requires 'foo';
    requires 'bar';

    package Foo::Baz;
    use Moose;

    sub foo { 'Foo::Baz::FOO' }
    sub bar { 'Foo::Baz::BAR' }
    sub baz { 'Foo::Baz::BAZ' }

    package Foo::Thing;
    use Moose;

    has 'thing' => (
        is      => 'rw',
        isa     => 'Foo::Baz',
        handles => 'Foo::Bar',
    );

}

{
    my $foo = Foo::Thing->new(thing => Foo::Baz->new);
    isa_ok($foo, 'Foo::Thing');
    isa_ok($foo->thing, 'Foo::Baz');

    ok($foo->meta->has_method('foo'), '... we have the method we expect');
    ok($foo->meta->has_method('bar'), '... we have the method we expect');
    ok(!$foo->meta->has_method('baz'), '... we dont have the method we expect');

    is($foo->foo, 'Foo::Baz::FOO', '... got the right value');
    is($foo->bar, 'Foo::Baz::BAR', '... got the right value');
    is($foo->thing->baz, 'Foo::Baz::BAZ', '... got the right value');
}

# -------------------------------------------------------------------
# AUTOLOAD & handles
# -------------------------------------------------------------------

{
    package Foo::Autoloaded;
    use Moose;

    sub AUTOLOAD {
        my $self = shift;

        my $name = our $AUTOLOAD;
        $name =~ s/.*://;		# strip fully-qualified portion

        if (@_) {
            return $self->{$name} = shift;
        } else {
            return $self->{$name};
        }
    }

    package Bar::Autoloaded;
    use Moose;

    has 'foo' => (
        is      => 'rw',
        default => sub { Foo::Autoloaded->new },
        handles => { 'foo_bar' => 'bar' }
    );

    package Baz::Autoloaded;
    use Moose;

    has 'foo' => (
        is      => 'rw',
        default => sub { Foo::Autoloaded->new },
        handles => ['bar']
    );

    package Goorch::Autoloaded;
    use Moose;

    ::dies_ok {
        has 'foo' => (
            is      => 'rw',
            default => sub { Foo::Autoloaded->new },
            handles => qr/bar/
        );
    } '... you cannot delegate to AUTOLOADED class with regexp';
}

# check HASH based delegation w/ AUTOLOAD

{
    my $bar = Bar::Autoloaded->new;
    isa_ok($bar, 'Bar::Autoloaded');

    ok($bar->foo, '... we have something in bar->foo');
    isa_ok($bar->foo, 'Foo::Autoloaded');

    # change the value ...

    $bar->foo->bar(30);

    # and make sure the delegation picks it up

    is($bar->foo->bar, 30, '... bar->foo->bar returned the right (changed) value');
    is($bar->foo_bar, 30, '... bar->foo_bar delegated correctly');

    # change the value through the delegation ...

    $bar->foo_bar(50);

    # and make sure everyone sees it

    is($bar->foo->bar, 50, '... bar->foo->bar returned the right (changed) value');
    is($bar->foo_bar, 50, '... bar->foo_bar delegated correctly');

    # change the object we are delegating too

    my $foo = Foo::Autoloaded->new;
    isa_ok($foo, 'Foo::Autoloaded');

    $foo->bar(25);

    is($foo->bar, 25, '... got the right foo->bar');

    lives_ok {
        $bar->foo($foo);
    } '... assigned the new Foo to Bar->foo';

    is($bar->foo, $foo, '... assigned bar->foo with the new Foo');

    is($bar->foo->bar, 25, '... bar->foo->bar returned the right result');
    is($bar->foo_bar, 25, '... and bar->foo_bar delegated correctly again');
}

# check ARRAY based delegation w/ AUTOLOAD

{
    my $baz = Baz::Autoloaded->new;
    isa_ok($baz, 'Baz::Autoloaded');

    ok($baz->foo, '... we have something in baz->foo');
    isa_ok($baz->foo, 'Foo::Autoloaded');

    # change the value ...

    $baz->foo->bar(30);

    # and make sure the delegation picks it up

    is($baz->foo->bar, 30, '... baz->foo->bar returned the right (changed) value');
    is($baz->bar, 30, '... baz->foo_bar delegated correctly');

    # change the value through the delegation ...

    $baz->bar(50);

    # and make sure everyone sees it

    is($baz->foo->bar, 50, '... baz->foo->bar returned the right (changed) value');
    is($baz->bar, 50, '... baz->foo_bar delegated correctly');

    # change the object we are delegating too

    my $foo = Foo::Autoloaded->new;
    isa_ok($foo, 'Foo::Autoloaded');

    $foo->bar(25);

    is($foo->bar, 25, '... got the right foo->bar');

    lives_ok {
        $baz->foo($foo);
    } '... assigned the new Foo to Baz->foo';

    is($baz->foo, $foo, '... assigned baz->foo with the new Foo');

    is($baz->foo->bar, 25, '... baz->foo->bar returned the right result');
    is($baz->bar, 25, '... and baz->foo_bar delegated correctly again');
}

# Check that removing attributes removes their handles methods also.
{
    {
        package Quux;
        use Moose;
        has foo => (
            isa => 'Foo',
            default => sub { Foo->new },
            handles => { 'foo_bar' => 'bar' }
        );
    }
    my $i = Quux->new;
    ok($i->meta->has_method('foo_bar'), 'handles method foo_bar is present');
    $i->meta->remove_attribute('foo');
    ok(!$i->meta->has_method('foo_bar'), 'handles method foo_bar is removed');
}
Commit	Line	Data
452bac1b	1	#!/usr/bin/perl
	2
	3	use strict;
	4	use warnings;
	5
2de18801	6	use Test::More tests => 89;
452bac1b	7	use Test::Exception;
452bac1b	8
7ff56534	9
452bac1b	10
f4f3e701	11	# -------------------------------------------------------------------
	12	# HASH handles
	13	# -------------------------------------------------------------------
452bac1b	14	# the canonical form of of the 'handles'
d03bd989	15	# option is the hash ref mapping a
452bac1b	16	# method name to the delegated method name
	17
	18	{
	19	package Foo;
452bac1b	20	use Moose;
452bac1b	21
d03bd989	22	has 'bar' => (is => 'rw', default => 10);
452bac1b	23
452bac1b	24	package Bar;
d03bd989	25	use Moose;
d03bd989	26
452bac1b	27	has 'foo' => (
	28	is => 'rw',
	29	default => sub { Foo->new },
2de18801	30	handles => {
	31	'foo_bar' => 'bar',
	32	'foo_bar_to_20' => [ bar => [ 20 ] ],
	33	}
452bac1b	34	);
	35	}
	36
	37	my $bar = Bar->new;
	38	isa_ok($bar, 'Bar');
	39
	40	ok($bar->foo, '... we have something in bar->foo');
	41	isa_ok($bar->foo, 'Foo');
	42
01cd78f8	43	my $meth = Bar->meta->get_method('foo_bar');
	44	isa_ok($meth, 'Moose::Meta::Method::Delegation');
	45	is($meth->associated_attribute->name, 'foo',
	46	'associated_attribute->name for this method is foo');
a05f85c1	47
452bac1b	48	is($bar->foo->bar, 10, '... bar->foo->bar returned the right default');
	49
	50	can_ok($bar, 'foo_bar');
	51	is($bar->foo_bar, 10, '... bar->foo_bar delegated correctly');
	52
f4f3e701	53	# change the value ...
	54
	55	$bar->foo->bar(30);
	56
	57	# and make sure the delegation picks it up
	58
	59	is($bar->foo->bar, 30, '... bar->foo->bar returned the right (changed) value');
	60	is($bar->foo_bar, 30, '... bar->foo_bar delegated correctly');
	61
	62	# change the value through the delegation ...
	63
	64	$bar->foo_bar(50);
	65
d03bd989	66	# and make sure everyone sees it
f4f3e701	67
	68	is($bar->foo->bar, 50, '... bar->foo->bar returned the right (changed) value');
	69	is($bar->foo_bar, 50, '... bar->foo_bar delegated correctly');
	70
	71	# change the object we are delegating too
	72
452bac1b	73	my $foo = Foo->new(bar => 25);
	74	isa_ok($foo, 'Foo');
	75
	76	is($foo->bar, 25, '... got the right foo->bar');
	77
	78	lives_ok {
	79	$bar->foo($foo);
	80	} '... assigned the new Foo to Bar->foo';
	81
	82	is($bar->foo, $foo, '... assigned bar->foo with the new Foo');
	83
	84	is($bar->foo->bar, 25, '... bar->foo->bar returned the right result');
	85	is($bar->foo_bar, 25, '... and bar->foo_bar delegated correctly again');
	86
2de18801	87	# curried handles
	88	$bar->foo_bar_to_20;
	89	is($bar->foo_bar, 20, '... correctly curried a single argument');
	90
f4f3e701	91	# -------------------------------------------------------------------
d03bd989	92	# ARRAY handles
f4f3e701	93	# -------------------------------------------------------------------
452bac1b	94	# we also support an array based format
d03bd989	95	# which assumes that the name is the same
452bac1b	96	# on either end
	97
	98	{
	99	package Engine;
452bac1b	100	use Moose;
	101
	102	sub go { 'Engine::go' }
d03bd989	103	sub stop { 'Engine::stop' }
452bac1b	104
452bac1b	105	package Car;
d03bd989	106	use Moose;
d03bd989	107
452bac1b	108	has 'engine' => (
	109	is => 'rw',
	110	default => sub { Engine->new },
	111	handles => [ 'go', 'stop' ]
	112	);
	113	}
	114
	115	my $car = Car->new;
	116	isa_ok($car, 'Car');
	117
	118	isa_ok($car->engine, 'Engine');
	119	can_ok($car->engine, 'go');
	120	can_ok($car->engine, 'stop');
	121
	122	is($car->engine->go, 'Engine::go', '... got the right value from ->engine->go');
	123	is($car->engine->stop, 'Engine::stop', '... got the right value from ->engine->stop');
	124
	125	can_ok($car, 'go');
	126	can_ok($car, 'stop');
	127
	128	is($car->go, 'Engine::go', '... got the right value from ->go');
	129	is($car->stop, 'Engine::stop', '... got the right value from ->stop');
	130
f4f3e701	131	# -------------------------------------------------------------------
d03bd989	132	# REGEXP handles
f4f3e701	133	# -------------------------------------------------------------------
452bac1b	134	# and we support regexp delegation
	135
	136	{
	137	package Baz;
452bac1b	138	use Moose;
	139
	140	sub foo { 'Baz::foo' }
d03bd989	141	sub bar { 'Baz::bar' }
d03bd989	142	sub boo { 'Baz::boo' }
452bac1b	143
452bac1b	144	package Baz::Proxy1;
d03bd989	145	use Moose;
d03bd989	146
452bac1b	147	has 'baz' => (
	148	is => 'ro',
	149	isa => 'Baz',
	150	default => sub { Baz->new },
	151	handles => qr/.*/
	152	);
d03bd989	153
452bac1b	154	package Baz::Proxy2;
d03bd989	155	use Moose;
d03bd989	156
452bac1b	157	has 'baz' => (
	158	is => 'ro',
	159	isa => 'Baz',
	160	default => sub { Baz->new },
	161	handles => qr/.oo/
d03bd989	162	);
d03bd989	163
452bac1b	164	package Baz::Proxy3;
d03bd989	165	use Moose;
d03bd989	166
452bac1b	167	has 'baz' => (
	168	is => 'ro',
	169	isa => 'Baz',
	170	default => sub { Baz->new },
	171	handles => qr/b.*/
d03bd989	172	);
452bac1b	173	}
	174
	175	{
	176	my $baz_proxy = Baz::Proxy1->new;
	177	isa_ok($baz_proxy, 'Baz::Proxy1');
	178
	179	can_ok($baz_proxy, 'baz');
	180	isa_ok($baz_proxy->baz, 'Baz');
	181
	182	can_ok($baz_proxy, 'foo');
	183	can_ok($baz_proxy, 'bar');
	184	can_ok($baz_proxy, 'boo');
d03bd989	185
452bac1b	186	is($baz_proxy->foo, 'Baz::foo', '... got the right proxied return value');
452bac1b	187	is($baz_proxy->bar, 'Baz::bar', '... got the right proxied return value');
d03bd989	188	is($baz_proxy->boo, 'Baz::boo', '... got the right proxied return value');
452bac1b	189	}
	190	{
	191	my $baz_proxy = Baz::Proxy2->new;
	192	isa_ok($baz_proxy, 'Baz::Proxy2');
	193
	194	can_ok($baz_proxy, 'baz');
	195	isa_ok($baz_proxy->baz, 'Baz');
	196
	197	can_ok($baz_proxy, 'foo');
	198	can_ok($baz_proxy, 'boo');
d03bd989	199
452bac1b	200	is($baz_proxy->foo, 'Baz::foo', '... got the right proxied return value');
d03bd989	201	is($baz_proxy->boo, 'Baz::boo', '... got the right proxied return value');
452bac1b	202	}
	203	{
	204	my $baz_proxy = Baz::Proxy3->new;
	205	isa_ok($baz_proxy, 'Baz::Proxy3');
	206
	207	can_ok($baz_proxy, 'baz');
	208	isa_ok($baz_proxy->baz, 'Baz');
	209
	210	can_ok($baz_proxy, 'bar');
	211	can_ok($baz_proxy, 'boo');
d03bd989	212
452bac1b	213	is($baz_proxy->bar, 'Baz::bar', '... got the right proxied return value');
d03bd989	214	is($baz_proxy->boo, 'Baz::boo', '... got the right proxied return value');
452bac1b	215	}
452bac1b	216
f4f3e701	217	# -------------------------------------------------------------------
	218	# ROLE handles
	219	# -------------------------------------------------------------------
	220
c84f324f	221	{
	222	package Foo::Bar;
	223	use Moose::Role;
d03bd989	224
c84f324f	225	requires 'foo';
c84f324f	226	requires 'bar';
d03bd989	227
c84f324f	228	package Foo::Baz;
c84f324f	229	use Moose;
d03bd989	230
c84f324f	231	sub foo { 'Foo::Baz::FOO' }
c84f324f	232	sub bar { 'Foo::Baz::BAR' }
d03bd989	233	sub baz { 'Foo::Baz::BAZ' }
d03bd989	234
c84f324f	235	package Foo::Thing;
c84f324f	236	use Moose;
d03bd989	237
c84f324f	238	has 'thing' => (
d03bd989	239	is => 'rw',
c84f324f	240	isa => 'Foo::Baz',
	241	handles => 'Foo::Bar',
	242	);
	243
	244	}
	245
	246	{
	247	my $foo = Foo::Thing->new(thing => Foo::Baz->new);
	248	isa_ok($foo, 'Foo::Thing');
	249	isa_ok($foo->thing, 'Foo::Baz');
d03bd989	250
c84f324f	251	ok($foo->meta->has_method('foo'), '... we have the method we expect');
c84f324f	252	ok($foo->meta->has_method('bar'), '... we have the method we expect');
d03bd989	253	ok(!$foo->meta->has_method('baz'), '... we dont have the method we expect');
	254
	255	is($foo->foo, 'Foo::Baz::FOO', '... got the right value');
c84f324f	256	is($foo->bar, 'Foo::Baz::BAR', '... got the right value');
d03bd989	257	is($foo->thing->baz, 'Foo::Baz::BAZ', '... got the right value');
c84f324f	258	}
c84f324f	259
e902b1a5	260	# -------------------------------------------------------------------
	261	# AUTOLOAD & handles
	262	# -------------------------------------------------------------------
	263
	264	{
	265	package Foo::Autoloaded;
	266	use Moose;
	267
	268	sub AUTOLOAD {
	269	my $self = shift;
	270
	271	my $name = our $AUTOLOAD;
	272	$name =~ s/.*://; # strip fully-qualified portion
	273
	274	if (@_) {
	275	return $self->{$name} = shift;
	276	} else {
	277	return $self->{$name};
	278	}
	279	}
	280
	281	package Bar::Autoloaded;
d03bd989	282	use Moose;
d03bd989	283
e902b1a5	284	has 'foo' => (
	285	is => 'rw',
	286	default => sub { Foo::Autoloaded->new },
	287	handles => { 'foo_bar' => 'bar' }
	288	);
d03bd989	289
e902b1a5	290	package Baz::Autoloaded;
d03bd989	291	use Moose;
d03bd989	292
e902b1a5	293	has 'foo' => (
	294	is => 'rw',
	295	default => sub { Foo::Autoloaded->new },
	296	handles => ['bar']
d03bd989	297	);
d03bd989	298
e902b1a5	299	package Goorch::Autoloaded;
d03bd989	300	use Moose;
d03bd989	301
e902b1a5	302	::dies_ok {
	303	has 'foo' => (
	304	is => 'rw',
	305	default => sub { Foo::Autoloaded->new },
	306	handles => qr/bar/
d03bd989	307	);
e902b1a5	308	} '... you cannot delegate to AUTOLOADED class with regexp';
	309	}
	310
	311	# check HASH based delegation w/ AUTOLOAD
	312
	313	{
	314	my $bar = Bar::Autoloaded->new;
	315	isa_ok($bar, 'Bar::Autoloaded');
	316
	317	ok($bar->foo, '... we have something in bar->foo');
	318	isa_ok($bar->foo, 'Foo::Autoloaded');
	319
	320	# change the value ...
	321
	322	$bar->foo->bar(30);
	323
	324	# and make sure the delegation picks it up
	325
	326	is($bar->foo->bar, 30, '... bar->foo->bar returned the right (changed) value');
	327	is($bar->foo_bar, 30, '... bar->foo_bar delegated correctly');
	328
	329	# change the value through the delegation ...
	330
	331	$bar->foo_bar(50);
	332
d03bd989	333	# and make sure everyone sees it
e902b1a5	334
	335	is($bar->foo->bar, 50, '... bar->foo->bar returned the right (changed) value');
	336	is($bar->foo_bar, 50, '... bar->foo_bar delegated correctly');
	337
	338	# change the object we are delegating too
	339
	340	my $foo = Foo::Autoloaded->new;
	341	isa_ok($foo, 'Foo::Autoloaded');
	342
	343	$foo->bar(25);
d03bd989	344
e902b1a5	345	is($foo->bar, 25, '... got the right foo->bar');
	346
	347	lives_ok {
	348	$bar->foo($foo);
	349	} '... assigned the new Foo to Bar->foo';
	350
	351	is($bar->foo, $foo, '... assigned bar->foo with the new Foo');
	352
	353	is($bar->foo->bar, 25, '... bar->foo->bar returned the right result');
	354	is($bar->foo_bar, 25, '... and bar->foo_bar delegated correctly again');
	355	}
	356
	357	# check ARRAY based delegation w/ AUTOLOAD
	358
	359	{
	360	my $baz = Baz::Autoloaded->new;
	361	isa_ok($baz, 'Baz::Autoloaded');
	362
	363	ok($baz->foo, '... we have something in baz->foo');
	364	isa_ok($baz->foo, 'Foo::Autoloaded');
	365
	366	# change the value ...
	367
	368	$baz->foo->bar(30);
	369
	370	# and make sure the delegation picks it up
	371
	372	is($baz->foo->bar, 30, '... baz->foo->bar returned the right (changed) value');
	373	is($baz->bar, 30, '... baz->foo_bar delegated correctly');
	374
	375	# change the value through the delegation ...
	376
	377	$baz->bar(50);
	378
d03bd989	379	# and make sure everyone sees it
e902b1a5	380
	381	is($baz->foo->bar, 50, '... baz->foo->bar returned the right (changed) value');
	382	is($baz->bar, 50, '... baz->foo_bar delegated correctly');
	383
	384	# change the object we are delegating too
	385
	386	my $foo = Foo::Autoloaded->new;
	387	isa_ok($foo, 'Foo::Autoloaded');
	388
	389	$foo->bar(25);
d03bd989	390
e902b1a5	391	is($foo->bar, 25, '... got the right foo->bar');
	392
	393	lives_ok {
	394	$baz->foo($foo);
	395	} '... assigned the new Foo to Baz->foo';
	396
	397	is($baz->foo, $foo, '... assigned baz->foo with the new Foo');
	398
	399	is($baz->foo->bar, 25, '... baz->foo->bar returned the right result');
	400	is($baz->bar, 25, '... and baz->foo_bar delegated correctly again');
	401	}
e1d6f0a3	402
	403	# Check that removing attributes removes their handles methods also.
	404	{
	405	{
	406	package Quux;
	407	use Moose;
d03bd989	408	has foo => (
d03bd989	409	isa => 'Foo',
e1d6f0a3	410	default => sub { Foo->new },
	411	handles => { 'foo_bar' => 'bar' }
	412	);
	413	}
	414	my $i = Quux->new;
	415	ok($i->meta->has_method('foo_bar'), 'handles method foo_bar is present');
	416	$i->meta->remove_attribute('foo');
	417	ok(!$i->meta->has_method('foo_bar'), 'handles method foo_bar is removed');
	418	}
	419