[gitmo/Mouse.git] / t / 020_attributes / failing / 010_attribute_delegation.t

#!/usr/bin/perl

use strict;
use warnings;

use Test::More tests => 92;
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 Mouse;

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

    sub baz { 42 }

    package Bar;
    use Mouse;

    has 'foo' => (
        is      => 'rw',
        default => sub { Foo->new },
        handles => {
            'foo_bar' => 'bar',
            foo_baz => 'baz',
            '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, 'Mouse::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 Mouse;

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

    package Car;
    use Mouse;

    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 Mouse;

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

    package Baz::Proxy1;
    use Mouse;

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

    package Baz::Proxy2;
    use Mouse;

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

    package Baz::Proxy3;
    use Mouse;

    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 Mouse::Role;

    requires 'foo';
    requires 'bar';

    package Foo::Baz;
    use Mouse;

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

    package Foo::Thing;
    use Mouse;

    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 Mouse;

    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 Mouse;

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

    package Baz::Autoloaded;
    use Mouse;

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

    package Goorch::Autoloaded;
    use Mouse;

    ::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 Mouse;
        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');
}

# Make sure that a useful error message is thrown when the delegation target is
# not an object
{
    my $i = Bar->new(foo => undef);
    throws_ok { $i->foo_bar } qr/is not defined/,
        'useful error from unblessed reference';

    my $j = Bar->new(foo => []);
    throws_ok { $j->foo_bar } qr/is not an object \(got 'ARRAY/,
        'useful error from unblessed reference';

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