t/202_trait_array.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 69;
   7 use Test::Exception;
   8 use Test::Moose 'does_ok';
   9
  10 BEGIN {
  11     use_ok('MooseX::AttributeHelpers');
  12 }
  13
  14 {
  15     package Stuff;
  16     use Moose;
  17
  18     has 'options' => (
  19         traits    => [qw/MooseX::AttributeHelpers::Trait::Collection::Array/],
  20         is        => 'ro',
  21         isa       => 'ArrayRef[Str]',
  22         default   => sub { [] },
  23         provides => {
  24             'push'          => 'add_options',
  25             'pop'           => 'remove_last_option',
  26             'shift'         => 'remove_first_option',
  27             'unshift'       => 'insert_options',
  28             'get'           => 'get_option_at',
  29             'set'           => 'set_option_at',
  30             'count'         => 'num_options',
  31             'empty'         => 'has_options',
  32             'clear'         => 'clear_options',
  33             'splice'        => 'splice_options',
  34             'sort_in_place' => 'sort_options_in_place',
  35             'accessor'      => 'option_accessor',
  36             },
  37         curries   => {
  38             'push'    => {
  39                 add_options_with_speed => ['funrolls', 'funbuns']
  40             },
  41             'unshift'  => {
  42                 prepend_prerequisites_along_with => ['first', 'second']
  43             },
  44             'sort_in_place' => { descending_options => [ sub { $_[1] <=> $_[0] } ],
  45             },
  46         }
  47     );
  48 }
  49
  50 my $stuff = Stuff->new(options => [ 10, 12 ]);
  51 isa_ok($stuff, 'Stuff');
  52
  53 can_ok($stuff, $_) for qw[
  54     add_options
  55     remove_last_option
  56     remove_first_option
  57     insert_options
  58     get_option_at
  59     set_option_at
  60     num_options
  61     clear_options
  62     has_options
  63     sort_options_in_place
  64     option_accessor
  65 ];
  66
  67 is_deeply($stuff->options, [10, 12], '... got options');
  68
  69 ok($stuff->has_options, '... we have options');
  70 is($stuff->num_options, 2, '... got 2 options');
  71
  72 is($stuff->remove_last_option, 12, '... removed the last option');
  73 is($stuff->remove_first_option, 10, '... removed the last option');
  74
  75 is_deeply($stuff->options, [], '... no options anymore');
  76
  77 ok(!$stuff->has_options, '... no options');
  78 is($stuff->num_options, 0, '... got no options');
  79
  80 lives_ok {
  81     $stuff->add_options(1, 2, 3);
  82 } '... set the option okay';
  83
  84 is_deeply($stuff->options, [1, 2, 3], '... got options now');
  85
  86 ok($stuff->has_options, '... no options');
  87 is($stuff->num_options, 3, '... got 3 options');
  88
  89 is($stuff->get_option_at(0), 1, '... get option at index 0');
  90 is($stuff->get_option_at(1), 2, '... get option at index 1');
  91 is($stuff->get_option_at(2), 3, '... get option at index 2');
  92
  93 lives_ok {
  94     $stuff->set_option_at(1, 100);
  95 } '... set the option okay';
  96
  97 is($stuff->get_option_at(1), 100, '... get option at index 1');
  98
  99 lives_ok {
 100     $stuff->add_options(10, 15);
 101 } '... set the option okay';
 102
 103 is_deeply($stuff->options, [1, 100, 3, 10, 15], '... got more options now');
 104
 105 is($stuff->num_options, 5, '... got 5 options');
 106
 107 is($stuff->remove_last_option, 15, '... removed the last option');
 108
 109 is($stuff->num_options, 4, '... got 4 options');
 110 is_deeply($stuff->options, [1, 100, 3, 10], '... got diff options now');
 111
 112 lives_ok {
 113     $stuff->insert_options(10, 20);
 114 } '... set the option okay';
 115
 116 is($stuff->num_options, 6, '... got 6 options');
 117 is_deeply($stuff->options, [10, 20, 1, 100, 3, 10], '... got diff options now');
 118
 119 is($stuff->get_option_at(0), 10, '... get option at index 0');
 120 is($stuff->get_option_at(1), 20, '... get option at index 1');
 121 is($stuff->get_option_at(3), 100, '... get option at index 3');
 122
 123 is($stuff->remove_first_option, 10, '... getting the first option');
 124
 125 is($stuff->num_options, 5, '... got 5 options');
 126 is($stuff->get_option_at(0), 20, '... get option at index 0');
 127
 128 $stuff->clear_options;
 129 is_deeply( $stuff->options, [], "... clear options" );
 130
 131 $stuff->add_options(5, 1, 2, 3);
 132 $stuff->sort_options_in_place;
 133 is_deeply( $stuff->options, [1, 2, 3, 5], "... sort options in place (default sort order)" );
 134
 135 $stuff->sort_options_in_place( sub { $_[1] <=> $_[0] } );
 136 is_deeply( $stuff->options, [5, 3, 2, 1], "... sort options in place (descending order)" );
 137
 138 $stuff->clear_options();
 139 $stuff->add_options(5, 1, 2, 3);
 140 lives_ok {
 141    $stuff->descending_options();
 142 } '... curried sort in place lives ok';
 143
 144 is_deeply( $stuff->options, [5, 3, 2, 1], "... sort currying" );
 145
 146 throws_ok { $stuff->sort_options_in_place('foo') } qr/Argument must be a code reference/,
 147     'error when sort_in_place receives a non-coderef argument';
 148
 149 $stuff->clear_options;
 150
 151 lives_ok {
 152     $stuff->add_options('tree');
 153 } '... set the options okay';
 154
 155 lives_ok {
 156     $stuff->add_options_with_speed('compatible', 'safe');
 157 } '... add options with speed okay';
 158
 159 is_deeply($stuff->options, [qw/tree funrolls funbuns compatible safe/],
 160           'check options after add_options_with_speed');
 161
 162 lives_ok {
 163     $stuff->prepend_prerequisites_along_with();
 164 } '... add prerequisite options okay';
 165
 166 $stuff->clear_options;
 167 $stuff->add_options( 1, 2 );
 168
 169 lives_ok {
 170     $stuff->splice_options( 1, 0, 'foo' );
 171 } '... splice_options works';
 172
 173 is_deeply(
 174     $stuff->options, [ 1, 'foo', 2 ],
 175     'splice added expected option'
 176 );
 177
 178 is($stuff->option_accessor(1 => 'foo++'), 'foo++');
 179 is($stuff->option_accessor(1), 'foo++');
 180
 181 ## check some errors
 182
 183 #dies_ok {
 184 #    $stuff->insert_options(undef);
 185 #} '... could not add an undef where a string is expected';
 186 #
 187 #dies_ok {
 188 #    $stuff->set_option(5, {});
 189 #} '... could not add a hash ref where a string is expected';
 190
 191 dies_ok {
 192     Stuff->new(options => [ undef, 10, undef, 20 ]);
 193 } '... bad constructor params';
 194
 195 dies_ok {
 196     my $stuff = Stuff->new();
 197     $stuff->add_options(undef);
 198 } '... rejects push of an invalid type';
 199
 200 dies_ok {
 201     my $stuff = Stuff->new();
 202     $stuff->insert_options(undef);
 203 } '... rejects unshift of an invalid type';
 204
 205 dies_ok {
 206     my $stuff = Stuff->new();
 207     $stuff->set_option_at( 0, undef );
 208 } '... rejects set of an invalid type';
 209
 210 dies_ok {
 211     my $stuff = Stuff->new();
 212     $stuff->sort_in_place_options( undef );
 213 } '... sort rejects arg of invalid type';
 214
 215 dies_ok {
 216     my $stuff = Stuff->new();
 217     $stuff->option_accessor();
 218 } '... accessor rejects 0 args';
 219
 220 dies_ok {
 221     my $stuff = Stuff->new();
 222     $stuff->option_accessor(1, 2, 3);
 223 } '... accessor rejects 3 args';
 224
 225 ## test the meta
 226
 227 my $options = $stuff->meta->get_attribute('options');
 228 does_ok($options, 'MooseX::AttributeHelpers::Trait::Collection::Array');
 229
 230 is_deeply($options->provides, {
 231     'push'    => 'add_options',
 232     'pop'     => 'remove_last_option',
 233     'shift'   => 'remove_first_option',
 234     'unshift' => 'insert_options',
 235     'get'     => 'get_option_at',
 236     'set'     => 'set_option_at',
 237     'count'   => 'num_options',
 238     'empty'   => 'has_options',
 239     'clear'   => 'clear_options',
 240     'splice'  => 'splice_options',
 241     'sort_in_place' => 'sort_options_in_place',
 242     'accessor' => 'option_accessor',
 243 }, '... got the right provides mapping');
 244
 245 is($options->type_constraint->type_parameter, 'Str', '... got the right container type');