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