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