t/native_traits/trait_array.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use lib 't/lib';
   7
   8 use Moose ();
   9 use Moose::Util::TypeConstraints;
  10 use NoInlineAttribute;
  11 use Test::More;
  12 use Test::Fatal;
  13 use Test::Moose;
  14
  15 {
  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 } ) ],
  56         first_index   => 'first_index',
  57         first_index_curried => [ first_index => ( sub { $_ % 2 } ) ],
  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 ],
  66     );
  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
  78         my @traits = 'Array';
  79         push @traits, 'NoInlineAttribute'
  80             if delete $attr{no_inline};
  81
  82         $class->add_attribute(
  83             _values => (
  84                 traits  => \@traits,
  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     }
  96 }
  97
  98 {
  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 {
 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 {
 124     run_tests(build_class);
 125     run_tests( build_class( lazy => 1, default => sub { [ 42, 84 ] } ) );
 126     run_tests( build_class( trigger => sub { } ) );
 127     run_tests( build_class( no_inline => 1 ) );
 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 ) );
 137 }
 138
 139 sub run_tests {
 140     my ( $class, $handles ) = @_;
 141
 142     can_ok( $class, $_ ) for sort keys %{$handles};
 143
 144     with_immutable {
 145         my $obj = $class->new( _values => [ 10, 12, 42 ] );
 146
 147         is_deeply(
 148             $obj->_values, [ 10, 12, 42 ],
 149             'values can be set in constructor'
 150         );
 151
 152         ok( !$obj->is_empty, 'values is not empty' );
 153         is( $obj->count, 3, 'count returns 3' );
 154
 155         like( exception { $obj->count(22) }, qr/Cannot call count with any arguments/, 'throws an error when passing an argument passed to count' );
 156
 157         is( exception { $obj->push( 1, 2, 3 ) }, undef, 'pushed three new values and lived' );
 158
 159         is( exception { $obj->push() }, undef, 'call to push without arguments lives' );
 160
 161         is( exception {
 162             is( $obj->unshift( 101, 22 ), 8,
 163                 'unshift returns size of the new array' );
 164         }, undef, 'unshifted two values and lived' );
 165
 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
 171         is( exception { $obj->unshift() }, undef, 'call to unshift without arguments lives' );
 172
 173         is( $obj->pop, 3, 'pop returns the last value in the array' );
 174
 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         );
 179
 180         like( exception { $obj->pop(42) }, qr/Cannot call pop with any arguments/, 'call to pop with arguments dies' );
 181
 182         is( $obj->shift, 101, 'shift returns the first value' );
 183
 184         like( exception { $obj->shift(42) }, qr/Cannot call shift with any arguments/, 'call to shift with arguments dies' );
 185
 186         is_deeply(
 187             $obj->_values, [ 22, 10, 12, 42, 1, 2 ],
 188             'shift changed the value of the array in the object'
 189         );
 190
 191         is_deeply(
 192             [ $obj->elements ], [ 22, 10, 12, 42, 1, 2 ],
 193             'call to elements returns values as a list'
 194         );
 195
 196         like( exception { $obj->elements(22) }, qr/Cannot call elements with any arguments/, 'throws an error when passing an argument passed to elements' );
 197
 198         $obj->_values( [ 1, 2, 3 ] );
 199
 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' );
 204
 205         like( exception { $obj->get() }, qr/Cannot call get without at least 1 argument/, 'throws an error when get is called without any arguments' );
 206
 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' );
 208
 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' );
 210
 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' );
 212
 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' );
 214
 215         is( exception {
 216             is( $obj->set( 1, 100 ), 100, 'set returns new value' );
 217         }, undef, 'set value at index 1 lives' );
 218
 219         is( $obj->get(1), 100, 'get value at index 1 returns new value' );
 220
 221
 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' );
 223
 224         is( exception { $obj->set_curried_1(99) }, undef, 'set_curried_1 lives' );
 225
 226         is( $obj->get(1), 99, 'get value at index 1 returns new value' );
 227
 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' );
 229
 230         is( exception { $obj->set_curried_2 }, undef, 'set_curried_2 lives' );
 231
 232         is( $obj->get(1), 98, 'get value at index 1 returns new value' );
 233
 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' );
 235
 236         is(
 237             $obj->accessor(1), 98,
 238             'accessor with one argument returns value at index 1'
 239         );
 240
 241         is( exception {
 242             is( $obj->accessor( 1 => 97 ), 97, 'accessor returns new value' );
 243         }, undef, 'accessor as writer lives' );
 244
 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
 253         is(
 254             $obj->get(1), 97,
 255             'accessor set value at index 1'
 256         );
 257
 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' );
 259
 260         is(
 261             $obj->accessor_curried_1, 97,
 262             'accessor_curried_1 returns expected value when called with no arguments'
 263         );
 264
 265         is( exception { $obj->accessor_curried_1(95) }, undef, 'accessor_curried_1 as writer lives' );
 266
 267         is(
 268             $obj->get(1), 95,
 269             'accessor_curried_1 set value at index 1'
 270         );
 271
 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' );
 273
 274         is( exception { $obj->accessor_curried_2 }, undef, 'accessor_curried_2 as writer lives' );
 275
 276         is(
 277             $obj->get(1), 90,
 278             'accessor_curried_2 set value at index 1'
 279         );
 280
 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' );
 282
 283         is( exception { $obj->clear }, undef, 'clear lives' );
 284
 285         ok( $obj->is_empty, 'values is empty after call to clear' );
 286
 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
 292         $obj->set( 0 => 42 );
 293
 294         like( exception { $obj->clear(50) }, qr/Cannot call clear with any arguments/, 'throws an error when clear is called with an argument' );
 295
 296         ok(
 297             !$obj->is_empty,
 298             'values is not empty after failed call to clear'
 299         );
 300
 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' );
 302
 303         $obj->clear;
 304         is(
 305             $obj->push( 1, 5, 10, 42 ), 4,
 306             'pushed 4 elements, got number of elements in the array back'
 307         );
 308
 309         is( exception {
 310             is( $obj->delete(2), 10, 'delete returns deleted value' );
 311         }, undef, 'delete lives' );
 312
 313         is_deeply(
 314             $obj->_values, [ 1, 5, 42 ],
 315             'delete removed the specified element'
 316         );
 317
 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' );
 319
 320         is( exception { $obj->delete_curried }, undef, 'delete_curried lives' );
 321
 322         is_deeply(
 323             $obj->_values, [ 1, 42 ],
 324             'delete removed the specified element'
 325         );
 326
 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' );
 328
 329         is( exception { $obj->insert( 1, 21 ) }, undef, 'insert lives' );
 330
 331         is_deeply(
 332             $obj->_values, [ 1, 21, 42 ],
 333             'insert added the specified element'
 334         );
 335
 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' );
 337
 338         is( exception {
 339             is_deeply(
 340                 [ $obj->splice( 1, 0, 2, 3 ) ],
 341                 [],
 342                 'return value of splice is empty list when not removing elements'
 343             );
 344         }, undef, 'splice lives' );
 345
 346         is_deeply(
 347             $obj->_values, [ 1, 2, 3, 21, 42 ],
 348             'splice added the specified elements'
 349         );
 350
 351         is( exception {
 352             is_deeply(
 353                 [ $obj->splice( 1, 2, 99 ) ],
 354                 [ 2, 3 ],
 355                 'splice returns list of removed values'
 356             );
 357         }, undef, 'splice lives' );
 358
 359         is_deeply(
 360             $obj->_values, [ 1, 99, 21, 42 ],
 361             'splice added the specified elements'
 362         );
 363
 364         like( exception { $obj->splice() }, qr/Cannot call splice without at least 1 argument/, 'throws an error when splice is called with no arguments' );
 365
 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' );
 367
 368         is( exception { $obj->splice_curried_1( 2, 101 ) }, undef, 'splice_curried_1 lives' );
 369
 370         is_deeply(
 371             $obj->_values, [ 1, 101, 42 ],
 372             'splice added the specified elements'
 373         );
 374
 375         is( exception { $obj->splice_curried_2(102) }, undef, 'splice_curried_2 lives' );
 376
 377         is_deeply(
 378             $obj->_values, [ 1, 102 ],
 379             'splice added the specified elements'
 380         );
 381
 382         is( exception { $obj->splice_curried_all }, undef, 'splice_curried_all lives' );
 383
 384         is_deeply(
 385             $obj->_values, [ 1, 3, 4, 5 ],
 386             'splice added the specified elements'
 387         );
 388
 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
 401         $obj->_values( [ 3, 9, 5, 22, 11 ] );
 402
 403         is_deeply(
 404             [ $obj->sort ], [ 11, 22, 3, 5, 9 ],
 405             'sort returns sorted values'
 406         );
 407
 408         is_deeply(
 409             [ $obj->sort( sub { $_[0] <=> $_[1] } ) ], [ 3, 5, 9, 11, 22 ],
 410             'sort returns values sorted by provided function'
 411         );
 412
 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' );
 414
 415         like( exception {
 416             $obj->sort( sub { }, 27 );
 417         }, qr/Cannot call sort with more than 1 argument/, 'throws an error when passing two arguments to sort' );
 418
 419         $obj->_values( [ 3, 9, 5, 22, 11 ] );
 420
 421         $obj->sort_in_place;
 422
 423         is_deeply(
 424             $obj->_values, [ 11, 22, 3, 5, 9 ],
 425             'sort_in_place sorts values'
 426         );
 427
 428         $obj->sort_in_place( sub { $_[0] <=> $_[1] } );
 429
 430         is_deeply(
 431             $obj->_values, [ 3, 5, 9, 11, 22 ],
 432             'sort_in_place with function sorts values'
 433         );
 434
 435         like( exception {
 436             $obj->sort_in_place( 27 );
 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' );
 438
 439         like( exception {
 440             $obj->sort_in_place( sub { }, 27 );
 441         }, qr/Cannot call sort_in_place with more than 1 argument/, 'throws an error when passing two arguments to sort_in_place' );
 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
 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' );
 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
 462         like( exception { $obj->map }, qr/Cannot call map without at least 1 argument/, 'throws an error when passing no arguments to map' );
 463
 464         like( exception {
 465             $obj->map( sub { }, 2 );
 466         }, qr/Cannot call map with more than 1 argument/, 'throws an error when passing two arguments to map' );
 467
 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' );
 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
 478         like( exception {
 479             $obj->map_curried( sub { } );
 480         }, qr/Cannot call map with more than 1 argument/, 'throws an error when passing one argument passed to map_curried' );
 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
 490         like( exception { $obj->grep }, qr/Cannot call grep without at least 1 argument/, 'throws an error when passing no arguments to grep' );
 491
 492         like( exception {
 493             $obj->grep( sub { }, 2 );
 494         }, qr/Cannot call grep with more than 1 argument/, 'throws an error when passing two arguments to grep' );
 495
 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' );
 497
 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
 505         is_deeply(
 506             [ $obj->grep_curried ],
 507             [ 2 .. 4 ],
 508             'grep_curried returns the expected values'
 509         );
 510
 511         like( exception {
 512             $obj->grep_curried( sub { } );
 513         }, qr/Cannot call grep with more than 1 argument/, 'throws an error when passing one argument passed to grep_curried' );
 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
 523         like( exception { $obj->first }, qr/Cannot call first without at least 1 argument/, 'throws an error when passing no arguments to first' );
 524
 525         like( exception {
 526             $obj->first( sub { }, 2 );
 527         }, qr/Cannot call first with more than 1 argument/, 'throws an error when passing two arguments to first' );
 528
 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' );
 530
 531         is(
 532             $obj->first_curried,
 533             99,
 534             'first_curried returns expected value'
 535         );
 536
 537         like( exception {
 538             $obj->first_curried( sub { } );
 539         }, qr/Cannot call first with more than 1 argument/, 'throws an error when passing one argument passed to first_curried' );
 540
 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
 567         $obj->_values( [ 1 .. 4 ] );
 568
 569         is(
 570             $obj->join('-'), '1-2-3-4',
 571             'join returns expected result'
 572         );
 573
 574         is(
 575             $obj->join(q{}), '1234',
 576             'join returns expected result when joining with empty string'
 577         );
 578
 579         is(
 580             $obj->join( OverloadStr->new(q{}) ), '1234',
 581             'join returns expected result when joining with empty string'
 582         );
 583
 584         like( exception { $obj->join }, qr/Cannot call join without at least 1 argument/, 'throws an error when passing no arguments to join' );
 585
 586         like( exception { $obj->join( '-', 2 ) }, qr/Cannot call join with more than 1 argument/, 'throws an error when passing two arguments to join' );
 587
 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' );
 589
 590         is_deeply(
 591             [ sort $obj->shuffle ],
 592             [ 1 .. 4 ],
 593             'shuffle returns all values (cannot check for a random order)'
 594         );
 595
 596         like( exception { $obj->shuffle(2) }, qr/Cannot call shuffle with any arguments/, 'throws an error when passing an argument passed to shuffle' );
 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
 606         like( exception { $obj->uniq(2) }, qr/Cannot call uniq with any arguments/, 'throws an error when passing an argument passed to uniq' );
 607
 608         $obj->_values( [ 1 .. 5 ] );
 609
 610         is(
 611             $obj->reduce( sub { $_[0] * $_[1] } ),
 612             120,
 613             'reduce returns expected value'
 614         );
 615
 616         like( exception { $obj->reduce }, qr/Cannot call reduce without at least 1 argument/, 'throws an error when passing no arguments to reduce' );
 617
 618         like( exception {
 619             $obj->reduce( sub { }, 2 );
 620         }, qr/Cannot call reduce with more than 1 argument/, 'throws an error when passing two arguments to reduce' );
 621
 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' );
 623
 624         is(
 625             $obj->reduce_curried,
 626             120,
 627             'reduce_curried returns expected value'
 628         );
 629
 630         like( exception {
 631             $obj->reduce_curried( sub { } );
 632         }, qr/Cannot call reduce with more than 1 argument/, 'throws an error when passing one argument passed to reduce_curried' );
 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
 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' );
 658
 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' );
 660
 661         $it = $obj->natatime_curried();
 662         @nat = ();
 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
 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' );
 683
 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
 691             is_deeply(
 692                 [ $obj->elements ], [ 42, 84 ],
 693                 'elements contains default with lazy init'
 694             );
 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;
 716 }
 717
 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
 736 done_testing;