t/070_native_traits/202_trait_array.t

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