t/070_native_traits/205_trait_list.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 34;
   7 use Test::Exception;
   8 use Test::Moose 'does_ok';
   9
  10 my $sort;
  11 my $less;
  12 my $up;
  13 {
  14     package Stuff;
  15     use Moose;
  16
  17     has '_options' => (
  18         traits   => ['Array'],
  19         is       => 'ro',
  20         isa      => 'ArrayRef[Int]',
  21         init_arg => 'options',
  22         default  => sub { [] },
  23         handles  => {
  24             'num_options'          => 'count',
  25             'has_no_options'       => 'empty',
  26             'map_options',         => 'map',
  27             'filter_options'       => 'grep',
  28             'find_option'          => 'first',
  29             'options'              => 'elements',
  30             'join_options'         => 'join',
  31             'get_option_at'        => 'get',
  32             'get_first_option'     => 'head',
  33             'all_but_first_option' => 'tail',
  34             'get_last_option'      => 'last',
  35             'sorted_options'       => 'sort',
  36             'less_than_five'       => [ grep => [ $less = sub { $_ < 5 } ] ],
  37             'up_by_one'            => [ map => [ $up = sub { $_ + 1 } ] ],
  38             'dashify'    => [ join => ['-'] ],
  39             'descending' => [ sort => [ $sort = sub { $_[1] <=> $_[0] } ] ],
  40         },
  41     );
  42
  43 }
  44
  45 my $stuff = Stuff->new( options => [ 1 .. 10 ] );
  46 isa_ok( $stuff, 'Stuff' );
  47
  48 can_ok( $stuff, $_ ) for qw[
  49     _options
  50     num_options
  51     has_no_options
  52     map_options
  53     filter_options
  54     find_option
  55     options
  56     join_options
  57     get_option_at
  58     sorted_options
  59 ];
  60
  61 is_deeply( $stuff->_options, [ 1 .. 10 ], '... got options' );
  62
  63 ok( !$stuff->has_no_options, '... we have options' );
  64 is( $stuff->num_options, 10, '... got 2 options' );
  65 cmp_ok( $stuff->get_option_at(0), '==', 1,  '... get option 0' );
  66 cmp_ok( $stuff->get_first_option, '==', 1,  '... get head' );
  67 is_deeply( [ $stuff->all_but_first_option ], [ 2 .. 10 ], '... get tail' );
  68 cmp_ok( $stuff->get_last_option,  '==', 10, '... get last' );
  69
  70 is_deeply(
  71     [ $stuff->filter_options( sub { $_ % 2 == 0 } ) ],
  72     [ 2, 4, 6, 8, 10 ],
  73     '... got the right filtered values'
  74 );
  75
  76 is_deeply(
  77     [ $stuff->map_options( sub { $_ * 2 } ) ],
  78     [ 2, 4, 6, 8, 10, 12, 14, 16, 18, 20 ],
  79     '... got the right mapped values'
  80 );
  81
  82 is( $stuff->find_option( sub { $_ % 2 == 0 } ), 2,
  83     '.. found the right option' );
  84
  85 is_deeply( [ $stuff->options ], [ 1 .. 10 ], '... got the list of options' );
  86
  87 is( $stuff->join_options(':'), '1:2:3:4:5:6:7:8:9:10',
  88     '... joined the list of options by :' );
  89
  90 is_deeply(
  91     [ $stuff->sorted_options ], [ sort ( 1 .. 10 ) ],
  92     '... got sorted options (default sort order)'
  93 );
  94 is_deeply(
  95     [ $stuff->sorted_options( sub { $_[1] <=> $_[0] } ) ],
  96     [ sort { $b <=> $a } ( 1 .. 10 ) ],
  97     '... got sorted options (descending sort order) '
  98 );
  99
 100 throws_ok { $stuff->sorted_options('foo') }
 101 qr/Argument must be a code reference/,
 102     'error when sort receives a non-coderef argument';
 103
 104 # test the currying
 105 is_deeply( [ $stuff->less_than_five() ], [ 1 .. 4 ] );
 106
 107 is_deeply( [ $stuff->up_by_one() ], [ 2 .. 11 ] );
 108
 109 is( $stuff->dashify, '1-2-3-4-5-6-7-8-9-10' );
 110
 111 is_deeply( [ $stuff->descending ], [ reverse 1 .. 10 ] );
 112
 113 ## test the meta
 114
 115 my $options = $stuff->meta->get_attribute('_options');
 116 does_ok( $options, 'Moose::Meta::Attribute::Native::Trait::Array' );
 117
 118 is_deeply(
 119     $options->handles,
 120     {
 121         'num_options'          => 'count',
 122         'has_no_options'       => 'empty',
 123         'map_options',         => 'map',
 124         'filter_options'       => 'grep',
 125         'find_option'          => 'first',
 126         'options'              => 'elements',
 127         'join_options'         => 'join',
 128         'get_option_at'        => 'get',
 129         'get_first_option'     => 'head',
 130         'all_but_first_option' => 'tail',
 131         'get_last_option'      => 'last',
 132         'sorted_options'       => 'sort',
 133         'less_than_five'       => [ grep => [$less] ],
 134         'up_by_one'            => [ map => [$up] ],
 135         'dashify'              => [ join => ['-'] ],
 136         'descending'           => [ sort => [$sort] ],
 137     },
 138     '... got the right handles mapping'
 139 );
 140
 141 is( $options->type_constraint->type_parameter, 'Int',
 142     '... got the right container type' );
 143
 144 dies_ok {
 145     $stuff->sort_in_place_options(undef);
 146 }
 147 '... sort rejects arg of invalid type';
 148