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