t/020_attributes/013_attr_dereference_test.t

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