File: 013_attr_dereference_test.t

package info (click to toggle)
libmoose-perl 1.09-2
  • links: PTS, VCS
  • area: main
  • in suites: squeeze
  • size: 3,004 kB
  • ctags: 1,472
  • sloc: perl: 25,387; makefile: 2
file content (82 lines) | stat: -rw-r--r-- 1,518 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
#!/usr/bin/perl

use strict;
use warnings;

use Test::More;
use Test::Exception;


{
    package Customer;
    use Moose;

    package Firm;
    use Moose;
    use Moose::Util::TypeConstraints;

    ::lives_ok {
        has 'customers' => (
            is         => 'ro',
            isa        => subtype('ArrayRef' => where {
                            (blessed($_) && $_->isa('Customer') || return) for @$_; 1 }),
            auto_deref => 1,
        );
    } '... successfully created attr';
}

{
    my $customer = Customer->new;
    isa_ok($customer, 'Customer');

    my $firm = Firm->new(customers => [ $customer ]);
    isa_ok($firm, 'Firm');

    can_ok($firm, 'customers');

    is_deeply(
        [ $firm->customers ],
        [ $customer ],
        '... got the right dereferenced value'
    );
}

{
    my $firm = Firm->new();
    isa_ok($firm, 'Firm');

    can_ok($firm, 'customers');

    is_deeply(
        [ $firm->customers ],
        [],
        '... got the right dereferenced value'
    );
}

{
    package AutoDeref;
    use Moose;

    has 'bar' => (
        is         => 'rw',
        isa        => 'ArrayRef[Int]',
        auto_deref => 1,
    );
}

{
    my $autoderef = AutoDeref->new;

    dies_ok {
        $autoderef->bar(1, 2, 3);
    } '... its auto-de-ref-ing, not auto-en-ref-ing';

    lives_ok  {
        $autoderef->bar([ 1, 2, 3 ])
    } '... set the results of bar correctly';

    is_deeply [ $autoderef->bar ], [ 1, 2, 3 ], '... auto-dereffed correctly';
}

done_testing;