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