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