Commit | Line | Data |
06d16be0 |
1 | #!/usr/bin/env perl |
2 | use strict; |
3 | use warnings; |
4 | use Test::More; |
53a4d826 |
5 | use Test::Exception; |
06d16be0 |
6 | |
7 | { |
8 | use Moose::Util::TypeConstraints; |
9 | use List::Util qw(sum); |
10 | |
11 | subtype 'A1', as 'ArrayRef[Int]'; |
ee588adf |
12 | subtype 'A2', as 'ArrayRef', where { @$_ < 2 }; |
435e394d |
13 | subtype 'A3', as 'ArrayRef[Int]', where { ( sum(@$_) || 0 ) < 5 }; |
06d16be0 |
14 | |
15 | no Moose::Util::TypeConstraints; |
16 | } |
17 | |
18 | { |
19 | package Foo; |
20 | use Moose; |
21 | |
22 | has array => ( |
23 | traits => ['Array'], |
24 | is => 'rw', |
25 | isa => 'ArrayRef', |
26 | handles => { |
27 | push_array => 'push', |
28 | }, |
29 | ); |
30 | has array_int => ( |
31 | traits => ['Array'], |
32 | is => 'rw', |
33 | isa => 'ArrayRef[Int]', |
34 | handles => { |
35 | push_array_int => 'push', |
36 | }, |
37 | ); |
38 | has a1 => ( |
39 | traits => ['Array'], |
40 | is => 'rw', |
41 | isa => 'A1', |
42 | handles => { |
43 | push_a1 => 'push', |
44 | }, |
45 | ); |
46 | has a2 => ( |
47 | traits => ['Array'], |
48 | is => 'rw', |
49 | isa => 'A2', |
50 | handles => { |
51 | push_a2 => 'push', |
52 | }, |
53 | ); |
54 | has a3 => ( |
55 | traits => ['Array'], |
56 | is => 'rw', |
57 | isa => 'A3', |
58 | handles => { |
59 | push_a3 => 'push', |
60 | }, |
61 | ); |
62 | } |
63 | |
64 | my $foo = Foo->new; |
65 | |
66 | { |
ee588adf |
67 | $foo->array( [] ); |
68 | is_deeply( $foo->array, [], "array - correct contents" ); |
06d16be0 |
69 | |
70 | $foo->push_array('foo'); |
ee588adf |
71 | is_deeply( $foo->array, ['foo'], "array - correct contents" ); |
06d16be0 |
72 | } |
73 | |
74 | { |
ee588adf |
75 | $foo->array_int( [] ); |
76 | is_deeply( $foo->array_int, [], "array_int - correct contents" ); |
06d16be0 |
77 | |
53a4d826 |
78 | dies_ok { $foo->push_array_int('foo') } |
ee588adf |
79 | "array_int - can't push wrong type"; |
80 | is_deeply( $foo->array_int, [], "array_int - correct contents" ); |
06d16be0 |
81 | |
82 | $foo->push_array_int(1); |
ee588adf |
83 | is_deeply( $foo->array_int, [1], "array_int - correct contents" ); |
06d16be0 |
84 | } |
85 | |
86 | { |
53a4d826 |
87 | dies_ok { $foo->push_a1('foo') } "a1 - can't push onto undef"; |
ee588adf |
88 | |
89 | $foo->a1( [] ); |
90 | is_deeply( $foo->a1, [], "a1 - correct contents" ); |
91 | |
53a4d826 |
92 | dies_ok { $foo->push_a1('foo') } "a1 - can't push wrong type"; |
ee588adf |
93 | |
94 | is_deeply( $foo->a1, [], "a1 - correct contents" ); |
06d16be0 |
95 | |
96 | $foo->push_a1(1); |
ee588adf |
97 | is_deeply( $foo->a1, [1], "a1 - correct contents" ); |
06d16be0 |
98 | } |
99 | |
100 | { |
53a4d826 |
101 | dies_ok { $foo->push_a2('foo') } "a2 - can't push onto undef"; |
06d16be0 |
102 | |
ee588adf |
103 | $foo->a2( [] ); |
104 | is_deeply( $foo->a2, [], "a2 - correct contents" ); |
06d16be0 |
105 | |
106 | $foo->push_a2('foo'); |
ee588adf |
107 | is_deeply( $foo->a2, ['foo'], "a2 - correct contents" ); |
108 | |
53a4d826 |
109 | dies_ok { $foo->push_a2('bar') } "a2 - can't push more than one element"; |
ee588adf |
110 | |
111 | is_deeply( $foo->a2, ['foo'], "a2 - correct contents" ); |
06d16be0 |
112 | } |
113 | |
114 | { |
53a4d826 |
115 | dies_ok { $foo->push_a3(1) } "a3 - can't push onto undef"; |
ee588adf |
116 | |
117 | $foo->a3( [] ); |
118 | is_deeply( $foo->a3, [], "a3 - correct contents" ); |
119 | |
53a4d826 |
120 | dies_ok { $foo->push_a3('foo') } "a3 - can't push non-int"; |
ee588adf |
121 | |
53a4d826 |
122 | dies_ok { $foo->push_a3(100) } |
ee588adf |
123 | "a3 - can't violate overall type constraint"; |
124 | |
125 | is_deeply( $foo->a3, [], "a3 - correct contents" ); |
06d16be0 |
126 | |
127 | $foo->push_a3(1); |
ee588adf |
128 | is_deeply( $foo->a3, [1], "a3 - correct contents" ); |
129 | |
53a4d826 |
130 | dies_ok { $foo->push_a3(100) } |
ee588adf |
131 | "a3 - can't violate overall type constraint"; |
132 | |
133 | is_deeply( $foo->a3, [1], "a3 - correct contents" ); |
06d16be0 |
134 | |
135 | $foo->push_a3(3); |
ee588adf |
136 | is_deeply( $foo->a3, [ 1, 3 ], "a3 - correct contents" ); |
06d16be0 |
137 | } |
138 | |
139 | done_testing; |