X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F020_attributes%2F010_attribute_delegation.t;h=bcd4cc7bb7e6362b68960a766a5058dd83e82dc7;hb=4d438a84f437bcb3c43a04c27823b8b431cd3f55;hp=84890b9eefad33dbcce33df3eeda4676e6698f4e;hpb=ad5e9d0d22cc2da6d7533c650acba928b615a5d8;p=gitmo%2FMoose.git diff --git a/t/020_attributes/010_attribute_delegation.t b/t/020_attributes/010_attribute_delegation.t index 84890b9..bcd4cc7 100644 --- a/t/020_attributes/010_attribute_delegation.t +++ b/t/020_attributes/010_attribute_delegation.t @@ -3,11 +3,10 @@ use strict; use warnings; -use Test::More tests => 89; +use Test::More; use Test::Exception; - # ------------------------------------------------------------------- # HASH handles # ------------------------------------------------------------------- @@ -21,13 +20,19 @@ use Test::Exception; has 'bar' => (is => 'rw', default => 10); + sub baz { 42 } + package Bar; use Moose; has 'foo' => ( is => 'rw', default => sub { Foo->new }, - handles => { 'foo_bar' => 'bar' } + handles => { + 'foo_bar' => 'bar', + foo_baz => 'baz', + 'foo_bar_to_20' => [ bar => 20 ], + }, ); } @@ -81,6 +86,10 @@ 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 # ------------------------------------------------------------------- @@ -234,6 +243,15 @@ is($car->stop, 'Engine::stop', '... got the right value from ->stop'); handles => 'Foo::Bar', ); + package Foo::OtherThing; + use Moose; + use Moose::Util::TypeConstraints; + + has 'other_thing' => ( + is => 'rw', + isa => 'Foo::Baz', + handles => Moose::Util::TypeConstraints::find_type_constraint('Foo::Bar'), + ); } { @@ -250,6 +268,19 @@ is($car->stop, 'Engine::stop', '... got the right value from ->stop'); is($foo->thing->baz, 'Foo::Baz::BAZ', '... got the right value'); } +{ + my $foo = Foo::OtherThing->new(other_thing => Foo::Baz->new); + isa_ok($foo, 'Foo::OtherThing'); + isa_ok($foo->other_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->other_thing->baz, 'Foo::Baz::BAZ', '... got the right value'); +} # ------------------------------------------------------------------- # AUTOLOAD & handles # ------------------------------------------------------------------- @@ -262,7 +293,7 @@ is($car->stop, 'Engine::stop', '... got the right value from ->stop'); my $self = shift; my $name = our $AUTOLOAD; - $name =~ s/.*://; # strip fully-qualified portion + $name =~ s/.*://; # strip fully-qualified portion if (@_) { return $self->{$name} = shift; @@ -413,7 +444,16 @@ is($car->stop, 'Engine::stop', '... got the right value from ->stop'); # Make sure that a useful error message is thrown when the delegation target is # not an object { - my $i = Bar->new(foo => []); - throws_ok { $i->foo_bar } qr/is not an object \(got 'ARRAY/, + 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"; } + +done_testing;