Commit | Line | Data |
7ab4d55d |
1 | use strict; |
2 | use warnings; |
3 | |
4 | use Test::More; |
be0ed157 |
5 | use Test::Fatal; |
7ab4d55d |
6 | |
7 | { |
8 | |
9 | package Foo; |
10 | use Moose; |
11 | use Moose::Util::TypeConstraints; |
12 | |
13 | subtype 'UCArray', as 'ArrayRef[Str]', where { |
14 | !grep {/[a-z]/} @{$_}; |
15 | }; |
16 | |
17 | coerce 'UCArray', from 'ArrayRef[Str]', via { |
18 | [ map { uc $_ } @{$_} ]; |
19 | }; |
20 | |
21 | has array => ( |
22 | traits => ['Array'], |
23 | is => 'rw', |
24 | isa => 'UCArray', |
25 | coerce => 1, |
26 | handles => { |
27 | push_array => 'push', |
28 | set_array => 'set', |
29 | }, |
30 | ); |
31 | |
32 | our @TriggerArgs; |
33 | |
34 | has lazy => ( |
35 | traits => ['Array'], |
36 | is => 'rw', |
37 | isa => 'UCArray', |
38 | coerce => 1, |
39 | lazy => 1, |
40 | default => sub { ['a'] }, |
41 | handles => { |
42 | push_lazy => 'push', |
43 | set_lazy => 'set', |
44 | }, |
45 | trigger => sub { @TriggerArgs = @_ }, |
46 | clearer => 'clear_lazy', |
47 | ); |
48 | } |
49 | |
50 | my $foo = Foo->new; |
51 | |
52 | { |
53 | $foo->array( [qw( A B C )] ); |
54 | |
55 | $foo->push_array('d'); |
56 | |
57 | is_deeply( |
58 | $foo->array, [qw( A B C D )], |
59 | 'push coerces the array' |
60 | ); |
61 | |
62 | $foo->set_array( 1 => 'x' ); |
63 | |
64 | is_deeply( |
65 | $foo->array, [qw( A X C D )], |
66 | 'set coerces the array' |
67 | ); |
68 | } |
69 | |
70 | { |
71 | $foo->push_lazy('d'); |
72 | |
73 | is_deeply( |
74 | $foo->lazy, [qw( A D )], |
75 | 'push coerces the array - lazy' |
76 | ); |
77 | |
78 | is_deeply( |
79 | \@Foo::TriggerArgs, |
80 | [ $foo, [qw( A D )], ['A'] ], |
81 | 'trigger receives expected arguments' |
82 | ); |
83 | |
84 | $foo->set_lazy( 2 => 'f' ); |
85 | |
86 | is_deeply( |
87 | $foo->lazy, [qw( A D F )], |
88 | 'set coerces the array - lazy' |
89 | ); |
90 | |
91 | is_deeply( |
92 | \@Foo::TriggerArgs, |
93 | [ $foo, [qw( A D F )], [qw( A D )] ], |
94 | 'trigger receives expected arguments' |
95 | ); |
96 | } |
97 | |
4490c1fe |
98 | { |
99 | package Thing; |
100 | use Moose; |
c7fb753e |
101 | |
4490c1fe |
102 | has thing => ( |
88334003 |
103 | is => 'ro', |
104 | isa => 'Str', |
4490c1fe |
105 | ); |
106 | } |
c7fb753e |
107 | |
4490c1fe |
108 | { |
109 | package Bar; |
110 | use Moose; |
111 | use Moose::Util::TypeConstraints; |
112 | |
113 | class_type 'Thing'; |
114 | |
115 | coerce 'Thing' |
116 | => from 'Str' |
88334003 |
117 | => via { Thing->new( thing => $_ ) }; |
4490c1fe |
118 | |
119 | subtype 'ArrayRefOfThings' |
7bf5e58d |
120 | => as 'ArrayRef[Thing]'; |
4490c1fe |
121 | |
122 | coerce 'ArrayRefOfThings' |
123 | => from 'ArrayRef[Str]' |
88334003 |
124 | => via { [ map { Thing->new( thing => $_ ) } @{$_} ] }; |
4490c1fe |
125 | |
126 | coerce 'ArrayRefOfThings' |
127 | => from 'Str' |
88334003 |
128 | => via { [ Thing->new( thing => $_ ) ] }; |
4490c1fe |
129 | |
130 | has array => ( |
131 | traits => ['Array'], |
132 | is => 'rw', |
133 | isa => 'ArrayRefOfThings', |
134 | coerce => 1, |
135 | handles => { |
7bf5e58d |
136 | push_array => 'push', |
137 | set_array => 'set', |
138 | insert_array => 'insert', |
139 | get_array => 'get', |
4490c1fe |
140 | }, |
141 | ); |
142 | } |
143 | |
7bf5e58d |
144 | { |
2d916fe1 |
145 | my $bar = Bar->new( array => [qw( a b c )] ); |
4490c1fe |
146 | |
4490c1fe |
147 | $bar->push_array('d'); |
4490c1fe |
148 | |
2d916fe1 |
149 | is( $bar->get_array(3)->thing, 'd', 'push coerces the array' ); |
e0af6205 |
150 | |
7bf5e58d |
151 | $bar->set_array( 3 => 'e' ); |
152 | |
153 | is( $bar->get_array(3)->thing, 'e', 'set coerces the new member' ); |
154 | |
155 | $bar->insert_array( 3 => 'f' ); |
156 | |
157 | is( $bar->get_array(3)->thing, 'f', 'insert coerces the new member' ); |
158 | } |
159 | |
160 | { |
161 | package Baz; |
162 | use Moose; |
163 | use Moose::Util::TypeConstraints; |
164 | |
165 | subtype 'SmallArrayRef' |
166 | => as 'ArrayRef' |
167 | => where { @{$_} <= 2 }; |
168 | |
169 | coerce 'SmallArrayRef' |
170 | => from 'ArrayRef' |
171 | => via { [ @{$_}[ -2, -1 ] ] }; |
172 | |
173 | has array => ( |
174 | traits => ['Array'], |
175 | is => 'rw', |
176 | isa => 'SmallArrayRef', |
177 | coerce => 1, |
178 | handles => { |
179 | push_array => 'push', |
180 | set_array => 'set', |
181 | insert_array => 'insert', |
182 | }, |
183 | ); |
184 | } |
185 | |
186 | { |
187 | my $baz = Baz->new( array => [ 1, 2, 3 ] ); |
188 | |
189 | is_deeply( |
190 | $baz->array, [ 2, 3 ], |
191 | 'coercion truncates array ref in constructor' |
192 | ); |
193 | |
194 | $baz->push_array(4); |
195 | |
196 | is_deeply( |
197 | $baz->array, [ 3, 4 ], |
198 | 'coercion truncates array ref on push' |
199 | ); |
200 | |
201 | $baz->insert_array( 1 => 5 ); |
202 | |
203 | is_deeply( |
204 | $baz->array, [ 5, 4 ], |
205 | 'coercion truncates array ref on insert' |
206 | ); |
207 | |
208 | $baz->push_array( 7, 8, 9 ); |
209 | |
210 | is_deeply( |
211 | $baz->array, [ 8, 9 ], |
212 | 'coercion truncates array ref on push' |
213 | ); |
4490c1fe |
214 | } |
215 | |
7ab4d55d |
216 | done_testing; |