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