t/106_handles_foreign_class_bug.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 8;
   7 use Test::Exception;
   8
   9 {
  10     package Foo;
  11
  12     sub new {
  13         bless({}, 'Foo')
  14     }
  15
  16     sub a { 'Foo::a' }
  17 }
  18
  19 {
  20     package Bar;
  21     use Moose;
  22
  23     ::lives_ok {
  24         has 'baz' => (
  25             is      => 'ro',
  26             isa     => 'Foo',
  27             lazy    => 1,
  28             default => sub { Foo->new() },
  29             handles => qr/^a$/,
  30         );
  31     } '... can create the attribute with delegations';
  32
  33 }
  34
  35 my $bar;
  36 lives_ok {
  37     $bar = Bar->new;
  38 } '... created the object ok';
  39 isa_ok($bar, 'Bar');
  40
  41 is($bar->a, 'Foo::a', '... got the right delgated value');
  42
  43 {
  44     package Baz;
  45     use Moose;
  46
  47     ::lives_ok {
  48         has 'bar' => (
  49             is      => 'ro',
  50             isa     => 'Foo',
  51             lazy    => 1,
  52             default => sub { Foo->new() },
  53             handles => qr/.*/,
  54         );
  55     } '... can create the attribute with delegations';
  56
  57 }
  58
  59 my $baz;
  60 lives_ok {
  61     $baz = Baz->new;
  62 } '... created the object ok';
  63 isa_ok($baz, 'Baz');
  64
  65 is($baz->a, 'Foo::a', '... got the right delgated value');
  66
  67
  68
  69
  70
  71
  72
  73