diff options
Diffstat (limited to 't/bugs/handles_foreign_class_bug.t')
-rw-r--r-- | t/bugs/handles_foreign_class_bug.t | 111 |
1 files changed, 111 insertions, 0 deletions
diff --git a/t/bugs/handles_foreign_class_bug.t b/t/bugs/handles_foreign_class_bug.t new file mode 100644 index 0000000..4706d08 --- /dev/null +++ b/t/bugs/handles_foreign_class_bug.t @@ -0,0 +1,111 @@ +use strict; +use warnings; + +use Test::More; +use Test::Fatal; + +{ + package Foo; + + sub new { + bless({}, 'Foo') + } + + sub a { 'Foo::a' } + + $INC{'Foo.pm'} = __FILE__; +} + +{ + package Bar; + use Moose; + + ::is( ::exception { + has 'baz' => ( + is => 'ro', + isa => 'Foo', + lazy => 1, + default => sub { Foo->new() }, + handles => qr/^a$/, + ); + }, undef, '... can create the attribute with delegations' ); + +} + +my $bar; +is( exception { + $bar = Bar->new; +}, undef, '... created the object ok' ); +isa_ok($bar, 'Bar'); + +is($bar->a, 'Foo::a', '... got the right delgated value'); + +my @w; +$SIG{__WARN__} = sub { push @w, "@_" }; +{ + package Baz; + use Moose; + + ::is( ::exception { + has 'bar' => ( + is => 'ro', + isa => 'Foo', + lazy => 1, + default => sub { Foo->new() }, + handles => qr/.*/, + ); + }, undef, '... can create the attribute with delegations' ); + +} + +is(@w, 0, "no warnings"); + + +my $baz; +is( exception { + $baz = Baz->new; +}, undef, '... created the object ok' ); +isa_ok($baz, 'Baz'); + +is($baz->a, 'Foo::a', '... got the right delgated value'); + + + + + +@w = (); + +{ + package Blart; + use Moose; + + ::is( ::exception { + has 'bar' => ( + is => 'ro', + isa => 'Foo', + lazy => 1, + default => sub { Foo->new() }, + handles => [qw(a new)], + ); + }, undef, '... can create the attribute with delegations' ); + +} + +{ + local $TODO = "warning not yet implemented"; + + is(@w, 1, "one warning"); + like($w[0], qr/not delegating.*new/i, "warned"); +} + + + +my $blart; +is( exception { + $blart = Blart->new; +}, undef, '... created the object ok' ); +isa_ok($blart, 'Blart'); + +is($blart->a, 'Foo::a', '... got the right delgated value'); + +done_testing; |