t/070_native_traits/202_trait_array.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More;
   7 use Test::Exception;
   8 use Test::Moose 'does_ok';
   9
  10 my $sort;
  11 my $less;
  12 my $up;
  13 my $prod;
  14
  15 my %handles = (
  16     add_options => 'push',
  17     add_options_with_speed =>
  18         [ push => 'funrolls', 'funbuns' ],
  19     remove_last_option  => 'pop',
  20     remove_first_option => 'shift',
  21     insert_options      => 'unshift',
  22     prepend_prerequisites_along_with =>
  23         [ unshift => 'first', 'second' ],
  24     get_option_at         => 'get',
  25     set_option_at         => 'set',
  26     num_options           => 'count',
  27     options               => 'elements',
  28     has_no_options        => 'is_empty',
  29     clear_options         => 'clear',
  30     splice_options        => 'splice',
  31     sort_options_in_place => 'sort_in_place',
  32     option_accessor       => 'accessor',
  33     descending_options =>
  34         [ sort_in_place => ( $sort = sub { $_[1] <=> $_[0] } ) ],
  35     map_options    => 'map',
  36     up_by_one      => [ map => ( $up = sub { $_ + 1 } ) ],
  37     filter_options => 'grep',
  38     less_than_five => [ grep => ( $less = sub { $_ < 5 } ) ],
  39     find_option    => 'first',
  40     join_options   => 'join',
  41     dashify            => [ join     => '-' ],
  42     sorted_options     => 'sort',
  43     randomized_options => 'shuffle',
  44     unique_options     => 'uniq',
  45     pairwise_options   => [ natatime => 2 ],
  46     reduce             => 'reduce',
  47     product => [ reduce => ( $prod = sub { $_[0] * $_[1] } ) ],
  48 );
  49
  50 {
  51
  52     package Stuff;
  53     use Moose;
  54
  55     has '_options' => (
  56         traits  => ['Array'],
  57         is      => 'ro',
  58         isa     => 'ArrayRef[Str]',
  59         default => sub { [] },
  60         handles => \%handles,
  61     );
  62 }
  63
  64 {
  65     my $stuff = Stuff->new( _options => [ 10, 12 ] );
  66     isa_ok( $stuff, 'Stuff' );
  67
  68     can_ok( $stuff, $_ ) for sort keys %handles;
  69
  70     is_deeply( $stuff->_options, [ 10, 12 ], '... got options' );
  71
  72     ok( !$stuff->has_no_options, '... we have options' );
  73     is( $stuff->num_options, 2, '... got 2 options' );
  74
  75     is( $stuff->remove_last_option,  12, '... removed the last option' );
  76     is( $stuff->remove_first_option, 10, '... removed the last option' );
  77
  78     is_deeply( $stuff->_options, [], '... no options anymore' );
  79
  80     ok( $stuff->has_no_options, '... no options' );
  81     is( $stuff->num_options, 0, '... got no options' );
  82
  83     lives_ok {
  84         $stuff->add_options( 1, 2, 3 );
  85     }
  86     '... set the option okay';
  87
  88     is_deeply( $stuff->_options, [ 1, 2, 3 ], '... got options now' );
  89     is_deeply(
  90         [ $stuff->options ], [ 1, 2, 3 ],
  91         '... got options now (with elements method)'
  92     );
  93
  94     ok( !$stuff->has_no_options, '... has options' );
  95     is( $stuff->num_options, 3, '... got 3 options' );
  96
  97     is( $stuff->get_option_at(0), 1, '... get option at index 0' );
  98     is( $stuff->get_option_at(1), 2, '... get option at index 1' );
  99     is( $stuff->get_option_at(2), 3, '... get option at index 2' );
 100
 101     throws_ok { $stuff->get_option_at() }
 102     qr/Must provide a valid index number as an argument/,
 103         'throws an error when get_option_at is called without any arguments';
 104
 105     throws_ok { $stuff->get_option_at( {} ) }
 106     qr/Must provide a valid index number as an argument/,
 107         'throws an error when get_option_at is called with an invalid argument';
 108
 109     throws_ok { $stuff->get_option_at(2.2) }
 110     qr/Must provide a valid index number as an argument/,
 111         'throws an error when get_option_at is called with an invalid argument';
 112
 113     throws_ok { $stuff->get_option_at('foo') }
 114     qr/Must provide a valid index number as an argument/,
 115         'throws an error when get_option_at is called with an invalid argument';
 116
 117     lives_ok {
 118         $stuff->set_option_at( 1, 100 );
 119     }
 120     '... set the option okay';
 121
 122     is( $stuff->get_option_at(1), 100, '... get option at index 1' );
 123
 124     lives_ok {
 125         $stuff->add_options( 10, 15 );
 126     }
 127     '... set the option okay';
 128
 129     is_deeply(
 130         $stuff->_options, [ 1, 100, 3, 10, 15 ],
 131         '... got more options now'
 132     );
 133
 134     is( $stuff->num_options, 5, '... got 5 options' );
 135
 136     is( $stuff->remove_last_option, 15, '... removed the last option' );
 137
 138     is( $stuff->num_options, 4, '... got 4 options' );
 139     is_deeply(
 140         $stuff->_options, [ 1, 100, 3, 10 ],
 141         '... got diff options now'
 142     );
 143
 144     lives_ok {
 145         $stuff->insert_options( 10, 20 );
 146     }
 147     '... set the option okay';
 148
 149     is( $stuff->num_options, 6, '... got 6 options' );
 150     is_deeply(
 151         $stuff->_options, [ 10, 20, 1, 100, 3, 10 ],
 152         '... got diff options now'
 153     );
 154
 155     is( $stuff->get_option_at(0), 10,  '... get option at index 0' );
 156     is( $stuff->get_option_at(1), 20,  '... get option at index 1' );
 157     is( $stuff->get_option_at(3), 100, '... get option at index 3' );
 158
 159     is( $stuff->remove_first_option, 10, '... getting the first option' );
 160
 161     is( $stuff->num_options,      5,  '... got 5 options' );
 162     is( $stuff->get_option_at(0), 20, '... get option at index 0' );
 163
 164     $stuff->clear_options;
 165     is_deeply( $stuff->_options, [], "... clear options" );
 166
 167     $stuff->add_options( 5, 1, 2, 3 );
 168     $stuff->sort_options_in_place;
 169     is_deeply(
 170         $stuff->_options, [ 1, 2, 3, 5 ],
 171         "... sort options in place (default sort order)"
 172     );
 173
 174     $stuff->sort_options_in_place( sub { $_[1] <=> $_[0] } );
 175     is_deeply(
 176         $stuff->_options, [ 5, 3, 2, 1 ],
 177         "... sort options in place (descending order)"
 178     );
 179
 180     $stuff->clear_options();
 181     $stuff->add_options( 5, 1, 2, 3 );
 182     lives_ok {
 183         $stuff->descending_options();
 184     }
 185     '... curried sort in place lives ok';
 186
 187     is_deeply( $stuff->_options, [ 5, 3, 2, 1 ], "... sort currying" );
 188
 189     throws_ok { $stuff->sort_options_in_place('foo') }
 190     qr/Argument must be a code reference/,
 191         'error when sort_in_place receives a non-coderef argument';
 192
 193     $stuff->clear_options;
 194
 195     lives_ok {
 196         $stuff->add_options('tree');
 197     }
 198     '... set the options okay';
 199
 200     lives_ok {
 201         $stuff->add_options_with_speed( 'compatible', 'safe' );
 202     }
 203     '... add options with speed okay';
 204
 205     is_deeply(
 206         $stuff->_options, [qw/tree funrolls funbuns compatible safe/],
 207         'check options after add_options_with_speed'
 208     );
 209
 210     lives_ok {
 211         $stuff->prepend_prerequisites_along_with();
 212     }
 213     '... add prerequisite options okay';
 214
 215     $stuff->clear_options;
 216     $stuff->add_options( 1, 2 );
 217
 218     lives_ok {
 219         $stuff->splice_options( 1, 0, 'foo' );
 220     }
 221     '... splice_options works';
 222
 223     is_deeply(
 224         $stuff->_options, [ 1, 'foo', 2 ],
 225         'splice added expected option'
 226     );
 227
 228     is(
 229         $stuff->option_accessor( 1 => 'foo++' ), 'foo++',
 230         'set using accessor method'
 231     );
 232     is( $stuff->option_accessor(1), 'foo++', 'get using accessor method' );
 233
 234     dies_ok {
 235         $stuff->insert_options(undef);
 236     }
 237     '... could not add an undef where a string is expected';
 238
 239     dies_ok {
 240         $stuff->set_option( 5, {} );
 241     }
 242     '... could not add a hash ref where a string is expected';
 243
 244     dies_ok {
 245         Stuff->new( _options => [ undef, 10, undef, 20 ] );
 246     }
 247     '... bad constructor params';
 248
 249     dies_ok {
 250         my $stuff = Stuff->new();
 251         $stuff->add_options(undef);
 252     }
 253     '... rejects push of an invalid type';
 254
 255     dies_ok {
 256         my $stuff = Stuff->new();
 257         $stuff->insert_options(undef);
 258     }
 259     '... rejects unshift of an invalid type';
 260
 261     dies_ok {
 262         my $stuff = Stuff->new();
 263         $stuff->set_option_at( 0, undef );
 264     }
 265     '... rejects set of an invalid type';
 266
 267     dies_ok {
 268         my $stuff = Stuff->new();
 269         $stuff->sort_in_place_options(undef);
 270     }
 271     '... sort rejects arg of invalid type';
 272
 273     dies_ok {
 274         my $stuff = Stuff->new();
 275         $stuff->option_accessor();
 276     }
 277     '... accessor rejects 0 args';
 278
 279     dies_ok {
 280         my $stuff = Stuff->new();
 281         $stuff->option_accessor( 1, 2, 3 );
 282     }
 283     '... accessor rejects 3 args';
 284 }
 285
 286 {
 287     my $stuff = Stuff->new( _options => [ 1 .. 10 ] );
 288
 289     is_deeply( $stuff->_options, [ 1 .. 10 ], '... got options' );
 290
 291     ok( !$stuff->has_no_options, '... we have options' );
 292     is( $stuff->num_options, 10, '... got 2 options' );
 293     cmp_ok( $stuff->get_option_at(0), '==', 1, '... get option 0' );
 294
 295     is_deeply(
 296         [ $stuff->filter_options( sub { $_ % 2 == 0 } ) ],
 297         [ 2, 4, 6, 8, 10 ],
 298         '... got the right filtered values'
 299     );
 300
 301     throws_ok { $stuff->filter_options() }
 302     qr/Must provide a code reference as an argument/,
 303         'throws an error when filter_options is called without any arguments';
 304
 305     throws_ok { $stuff->filter_options( {} ) }
 306     qr/Must provide a code reference as an argument/,
 307         'throws an error when filter_options is called with an invalid argument';
 308
 309     is_deeply(
 310         [ $stuff->map_options( sub { $_ * 2 } ) ],
 311         [ 2, 4, 6, 8, 10, 12, 14, 16, 18, 20 ],
 312         '... got the right mapped values'
 313     );
 314
 315     throws_ok { $stuff->map_options() }
 316     qr/Must provide a code reference as an argument/,
 317         'throws an error when map_options is called without any arguments';
 318
 319     throws_ok { $stuff->map_options( {} ) }
 320     qr/Must provide a code reference as an argument/,
 321         'throws an error when map_options is called with an invalid argument';
 322
 323     is(
 324         $stuff->find_option( sub { $_ % 2 == 0 } ), 2,
 325         '.. found the right option'
 326     );
 327
 328     throws_ok { $stuff->find_option() }
 329     qr/Must provide a code reference as an argument/,
 330         'throws an error when find_option is called without any arguments';
 331
 332     throws_ok { $stuff->find_option( {} ) }
 333     qr/Must provide a code reference as an argument/,
 334         'throws an error when find_option is called with an invalid argument';
 335
 336     is_deeply(
 337         [ $stuff->options ], [ 1 .. 10 ],
 338         '... got the list of options'
 339     );
 340
 341     is(
 342         $stuff->join_options(':'), '1:2:3:4:5:6:7:8:9:10',
 343         '... joined the list of options by :'
 344     );
 345
 346     throws_ok { $stuff->join_options() }
 347     qr/Must provide a string as an argument/,
 348         'throws an error when join_options is called without any arguments';
 349
 350     throws_ok { $stuff->join_options( {} ) }
 351     qr/Must provide a string as an argument/,
 352         'throws an error when join_options is called with an invalid argument';
 353
 354     is_deeply(
 355         [ $stuff->sorted_options ], [ sort ( 1 .. 10 ) ],
 356         '... got sorted options (default sort order)'
 357     );
 358     is_deeply(
 359         [ $stuff->sorted_options( sub { $_[1] <=> $_[0] } ) ],
 360         [ sort { $b <=> $a } ( 1 .. 10 ) ],
 361         '... got sorted options (descending sort order) '
 362     );
 363
 364     throws_ok { $stuff->sorted_options('foo') }
 365     qr/Argument must be a code reference/,
 366         'error when sort receives a non-coderef argument';
 367
 368     is_deeply(
 369         [ sort { $a <=> $b } $stuff->randomized_options ],
 370         [ 1 .. 10 ],
 371         'randomized_options returns all options'
 372     );
 373
 374     my @pairs;
 375     $stuff->pairwise_options( sub { push @pairs, [@_] } );
 376     is_deeply(
 377         \@pairs,
 378         [ [ 1, 2 ], [ 3, 4 ], [ 5, 6 ], [ 7, 8 ], [ 9, 10 ] ],
 379         'pairwise returns pairs as expected'
 380     );
 381
 382     is_deeply(
 383         [ $stuff->less_than_five() ], [ 1 .. 4 ],
 384         'less_than_five returns 1..4'
 385     );
 386
 387     is_deeply(
 388         [ $stuff->up_by_one() ], [ 2 .. 11 ],
 389         'up_by_one returns 2..11'
 390     );
 391
 392     is(
 393         $stuff->dashify, '1-2-3-4-5-6-7-8-9-10',
 394         'dashify returns options joined by dashes'
 395     );
 396
 397     is(
 398         $stuff->reduce( sub { $_[0] * $_[1] } ),
 399         3628800,
 400         'call reducing to generate a product returns expected value'
 401     );
 402
 403     throws_ok { $stuff->reduce() }
 404     qr/Must provide a code reference as an argument/,
 405         'throws an error when reduce is called without any arguments';
 406
 407     throws_ok { $stuff->reduce( {} ) }
 408     qr/Must provide a code reference as an argument/,
 409         'throws an error when reduce is called with an invalid argument';
 410
 411     is(
 412         $stuff->product, 3628800,
 413         'product returns expected value'
 414     );
 415
 416     my $other_stuff = Stuff->new( _options => [ 1, 1, 2, 3, 5 ] );
 417     is_deeply(
 418         [ $other_stuff->unique_options ], [ 1, 2, 3, 5 ],
 419         'unique_options returns unique options'
 420     );
 421 }
 422
 423 {
 424     my $options = Stuff->meta->get_attribute('_options');
 425     does_ok( $options, 'Moose::Meta::Attribute::Native::Trait::Array' );
 426
 427     is_deeply(
 428         $options->handles, \%handles,
 429         '... got the right handles mapping'
 430     );
 431
 432     is(
 433         $options->type_constraint->type_parameter, 'Str',
 434         '... got the right container type'
 435     );
 436 }
 437
 438 done_testing;