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