t/020_attributes/013_attr_dereference_test.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More;
   7 use Test::Exception;
   8
   9
  10 {
  11     package Customer;
  12     use Moose;
  13
  14     package Firm;
  15     use Moose;
  16     use Moose::Util::TypeConstraints;
  17
  18     ::lives_ok {
  19         has 'customers' => (
  20             is         => 'ro',
  21             isa        => subtype('ArrayRef' => where {
  22                             (blessed($_) && $_->isa('Customer') || return) for @$_; 1 }),
  23             auto_deref => 1,
  24         );
  25     } '... successfully created attr';
  26 }
  27
  28 {
  29     my $customer = Customer->new;
  30     isa_ok($customer, 'Customer');
  31
  32     my $firm = Firm->new(customers => [ $customer ]);
  33     isa_ok($firm, 'Firm');
  34
  35     can_ok($firm, 'customers');
  36
  37     is_deeply(
  38         [ $firm->customers ],
  39         [ $customer ],
  40         '... got the right dereferenced value'
  41     );
  42 }
  43
  44 {
  45     my $firm = Firm->new();
  46     isa_ok($firm, 'Firm');
  47
  48     can_ok($firm, 'customers');
  49
  50     is_deeply(
  51         [ $firm->customers ],
  52         [],
  53         '... got the right dereferenced value'
  54     );
  55 }
  56
  57 {
  58     package AutoDeref;
  59     use Moose;
  60
  61     has 'bar' => (
  62         is         => 'rw',
  63         isa        => 'ArrayRef[Int]',
  64         auto_deref => 1,
  65     );
  66 }
  67
  68 {
  69     my $autoderef = AutoDeref->new;
  70
  71     dies_ok {
  72         $autoderef->bar(1, 2, 3);
  73     } '... its auto-de-ref-ing, not auto-en-ref-ing';
  74
  75     lives_ok  {
  76         $autoderef->bar([ 1, 2, 3 ])
  77     } '... set the results of bar correctly';
  78
  79     is_deeply [ $autoderef->bar ], [ 1, 2, 3 ], '... auto-dereffed correctly';
  80 }
  81
  82 done_testing;