Commit | Line | Data |
e3c07b19 |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
8b9641b8 |
6 | use lib 't/lib'; |
7 | |
a7821be5 |
8 | use Moose (); |
bbeb5798 |
9 | use Moose::Util::TypeConstraints; |
8b9641b8 |
10 | use NoInlineAttribute; |
a28e50e4 |
11 | use Test::More; |
b10dde3a |
12 | use Test::Fatal; |
37ecda0d |
13 | use Test::Moose; |
d50fc84a |
14 | |
e3c07b19 |
15 | { |
a7821be5 |
16 | my %handles = ( |
17 | count => 'count', |
18 | elements => 'elements', |
19 | is_empty => 'is_empty', |
20 | push => 'push', |
21 | push_curried => |
22 | [ push => 42, 84 ], |
23 | unshift => 'unshift', |
24 | unshift_curried => |
25 | [ unshift => 42, 84 ], |
26 | pop => 'pop', |
27 | shift => 'shift', |
28 | get => 'get', |
29 | get_curried => [ get => 1 ], |
30 | set => 'set', |
31 | set_curried_1 => [ set => 1 ], |
32 | set_curried_2 => [ set => ( 1, 98 ) ], |
33 | accessor => 'accessor', |
34 | accessor_curried_1 => [ accessor => 1 ], |
35 | accessor_curried_2 => [ accessor => ( 1, 90 ) ], |
36 | clear => 'clear', |
37 | delete => 'delete', |
38 | delete_curried => [ delete => 1 ], |
39 | insert => 'insert', |
40 | insert_curried => [ insert => ( 1, 101 ) ], |
41 | splice => 'splice', |
42 | splice_curried_1 => [ splice => 1 ], |
43 | splice_curried_2 => [ splice => 1, 2 ], |
44 | splice_curried_all => [ splice => 1, 2, ( 3, 4, 5 ) ], |
45 | sort => 'sort', |
46 | sort_curried => [ sort => ( sub { $_[1] <=> $_[0] } ) ], |
47 | sort_in_place => 'sort_in_place', |
48 | sort_in_place_curried => |
49 | [ sort_in_place => ( sub { $_[1] <=> $_[0] } ) ], |
50 | map => 'map', |
51 | map_curried => [ map => ( sub { $_ + 1 } ) ], |
52 | grep => 'grep', |
53 | grep_curried => [ grep => ( sub { $_ < 5 } ) ], |
54 | first => 'first', |
55 | first_curried => [ first => ( sub { $_ % 2 } ) ], |
175f9180 |
56 | first_index => 'first_index', |
57 | first_index_curried => [ first_index => ( sub { $_ % 2 } ) ], |
a7821be5 |
58 | join => 'join', |
59 | join_curried => [ join => '-' ], |
60 | shuffle => 'shuffle', |
61 | uniq => 'uniq', |
62 | reduce => 'reduce', |
63 | reduce_curried => [ reduce => ( sub { $_[0] * $_[1] } ) ], |
64 | natatime => 'natatime', |
65 | natatime_curried => [ natatime => 2 ], |
e3c07b19 |
66 | ); |
a7821be5 |
67 | |
68 | my $name = 'Foo1'; |
69 | |
70 | sub build_class { |
71 | my %attr = @_; |
72 | |
73 | my $class = Moose::Meta::Class->create( |
74 | $name++, |
75 | superclasses => ['Moose::Object'], |
76 | ); |
77 | |
8b9641b8 |
78 | my @traits = 'Array'; |
79 | push @traits, 'NoInlineAttribute' |
80 | if delete $attr{no_inline}; |
81 | |
a7821be5 |
82 | $class->add_attribute( |
83 | _values => ( |
8b9641b8 |
84 | traits => \@traits, |
a7821be5 |
85 | is => 'rw', |
86 | isa => 'ArrayRef[Int]', |
87 | default => sub { [] }, |
88 | handles => \%handles, |
89 | clearer => '_clear_values', |
90 | %attr, |
91 | ), |
92 | ); |
93 | |
94 | return ( $class->name, \%handles ); |
95 | } |
e3c07b19 |
96 | } |
97 | |
862b6081 |
98 | { |
88e88a7b |
99 | package Overloader; |
100 | |
101 | use overload |
102 | '&{}' => sub { ${ $_[0] } }, |
103 | bool => sub {1}; |
104 | |
105 | sub new { |
106 | bless \$_[1], $_[0]; |
107 | } |
108 | } |
109 | |
110 | { |
48b6c41f |
111 | package OverloadStr; |
112 | use overload |
113 | q{""} => sub { ${ $_[0] } }, |
114 | fallback => 1; |
115 | |
116 | sub new { |
117 | my $class = shift; |
118 | my $str = shift; |
119 | return bless \$str, $class; |
120 | } |
121 | } |
122 | |
123 | { |
a7821be5 |
124 | run_tests(build_class); |
125 | run_tests( build_class( lazy => 1, default => sub { [ 42, 84 ] } ) ); |
cf0da4e2 |
126 | run_tests( build_class( trigger => sub { } ) ); |
8b9641b8 |
127 | run_tests( build_class( no_inline => 1 ) ); |
bbeb5798 |
128 | |
129 | # Will force the inlining code to check the entire arrayref when it is modified. |
130 | subtype 'MyArrayRef', as 'ArrayRef', where { 1 }; |
131 | |
132 | run_tests( build_class( isa => 'MyArrayRef' ) ); |
133 | |
134 | coerce 'MyArrayRef', from 'ArrayRef', via { $_ }; |
135 | |
136 | run_tests( build_class( isa => 'MyArrayRef', coerce => 1 ) ); |
a7821be5 |
137 | } |
e3c07b19 |
138 | |
a7821be5 |
139 | sub run_tests { |
140 | my ( $class, $handles ) = @_; |
e3c07b19 |
141 | |
a7821be5 |
142 | can_ok( $class, $_ ) for sort keys %{$handles}; |
e3c07b19 |
143 | |
a7821be5 |
144 | with_immutable { |
145 | my $obj = $class->new( _values => [ 10, 12, 42 ] ); |
e3c07b19 |
146 | |
a7821be5 |
147 | is_deeply( |
148 | $obj->_values, [ 10, 12, 42 ], |
149 | 'values can be set in constructor' |
150 | ); |
e3c07b19 |
151 | |
a7821be5 |
152 | ok( !$obj->is_empty, 'values is not empty' ); |
153 | is( $obj->count, 3, 'count returns 3' ); |
e3c07b19 |
154 | |
b10dde3a |
155 | like( exception { $obj->count(22) }, qr/Cannot call count with any arguments/, 'throws an error when passing an argument passed to count' ); |
e3c07b19 |
156 | |
b10dde3a |
157 | is( exception { $obj->push( 1, 2, 3 ) }, undef, 'pushed three new values and lived' ); |
e3c07b19 |
158 | |
b10dde3a |
159 | is( exception { $obj->push() }, undef, 'call to push without arguments lives' ); |
e3c07b19 |
160 | |
b10dde3a |
161 | is( exception { |
7f5ec80d |
162 | is( $obj->unshift( 101, 22 ), 8, |
163 | 'unshift returns size of the new array' ); |
b10dde3a |
164 | }, undef, 'unshifted two values and lived' ); |
e3c07b19 |
165 | |
e32b7489 |
166 | is_deeply( |
167 | $obj->_values, [ 101, 22, 10, 12, 42, 1, 2, 3 ], |
168 | 'unshift changed the value of the array in the object' |
169 | ); |
170 | |
b10dde3a |
171 | is( exception { $obj->unshift() }, undef, 'call to unshift without arguments lives' ); |
e3c07b19 |
172 | |
a7821be5 |
173 | is( $obj->pop, 3, 'pop returns the last value in the array' ); |
910684ee |
174 | |
a7821be5 |
175 | is_deeply( |
176 | $obj->_values, [ 101, 22, 10, 12, 42, 1, 2 ], |
177 | 'pop changed the value of the array in the object' |
178 | ); |
910684ee |
179 | |
b10dde3a |
180 | like( exception { $obj->pop(42) }, qr/Cannot call pop with any arguments/, 'call to pop with arguments dies' ); |
910684ee |
181 | |
a7821be5 |
182 | is( $obj->shift, 101, 'shift returns the first value' ); |
910684ee |
183 | |
b10dde3a |
184 | like( exception { $obj->shift(42) }, qr/Cannot call shift with any arguments/, 'call to shift with arguments dies' ); |
e3c07b19 |
185 | |
a7821be5 |
186 | is_deeply( |
187 | $obj->_values, [ 22, 10, 12, 42, 1, 2 ], |
188 | 'shift changed the value of the array in the object' |
189 | ); |
e3c07b19 |
190 | |
a7821be5 |
191 | is_deeply( |
192 | [ $obj->elements ], [ 22, 10, 12, 42, 1, 2 ], |
193 | 'call to elements returns values as a list' |
194 | ); |
e3c07b19 |
195 | |
b10dde3a |
196 | like( exception { $obj->elements(22) }, qr/Cannot call elements with any arguments/, 'throws an error when passing an argument passed to elements' ); |
e3c07b19 |
197 | |
a7821be5 |
198 | $obj->_values( [ 1, 2, 3 ] ); |
e3c07b19 |
199 | |
a7821be5 |
200 | is( $obj->get(0), 1, 'get values at index 0' ); |
201 | is( $obj->get(1), 2, 'get values at index 1' ); |
202 | is( $obj->get(2), 3, 'get values at index 2' ); |
203 | is( $obj->get_curried, 2, 'get_curried returns value at index 1' ); |
e3c07b19 |
204 | |
b10dde3a |
205 | like( exception { $obj->get() }, qr/Cannot call get without at least 1 argument/, 'throws an error when get is called without any arguments' ); |
e3c07b19 |
206 | |
b10dde3a |
207 | like( exception { $obj->get( {} ) }, qr/The index passed to get must be an integer/, 'throws an error when get is called with an invalid argument' ); |
e3c07b19 |
208 | |
b10dde3a |
209 | like( exception { $obj->get(2.2) }, qr/The index passed to get must be an integer/, 'throws an error when get is called with an invalid argument' ); |
e3c07b19 |
210 | |
b10dde3a |
211 | like( exception { $obj->get('foo') }, qr/The index passed to get must be an integer/, 'throws an error when get is called with an invalid argument' ); |
e3c07b19 |
212 | |
b10dde3a |
213 | like( exception { $obj->get_curried(2) }, qr/Cannot call get with more than 1 argument/, 'throws an error when get_curried is called with an argument' ); |
e3c07b19 |
214 | |
b10dde3a |
215 | is( exception { |
7f5ec80d |
216 | is( $obj->set( 1, 100 ), 100, 'set returns new value' ); |
b10dde3a |
217 | }, undef, 'set value at index 1 lives' ); |
e3c07b19 |
218 | |
a7821be5 |
219 | is( $obj->get(1), 100, 'get value at index 1 returns new value' ); |
e3c07b19 |
220 | |
7f5ec80d |
221 | |
b10dde3a |
222 | like( exception { $obj->set( 1, 99, 42 ) }, qr/Cannot call set with more than 2 arguments/, 'throws an error when set is called with three arguments' ); |
59de9de4 |
223 | |
b10dde3a |
224 | is( exception { $obj->set_curried_1(99) }, undef, 'set_curried_1 lives' ); |
59de9de4 |
225 | |
a7821be5 |
226 | is( $obj->get(1), 99, 'get value at index 1 returns new value' ); |
59de9de4 |
227 | |
b10dde3a |
228 | like( exception { $obj->set_curried_1( 99, 42 ) }, qr/Cannot call set with more than 2 arguments/, 'throws an error when set_curried_1 is called with two arguments' ); |
59de9de4 |
229 | |
b10dde3a |
230 | is( exception { $obj->set_curried_2 }, undef, 'set_curried_2 lives' ); |
59de9de4 |
231 | |
a7821be5 |
232 | is( $obj->get(1), 98, 'get value at index 1 returns new value' ); |
59de9de4 |
233 | |
b10dde3a |
234 | like( exception { $obj->set_curried_2(42) }, qr/Cannot call set with more than 2 arguments/, 'throws an error when set_curried_2 is called with one argument' ); |
59de9de4 |
235 | |
a7821be5 |
236 | is( |
237 | $obj->accessor(1), 98, |
238 | 'accessor with one argument returns value at index 1' |
239 | ); |
59de9de4 |
240 | |
b10dde3a |
241 | is( exception { |
7f5ec80d |
242 | is( $obj->accessor( 1 => 97 ), 97, 'accessor returns new value' ); |
b10dde3a |
243 | }, undef, 'accessor as writer lives' ); |
59de9de4 |
244 | |
8fc30049 |
245 | like( |
246 | exception { |
247 | $obj->accessor; |
248 | }, |
249 | qr/Cannot call accessor without at least 1 argument/, |
250 | 'throws an error when accessor is called without arguments' |
251 | ); |
252 | |
a7821be5 |
253 | is( |
254 | $obj->get(1), 97, |
255 | 'accessor set value at index 1' |
256 | ); |
862b6081 |
257 | |
b10dde3a |
258 | like( exception { $obj->accessor( 1, 96, 42 ) }, qr/Cannot call accessor with more than 2 arguments/, 'throws an error when accessor is called with three arguments' ); |
59de9de4 |
259 | |
a7821be5 |
260 | is( |
261 | $obj->accessor_curried_1, 97, |
262 | 'accessor_curried_1 returns expected value when called with no arguments' |
263 | ); |
59de9de4 |
264 | |
b10dde3a |
265 | is( exception { $obj->accessor_curried_1(95) }, undef, 'accessor_curried_1 as writer lives' ); |
862b6081 |
266 | |
a7821be5 |
267 | is( |
268 | $obj->get(1), 95, |
269 | 'accessor_curried_1 set value at index 1' |
270 | ); |
862b6081 |
271 | |
b10dde3a |
272 | like( exception { $obj->accessor_curried_1( 96, 42 ) }, qr/Cannot call accessor with more than 2 arguments/, 'throws an error when accessor_curried_1 is called with two arguments' ); |
862b6081 |
273 | |
b10dde3a |
274 | is( exception { $obj->accessor_curried_2 }, undef, 'accessor_curried_2 as writer lives' ); |
862b6081 |
275 | |
a7821be5 |
276 | is( |
277 | $obj->get(1), 90, |
278 | 'accessor_curried_2 set value at index 1' |
279 | ); |
862b6081 |
280 | |
b10dde3a |
281 | like( exception { $obj->accessor_curried_2(42) }, qr/Cannot call accessor with more than 2 arguments/, 'throws an error when accessor_curried_2 is called with one argument' ); |
862b6081 |
282 | |
b10dde3a |
283 | is( exception { $obj->clear }, undef, 'clear lives' ); |
862b6081 |
284 | |
a7821be5 |
285 | ok( $obj->is_empty, 'values is empty after call to clear' ); |
862b6081 |
286 | |
805e018d |
287 | is( exception { |
288 | is( $obj->shift, undef, |
289 | 'shift returns undef on an empty array' ); |
290 | }, undef, 'shifted from an empty array and lived' ); |
291 | |
a7821be5 |
292 | $obj->set( 0 => 42 ); |
862b6081 |
293 | |
b10dde3a |
294 | like( exception { $obj->clear(50) }, qr/Cannot call clear with any arguments/, 'throws an error when clear is called with an argument' ); |
862b6081 |
295 | |
a7821be5 |
296 | ok( |
297 | !$obj->is_empty, |
298 | 'values is not empty after failed call to clear' |
299 | ); |
59de9de4 |
300 | |
b10dde3a |
301 | like( exception { $obj->is_empty(50) }, qr/Cannot call is_empty with any arguments/, 'throws an error when is_empty is called with an argument' ); |
8b9641b8 |
302 | |
a7821be5 |
303 | $obj->clear; |
7f5ec80d |
304 | is( |
305 | $obj->push( 1, 5, 10, 42 ), 4, |
306 | 'pushed 4 elements, got number of elements in the array back' |
307 | ); |
59de9de4 |
308 | |
b10dde3a |
309 | is( exception { |
7f5ec80d |
310 | is( $obj->delete(2), 10, 'delete returns deleted value' ); |
b10dde3a |
311 | }, undef, 'delete lives' ); |
59de9de4 |
312 | |
a7821be5 |
313 | is_deeply( |
314 | $obj->_values, [ 1, 5, 42 ], |
315 | 'delete removed the specified element' |
316 | ); |
e3c07b19 |
317 | |
b10dde3a |
318 | like( exception { $obj->delete( 2, 3 ) }, qr/Cannot call delete with more than 1 argument/, 'throws an error when delete is called with two arguments' ); |
59de9de4 |
319 | |
b10dde3a |
320 | is( exception { $obj->delete_curried }, undef, 'delete_curried lives' ); |
910684ee |
321 | |
a7821be5 |
322 | is_deeply( |
323 | $obj->_values, [ 1, 42 ], |
324 | 'delete removed the specified element' |
325 | ); |
910684ee |
326 | |
b10dde3a |
327 | like( exception { $obj->delete_curried(2) }, qr/Cannot call delete with more than 1 argument/, 'throws an error when delete_curried is called with one argument' ); |
e3c07b19 |
328 | |
b10dde3a |
329 | is( exception { $obj->insert( 1, 21 ) }, undef, 'insert lives' ); |
910684ee |
330 | |
a7821be5 |
331 | is_deeply( |
332 | $obj->_values, [ 1, 21, 42 ], |
333 | 'insert added the specified element' |
334 | ); |
910684ee |
335 | |
b10dde3a |
336 | like( exception { $obj->insert( 1, 22, 44 ) }, qr/Cannot call insert with more than 2 arguments/, 'throws an error when insert is called with three arguments' ); |
59de9de4 |
337 | |
b10dde3a |
338 | is( exception { |
7f5ec80d |
339 | is_deeply( |
340 | [ $obj->splice( 1, 0, 2, 3 ) ], |
341 | [], |
342 | 'return value of splice is empty list when not removing elements' |
343 | ); |
b10dde3a |
344 | }, undef, 'splice lives' ); |
910684ee |
345 | |
a7821be5 |
346 | is_deeply( |
347 | $obj->_values, [ 1, 2, 3, 21, 42 ], |
348 | 'splice added the specified elements' |
349 | ); |
910684ee |
350 | |
b10dde3a |
351 | is( exception { |
7f5ec80d |
352 | is_deeply( |
353 | [ $obj->splice( 1, 2, 99 ) ], |
354 | [ 2, 3 ], |
355 | 'splice returns list of removed values' |
356 | ); |
b10dde3a |
357 | }, undef, 'splice lives' ); |
e3c07b19 |
358 | |
a7821be5 |
359 | is_deeply( |
7f5ec80d |
360 | $obj->_values, [ 1, 99, 21, 42 ], |
a7821be5 |
361 | 'splice added the specified elements' |
362 | ); |
e3c07b19 |
363 | |
b10dde3a |
364 | like( exception { $obj->splice() }, qr/Cannot call splice without at least 1 argument/, 'throws an error when splice is called with no arguments' ); |
910684ee |
365 | |
b10dde3a |
366 | like( exception { $obj->splice( 1, 'foo', ) }, qr/The length argument passed to splice must be an integer/, 'throws an error when splice is called with an invalid length' ); |
e3181911 |
367 | |
b10dde3a |
368 | is( exception { $obj->splice_curried_1( 2, 101 ) }, undef, 'splice_curried_1 lives' ); |
910684ee |
369 | |
a7821be5 |
370 | is_deeply( |
7f5ec80d |
371 | $obj->_values, [ 1, 101, 42 ], |
a7821be5 |
372 | 'splice added the specified elements' |
373 | ); |
59de9de4 |
374 | |
b10dde3a |
375 | is( exception { $obj->splice_curried_2(102) }, undef, 'splice_curried_2 lives' ); |
862b6081 |
376 | |
a7821be5 |
377 | is_deeply( |
7f5ec80d |
378 | $obj->_values, [ 1, 102 ], |
a7821be5 |
379 | 'splice added the specified elements' |
380 | ); |
862b6081 |
381 | |
b10dde3a |
382 | is( exception { $obj->splice_curried_all }, undef, 'splice_curried_all lives' ); |
862b6081 |
383 | |
a7821be5 |
384 | is_deeply( |
385 | $obj->_values, [ 1, 3, 4, 5 ], |
386 | 'splice added the specified elements' |
387 | ); |
59de9de4 |
388 | |
7f5ec80d |
389 | is_deeply( |
390 | scalar $obj->splice( 1, 2 ), |
391 | 4, |
392 | 'splice in scalar context returns last element removed' |
393 | ); |
394 | |
395 | is_deeply( |
396 | scalar $obj->splice( 1, 0, 42 ), |
397 | undef, |
398 | 'splice in scalar context returns undef when no elements are removed' |
399 | ); |
400 | |
a7821be5 |
401 | $obj->_values( [ 3, 9, 5, 22, 11 ] ); |
862b6081 |
402 | |
a7821be5 |
403 | is_deeply( |
404 | [ $obj->sort ], [ 11, 22, 3, 5, 9 ], |
405 | 'sort returns sorted values' |
406 | ); |
862b6081 |
407 | |
a7821be5 |
408 | is_deeply( |
409 | [ $obj->sort( sub { $_[0] <=> $_[1] } ) ], [ 3, 5, 9, 11, 22 ], |
410 | 'sort returns values sorted by provided function' |
411 | ); |
910684ee |
412 | |
b10dde3a |
413 | like( exception { $obj->sort(1) }, qr/The argument passed to sort must be a code reference/, 'throws an error when passing a non coderef to sort' ); |
910684ee |
414 | |
b10dde3a |
415 | like( exception { |
a7821be5 |
416 | $obj->sort( sub { }, 27 ); |
b10dde3a |
417 | }, qr/Cannot call sort with more than 1 argument/, 'throws an error when passing two arguments to sort' ); |
910684ee |
418 | |
a7821be5 |
419 | $obj->_values( [ 3, 9, 5, 22, 11 ] ); |
862b6081 |
420 | |
a7821be5 |
421 | $obj->sort_in_place; |
d50fc84a |
422 | |
a7821be5 |
423 | is_deeply( |
424 | $obj->_values, [ 11, 22, 3, 5, 9 ], |
425 | 'sort_in_place sorts values' |
426 | ); |
862b6081 |
427 | |
a7821be5 |
428 | $obj->sort_in_place( sub { $_[0] <=> $_[1] } ); |
862b6081 |
429 | |
a7821be5 |
430 | is_deeply( |
431 | $obj->_values, [ 3, 5, 9, 11, 22 ], |
432 | 'sort_in_place with function sorts values' |
433 | ); |
434 | |
b10dde3a |
435 | like( exception { |
e3181911 |
436 | $obj->sort_in_place( 27 ); |
b10dde3a |
437 | }, qr/The argument passed to sort_in_place must be a code reference/, 'throws an error when passing a non coderef to sort_in_place' ); |
e3181911 |
438 | |
b10dde3a |
439 | like( exception { |
a7821be5 |
440 | $obj->sort_in_place( sub { }, 27 ); |
b10dde3a |
441 | }, qr/Cannot call sort_in_place with more than 1 argument/, 'throws an error when passing two arguments to sort_in_place' ); |
a7821be5 |
442 | |
443 | $obj->_values( [ 3, 9, 5, 22, 11 ] ); |
444 | |
445 | $obj->sort_in_place_curried; |
446 | |
447 | is_deeply( |
448 | $obj->_values, [ 22, 11, 9, 5, 3 ], |
449 | 'sort_in_place_curried sorts values' |
450 | ); |
451 | |
b10dde3a |
452 | like( exception { $obj->sort_in_place_curried(27) }, qr/Cannot call sort_in_place with more than 1 argument/, 'throws an error when passing one argument passed to sort_in_place_curried' ); |
a7821be5 |
453 | |
454 | $obj->_values( [ 1 .. 5 ] ); |
455 | |
456 | is_deeply( |
457 | [ $obj->map( sub { $_ + 1 } ) ], |
458 | [ 2 .. 6 ], |
459 | 'map returns the expected values' |
460 | ); |
461 | |
b10dde3a |
462 | like( exception { $obj->map }, qr/Cannot call map without at least 1 argument/, 'throws an error when passing no arguments to map' ); |
a7821be5 |
463 | |
b10dde3a |
464 | like( exception { |
a7821be5 |
465 | $obj->map( sub { }, 2 ); |
b10dde3a |
466 | }, qr/Cannot call map with more than 1 argument/, 'throws an error when passing two arguments to map' ); |
a7821be5 |
467 | |
b10dde3a |
468 | like( exception { $obj->map( {} ) }, qr/The argument passed to map must be a code reference/, 'throws an error when passing a non coderef to map' ); |
a7821be5 |
469 | |
470 | $obj->_values( [ 1 .. 5 ] ); |
471 | |
472 | is_deeply( |
473 | [ $obj->map_curried ], |
474 | [ 2 .. 6 ], |
475 | 'map_curried returns the expected values' |
476 | ); |
477 | |
b10dde3a |
478 | like( exception { |
a7821be5 |
479 | $obj->map_curried( sub { } ); |
b10dde3a |
480 | }, qr/Cannot call map with more than 1 argument/, 'throws an error when passing one argument passed to map_curried' ); |
a7821be5 |
481 | |
482 | $obj->_values( [ 2 .. 9 ] ); |
483 | |
484 | is_deeply( |
485 | [ $obj->grep( sub { $_ < 5 } ) ], |
486 | [ 2 .. 4 ], |
487 | 'grep returns the expected values' |
488 | ); |
489 | |
b10dde3a |
490 | like( exception { $obj->grep }, qr/Cannot call grep without at least 1 argument/, 'throws an error when passing no arguments to grep' ); |
a7821be5 |
491 | |
b10dde3a |
492 | like( exception { |
a7821be5 |
493 | $obj->grep( sub { }, 2 ); |
b10dde3a |
494 | }, qr/Cannot call grep with more than 1 argument/, 'throws an error when passing two arguments to grep' ); |
a7821be5 |
495 | |
b10dde3a |
496 | like( exception { $obj->grep( {} ) }, qr/The argument passed to grep must be a code reference/, 'throws an error when passing a non coderef to grep' ); |
a7821be5 |
497 | |
88e88a7b |
498 | my $overloader = Overloader->new( sub { $_ < 5 } ); |
499 | is_deeply( |
500 | [ $obj->grep($overloader) ], |
501 | [ 2 .. 4 ], |
502 | 'grep works with obj that overload code dereferencing' |
503 | ); |
504 | |
a7821be5 |
505 | is_deeply( |
506 | [ $obj->grep_curried ], |
507 | [ 2 .. 4 ], |
508 | 'grep_curried returns the expected values' |
509 | ); |
510 | |
b10dde3a |
511 | like( exception { |
a7821be5 |
512 | $obj->grep_curried( sub { } ); |
b10dde3a |
513 | }, qr/Cannot call grep with more than 1 argument/, 'throws an error when passing one argument passed to grep_curried' ); |
a7821be5 |
514 | |
515 | $obj->_values( [ 2, 4, 22, 99, 101, 6 ] ); |
516 | |
517 | is( |
518 | $obj->first( sub { $_ % 2 } ), |
519 | 99, |
520 | 'first returns expected value' |
521 | ); |
522 | |
b10dde3a |
523 | like( exception { $obj->first }, qr/Cannot call first without at least 1 argument/, 'throws an error when passing no arguments to first' ); |
a7821be5 |
524 | |
b10dde3a |
525 | like( exception { |
a7821be5 |
526 | $obj->first( sub { }, 2 ); |
b10dde3a |
527 | }, qr/Cannot call first with more than 1 argument/, 'throws an error when passing two arguments to first' ); |
a7821be5 |
528 | |
b10dde3a |
529 | like( exception { $obj->first( {} ) }, qr/The argument passed to first must be a code reference/, 'throws an error when passing a non coderef to first' ); |
a7821be5 |
530 | |
531 | is( |
532 | $obj->first_curried, |
533 | 99, |
534 | 'first_curried returns expected value' |
535 | ); |
536 | |
b10dde3a |
537 | like( exception { |
a7821be5 |
538 | $obj->first_curried( sub { } ); |
b10dde3a |
539 | }, qr/Cannot call first with more than 1 argument/, 'throws an error when passing one argument passed to first_curried' ); |
a7821be5 |
540 | |
175f9180 |
541 | |
542 | is( |
543 | $obj->first_index( sub { $_ % 2 } ), |
544 | 3, |
545 | 'first_index returns expected value' |
546 | ); |
547 | |
548 | like( exception { $obj->first_index }, qr/Cannot call first_index without at least 1 argument/, 'throws an error when passing no arguments to first_index' ); |
549 | |
550 | like( exception { |
551 | $obj->first_index( sub { }, 2 ); |
552 | }, qr/Cannot call first_index with more than 1 argument/, 'throws an error when passing two arguments to first_index' ); |
553 | |
554 | like( exception { $obj->first_index( {} ) }, qr/The argument passed to first_index must be a code reference/, 'throws an error when passing a non coderef to first_index' ); |
555 | |
556 | is( |
557 | $obj->first_index_curried, |
558 | 3, |
559 | 'first_index_curried returns expected value' |
560 | ); |
561 | |
562 | like( exception { |
563 | $obj->first_index_curried( sub { } ); |
564 | }, qr/Cannot call first_index with more than 1 argument/, 'throws an error when passing one argument passed to first_index_curried' ); |
565 | |
566 | |
a7821be5 |
567 | $obj->_values( [ 1 .. 4 ] ); |
568 | |
569 | is( |
570 | $obj->join('-'), '1-2-3-4', |
571 | 'join returns expected result' |
572 | ); |
573 | |
5394a1c7 |
574 | is( |
575 | $obj->join(q{}), '1234', |
576 | 'join returns expected result when joining with empty string' |
577 | ); |
578 | |
48b6c41f |
579 | is( |
580 | $obj->join( OverloadStr->new(q{}) ), '1234', |
581 | 'join returns expected result when joining with empty string' |
582 | ); |
583 | |
b10dde3a |
584 | like( exception { $obj->join }, qr/Cannot call join without at least 1 argument/, 'throws an error when passing no arguments to join' ); |
a7821be5 |
585 | |
b10dde3a |
586 | like( exception { $obj->join( '-', 2 ) }, qr/Cannot call join with more than 1 argument/, 'throws an error when passing two arguments to join' ); |
a7821be5 |
587 | |
b10dde3a |
588 | like( exception { $obj->join( {} ) }, qr/The argument passed to join must be a string/, 'throws an error when passing a non string to join' ); |
a7821be5 |
589 | |
590 | is_deeply( |
591 | [ sort $obj->shuffle ], |
592 | [ 1 .. 4 ], |
593 | 'shuffle returns all values (cannot check for a random order)' |
594 | ); |
595 | |
b10dde3a |
596 | like( exception { $obj->shuffle(2) }, qr/Cannot call shuffle with any arguments/, 'throws an error when passing an argument passed to shuffle' ); |
a7821be5 |
597 | |
598 | $obj->_values( [ 1 .. 4, 2, 5, 3, 7, 3, 3, 1 ] ); |
599 | |
600 | is_deeply( |
601 | [ $obj->uniq ], |
602 | [ 1 .. 4, 5, 7 ], |
603 | 'uniq returns expected values (in original order)' |
604 | ); |
605 | |
b10dde3a |
606 | like( exception { $obj->uniq(2) }, qr/Cannot call uniq with any arguments/, 'throws an error when passing an argument passed to uniq' ); |
a7821be5 |
607 | |
608 | $obj->_values( [ 1 .. 5 ] ); |
609 | |
610 | is( |
611 | $obj->reduce( sub { $_[0] * $_[1] } ), |
612 | 120, |
613 | 'reduce returns expected value' |
614 | ); |
615 | |
b10dde3a |
616 | like( exception { $obj->reduce }, qr/Cannot call reduce without at least 1 argument/, 'throws an error when passing no arguments to reduce' ); |
a7821be5 |
617 | |
b10dde3a |
618 | like( exception { |
a7821be5 |
619 | $obj->reduce( sub { }, 2 ); |
b10dde3a |
620 | }, qr/Cannot call reduce with more than 1 argument/, 'throws an error when passing two arguments to reduce' ); |
a7821be5 |
621 | |
b10dde3a |
622 | like( exception { $obj->reduce( {} ) }, qr/The argument passed to reduce must be a code reference/, 'throws an error when passing a non coderef to reduce' ); |
a7821be5 |
623 | |
624 | is( |
625 | $obj->reduce_curried, |
626 | 120, |
627 | 'reduce_curried returns expected value' |
628 | ); |
629 | |
b10dde3a |
630 | like( exception { |
a7821be5 |
631 | $obj->reduce_curried( sub { } ); |
b10dde3a |
632 | }, qr/Cannot call reduce with more than 1 argument/, 'throws an error when passing one argument passed to reduce_curried' ); |
a7821be5 |
633 | |
634 | $obj->_values( [ 1 .. 6 ] ); |
635 | |
636 | my $it = $obj->natatime(2); |
637 | my @nat; |
638 | while ( my @v = $it->() ) { |
639 | push @nat, \@v; |
640 | } |
641 | |
642 | is_deeply( |
643 | [ [ 1, 2 ], [ 3, 4 ], [ 5, 6 ] ], |
644 | \@nat, |
645 | 'natatime returns expected iterator' |
646 | ); |
647 | |
648 | @nat = (); |
649 | $obj->natatime( 2, sub { push @nat, [@_] } ); |
650 | |
651 | is_deeply( |
652 | [ [ 1, 2 ], [ 3, 4 ], [ 5, 6 ] ], |
653 | \@nat, |
654 | 'natatime with function returns expected value' |
655 | ); |
656 | |
b10dde3a |
657 | like( exception { $obj->natatime( {} ) }, qr/The n value passed to natatime must be an integer/, 'throws an error when passing a non integer to natatime' ); |
a7821be5 |
658 | |
b10dde3a |
659 | like( exception { $obj->natatime( 2, {} ) }, qr/The second argument passed to natatime must be a code reference/, 'throws an error when passing a non code ref to natatime' ); |
a7821be5 |
660 | |
04bcce6a |
661 | $it = $obj->natatime_curried(); |
662 | @nat = (); |
a098a4a3 |
663 | while ( my @v = $it->() ) { |
664 | push @nat, \@v; |
665 | } |
666 | |
667 | is_deeply( |
668 | [ [ 1, 2 ], [ 3, 4 ], [ 5, 6 ] ], |
669 | \@nat, |
670 | 'natatime_curried returns expected iterator' |
671 | ); |
672 | |
673 | @nat = (); |
674 | $obj->natatime_curried( sub { push @nat, [@_] } ); |
675 | |
676 | is_deeply( |
677 | [ [ 1, 2 ], [ 3, 4 ], [ 5, 6 ] ], |
678 | \@nat, |
679 | 'natatime_curried with function returns expected value' |
680 | ); |
681 | |
b10dde3a |
682 | like( exception { $obj->natatime_curried( {} ) }, qr/The second argument passed to natatime must be a code reference/, 'throws an error when passing a non code ref to natatime_curried' ); |
a098a4a3 |
683 | |
a7821be5 |
684 | if ( $class->meta->get_attribute('_values')->is_lazy ) { |
685 | my $obj = $class->new; |
686 | |
687 | is( $obj->count, 2, 'count is 2 (lazy init)' ); |
688 | |
689 | $obj->_clear_values; |
690 | |
a098a4a3 |
691 | is_deeply( |
692 | [ $obj->elements ], [ 42, 84 ], |
693 | 'elements contains default with lazy init' |
694 | ); |
a7821be5 |
695 | |
696 | $obj->_clear_values; |
697 | |
698 | $obj->push(2); |
699 | |
700 | is_deeply( |
701 | $obj->_values, [ 42, 84, 2 ], |
702 | 'push works with lazy init' |
703 | ); |
704 | |
705 | $obj->_clear_values; |
706 | |
707 | $obj->unshift( 3, 4 ); |
708 | |
709 | is_deeply( |
710 | $obj->_values, [ 3, 4, 42, 84 ], |
711 | 'unshift works with lazy init' |
712 | ); |
713 | } |
714 | } |
715 | $class; |
862b6081 |
716 | } |
a28e50e4 |
717 | |
229a897a |
718 | { |
719 | my ( $class, $handles ) = build_class( isa => 'ArrayRef' ); |
720 | my $obj = $class->new; |
721 | with_immutable { |
722 | is( |
723 | exception { $obj->accessor( 0, undef ) }, |
724 | undef, |
725 | 'can use accessor to set value to undef' |
726 | ); |
727 | is( |
728 | exception { $obj->accessor_curried_1(undef) }, |
729 | undef, |
730 | 'can use curried accessor to set value to undef' |
731 | ); |
732 | } |
733 | $class; |
734 | } |
735 | |
a28e50e4 |
736 | done_testing; |