t/070_native_traits/202_trait_array.t

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