t/072_attr_dereference_test.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 9;
   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 }