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