8 use Moose::Util::TypeConstraints;
9 use List::Util qw(sum);
11 subtype 'A1', as 'ArrayRef[Int]';
12 subtype 'A2', as 'ArrayRef', where { @$_ < 2 };
13 subtype 'A3', as 'ArrayRef[Int]', where { sum @$_ < 5 };
15 no Moose::Util::TypeConstraints;
33 isa => 'ArrayRef[Int]',
35 push_array_int => 'push',
68 dies_ok { $foo->push_array('foo') } "can't push onto undef";
71 is($foo->array, $array, "same ref");
72 is_deeply($foo->array, [], "correct contents");
74 $foo->push_array('foo');
75 is($foo->array, $array, "same ref");
76 is_deeply($foo->array, ['foo'], "correct contents");
81 dies_ok { $foo->push_array_int(1) } "can't push onto undef";
83 $foo->array_int($array);
84 is($foo->array_int, $array, "same ref");
85 is_deeply($foo->array_int, [], "correct contents");
87 dies_ok { $foo->push_array_int('foo') } "can't push wrong type";
88 is($foo->array_int, $array, "same ref");
89 is_deeply($foo->array_int, [], "correct contents");
92 $foo->push_array_int(1);
93 is($foo->array_int, $array, "same ref");
94 is_deeply($foo->array_int, [1], "correct contents");
99 dies_ok { $foo->push_a1('foo') } "can't push onto undef";
102 is($foo->a1, $array, "same ref");
103 is_deeply($foo->a1, [], "correct contents");
105 { local $TODO = "type parameters aren't checked on subtypes";
106 dies_ok { $foo->push_a1('foo') } "can't push wrong type";
108 is($foo->a1, $array, "same ref");
109 { local $TODO = "type parameters aren't checked on subtypes";
110 is_deeply($foo->a1, [], "correct contents");
115 is($foo->a1, $array, "same ref");
116 is_deeply($foo->a1, [1], "correct contents");
121 dies_ok { $foo->push_a2('foo') } "can't push onto undef";
124 is($foo->a2, $array, "same ref");
125 is_deeply($foo->a2, [], "correct contents");
127 $foo->push_a2('foo');
128 is($foo->a2, $array, "same ref");
129 is_deeply($foo->a2, ['foo'], "correct contents");
131 { local $TODO = "overall tcs aren't checked";
132 dies_ok { $foo->push_a2('bar') } "can't push more than one element";
134 is($foo->a2, $array, "same ref");
135 { local $TODO = "overall tcs aren't checked";
136 is_deeply($foo->a2, ['foo'], "correct contents");
142 dies_ok { $foo->push_a3(1) } "can't push onto undef";
145 is($foo->a3, $array, "same ref");
146 is_deeply($foo->a3, [], "correct contents");
148 { local $TODO = "tc parameters aren't checked on subtypes";
149 dies_ok { $foo->push_a3('foo') } "can't push non-int";
151 { local $TODO = "overall tcs aren't checked";
152 dies_ok { $foo->push_a3(100) } "can't violate overall type constraint";
154 is($foo->a3, $array, "same ref");
155 { local $TODO = "tc checks are broken";
156 is_deeply($foo->a3, [], "correct contents");
161 is($foo->a3, $array, "same ref");
162 is_deeply($foo->a3, [1], "correct contents");
164 { local $TODO = "overall tcs aren't checked";
165 dies_ok { $foo->push_a3(100) } "can't violate overall type constraint";
167 is($foo->a3, $array, "same ref");
168 { local $TODO = "overall tcs aren't checked";
169 is_deeply($foo->a3, [1], "correct contents");
174 is($foo->a3, $array, "same ref");
175 is_deeply($foo->a3, [1, 3], "correct contents");