merge trunk to pluggable errors
[gitmo/Moose.git] / 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 }