Commit | Line | Data |
fde8e43f |
1 | #!/usr/bin/env perl |
2 | # This is automatically generated by author/import-moose-test.pl. |
3 | # DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! |
4 | use t::lib::MooseCompat; |
5 | use strict; |
6 | use warnings; |
7 | use Test::More; |
8 | use Test::Exception; |
9 | |
10 | { |
11 | use Mouse::Util::TypeConstraints; |
12 | use List::Util qw(sum); |
13 | |
14 | subtype 'A1', as 'ArrayRef[Int]'; |
15 | subtype 'A2', as 'ArrayRef', where { @$_ < 2 }; |
16 | subtype 'A3', as 'ArrayRef[Int]', where { sum @$_ < 5 }; |
17 | |
18 | no Mouse::Util::TypeConstraints; |
19 | } |
20 | |
21 | { |
22 | package Foo; |
23 | use Mouse; |
24 | |
25 | has array => ( |
26 | traits => ['Array'], |
27 | is => 'rw', |
28 | isa => 'ArrayRef', |
29 | handles => { |
30 | push_array => 'push', |
31 | }, |
32 | ); |
33 | has array_int => ( |
34 | traits => ['Array'], |
35 | is => 'rw', |
36 | isa => 'ArrayRef[Int]', |
37 | handles => { |
38 | push_array_int => 'push', |
39 | }, |
40 | ); |
41 | has a1 => ( |
42 | traits => ['Array'], |
43 | is => 'rw', |
44 | isa => 'A1', |
45 | handles => { |
46 | push_a1 => 'push', |
47 | }, |
48 | ); |
49 | has a2 => ( |
50 | traits => ['Array'], |
51 | is => 'rw', |
52 | isa => 'A2', |
53 | handles => { |
54 | push_a2 => 'push', |
55 | }, |
56 | ); |
57 | has a3 => ( |
58 | traits => ['Array'], |
59 | is => 'rw', |
60 | isa => 'A3', |
61 | handles => { |
62 | push_a3 => 'push', |
63 | }, |
64 | ); |
65 | } |
66 | |
67 | my $foo = Foo->new; |
68 | |
69 | { |
70 | my $array = []; |
71 | dies_ok { $foo->push_array('foo') } "can't push onto undef"; |
72 | |
73 | $foo->array($array); |
74 | is($foo->array, $array, "same ref"); |
75 | is_deeply($foo->array, [], "correct contents"); |
76 | |
77 | $foo->push_array('foo'); |
78 | is($foo->array, $array, "same ref"); |
79 | is_deeply($foo->array, ['foo'], "correct contents"); |
80 | } |
81 | |
82 | { |
83 | my $array = []; |
84 | dies_ok { $foo->push_array_int(1) } "can't push onto undef"; |
85 | |
86 | $foo->array_int($array); |
87 | is($foo->array_int, $array, "same ref"); |
88 | is_deeply($foo->array_int, [], "correct contents"); |
89 | |
90 | dies_ok { $foo->push_array_int('foo') } "can't push wrong type"; |
91 | is($foo->array_int, $array, "same ref"); |
92 | is_deeply($foo->array_int, [], "correct contents"); |
93 | @$array = (); |
94 | |
95 | $foo->push_array_int(1); |
96 | is($foo->array_int, $array, "same ref"); |
97 | is_deeply($foo->array_int, [1], "correct contents"); |
98 | } |
99 | |
100 | { |
101 | my $array = []; |
102 | dies_ok { $foo->push_a1('foo') } "can't push onto undef"; |
103 | |
104 | $foo->a1($array); |
105 | is($foo->a1, $array, "same ref"); |
106 | is_deeply($foo->a1, [], "correct contents"); |
107 | |
108 | { local $TODO = "type parameters aren't checked on subtypes"; |
109 | dies_ok { $foo->push_a1('foo') } "can't push wrong type"; |
110 | } |
111 | is($foo->a1, $array, "same ref"); |
112 | { local $TODO = "type parameters aren't checked on subtypes"; |
113 | is_deeply($foo->a1, [], "correct contents"); |
114 | } |
115 | @$array = (); |
116 | |
117 | $foo->push_a1(1); |
118 | is($foo->a1, $array, "same ref"); |
119 | is_deeply($foo->a1, [1], "correct contents"); |
120 | } |
121 | |
122 | { |
123 | my $array = []; |
124 | dies_ok { $foo->push_a2('foo') } "can't push onto undef"; |
125 | |
126 | $foo->a2($array); |
127 | is($foo->a2, $array, "same ref"); |
128 | is_deeply($foo->a2, [], "correct contents"); |
129 | |
130 | $foo->push_a2('foo'); |
131 | is($foo->a2, $array, "same ref"); |
132 | is_deeply($foo->a2, ['foo'], "correct contents"); |
133 | |
134 | { local $TODO = "overall tcs aren't checked"; |
135 | dies_ok { $foo->push_a2('bar') } "can't push more than one element"; |
136 | } |
137 | is($foo->a2, $array, "same ref"); |
138 | { local $TODO = "overall tcs aren't checked"; |
139 | is_deeply($foo->a2, ['foo'], "correct contents"); |
140 | } |
141 | } |
142 | |
143 | { |
144 | my $array = []; |
145 | dies_ok { $foo->push_a3(1) } "can't push onto undef"; |
146 | |
147 | $foo->a3($array); |
148 | is($foo->a3, $array, "same ref"); |
149 | is_deeply($foo->a3, [], "correct contents"); |
150 | |
151 | { local $TODO = "tc parameters aren't checked on subtypes"; |
152 | dies_ok { $foo->push_a3('foo') } "can't push non-int"; |
153 | } |
154 | { local $TODO = "overall tcs aren't checked"; |
155 | dies_ok { $foo->push_a3(100) } "can't violate overall type constraint"; |
156 | } |
157 | is($foo->a3, $array, "same ref"); |
158 | { local $TODO = "tc checks are broken"; |
159 | is_deeply($foo->a3, [], "correct contents"); |
160 | } |
161 | @$array = (); |
162 | |
163 | $foo->push_a3(1); |
164 | is($foo->a3, $array, "same ref"); |
165 | is_deeply($foo->a3, [1], "correct contents"); |
166 | |
167 | { local $TODO = "overall tcs aren't checked"; |
168 | dies_ok { $foo->push_a3(100) } "can't violate overall type constraint"; |
169 | } |
170 | is($foo->a3, $array, "same ref"); |
171 | { local $TODO = "overall tcs aren't checked"; |
172 | is_deeply($foo->a3, [1], "correct contents"); |
173 | } |
174 | @$array = (1); |
175 | |
176 | $foo->push_a3(3); |
177 | is($foo->a3, $array, "same ref"); |
178 | is_deeply($foo->a3, [1, 3], "correct contents"); |
179 | } |
180 | |
181 | done_testing; |