Commit | Line | Data |
5f654d8e |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
e29de5ed |
6 | use Test::More tests => 70; |
5f654d8e |
7 | |
8 | BEGIN { |
9 | use_ok('Moose::Autobox'); |
5f654d8e |
10 | } |
11 | |
7dad2765 |
12 | use Moose::Autobox; |
5f654d8e |
13 | |
3f4dd8b7 |
14 | my $VAR1; # for eval of dumps |
15 | |
5f654d8e |
16 | # SCALAR & UNDEF |
17 | |
18 | my $s; |
19 | ok(!$s->defined, '... got a undefined value'); |
20 | |
21 | $s = 5; |
22 | ok($s->defined, '... got a defined value'); |
23 | |
3f4dd8b7 |
24 | eval $s->dump; |
25 | is($VAR1, 5 , '... eval of SCALAR->dump works'); |
26 | |
e29de5ed |
27 | eval $s->flatten; |
28 | is($VAR1, 5 , '... eval of SCALAR->flatten works'); |
29 | |
3f4dd8b7 |
30 | eval $s->perl; |
31 | is($s->perl, $s->dump, '... SCALAR->dump equals SCALAR->perl'); |
32 | |
5f654d8e |
33 | # CODE |
34 | |
35 | my $f1 = sub { @_ }; |
36 | ok($f1->defined, '... created function'); |
37 | |
38 | my $f2 = eval { $f1->curry(1, 2, 3) }; |
39 | ok($f2->defined, '... created curried function'); |
40 | |
41 | my $f3 = eval { $f1->rcurry(1, 2, 3) }; |
42 | ok($f3->defined, '... created right-curried function'); |
43 | |
44 | is_deeply( |
45 | [ $f2->(4, 5, 6) ], |
46 | [ 1, 2, 3, 4, 5, 6 ], |
47 | '... got the right return value from the curried function'); |
48 | |
49 | is_deeply( |
50 | [ $f3->(4, 5, 6) ], |
51 | [ 4, 5, 6, 1, 2, 3 ], |
52 | '... got the right return value from the r-curried function'); |
53 | |
54 | ok((sub { 1 })->disjoin(sub { 0 })->(), '... disjoins properly'); |
260cc81f |
55 | ok((sub { 0 })->disjoin(sub { 1 })->(), '... disjoins properly'); |
56 | |
5f654d8e |
57 | ok(!(sub { 1 })->conjoin(sub { 0 })->(), '... conjoins properly'); |
260cc81f |
58 | ok(!(sub { 0 })->conjoin(sub { 1 })->(), '... conjoins properly'); |
5f654d8e |
59 | |
252ab1a2 |
60 | my $compose = (sub { @_, 1 })->compose(sub { @_, 2 }); |
5f654d8e |
61 | |
252ab1a2 |
62 | is_deeply( |
63 | [ $compose->() ], |
64 | [ 1, 2 ], |
65 | '... got the right return value for compose'); |
260cc81f |
66 | |
5f654d8e |
67 | # ARRAY |
68 | |
69 | my $a = [ 4, 2, 6, 78, 101, 2, 3 ]; |
70 | |
71 | is($a->length, 7, '... got the right length'); |
72 | ok($a->defined, '... got the right defined value'); |
73 | |
74 | is_deeply( |
75 | $a->map(sub { $_ + 2 }), |
76 | [ map { $_ + 2 } (4, 2, 6, 78, 101, 2, 3) ], |
77 | '... got the right return value for map'); |
78 | |
79 | is_deeply($a, [ 4, 2, 6, 78, 101, 2, 3 ], '... original value is unchanged'); |
80 | |
09a0196c |
81 | my $b = [1, 2, 3]; |
82 | $b->map(sub { $_++ } ); |
83 | is_deeply($b, [ 2, 3, 4 ], '... original value is changed'); |
84 | |
5f654d8e |
85 | is_deeply( |
86 | $a->reverse(), |
87 | [ 3, 2, 101, 78, 6, 2, 4 ], |
88 | '... got the right return value for reverse'); |
89 | |
90 | is_deeply($a, [ 4, 2, 6, 78, 101, 2, 3 ], '... original value is unchanged'); |
91 | |
92 | is_deeply( |
93 | $a->grep(sub { $_ < 50 }), |
94 | [ grep { $_ < 50 } (4, 2, 6, 78, 101, 2, 3) ], |
95 | '... got the right return value grep'); |
96 | |
97 | is_deeply($a, [ 4, 2, 6, 78, 101, 2, 3 ], '... original value is unchanged'); |
98 | |
99 | is($a->join(', '), '4, 2, 6, 78, 101, 2, 3', '... got the right joined string'); |
260cc81f |
100 | is($a->join, '4267810123', '... got the right joined string'); |
5f654d8e |
101 | ok($a->exists(0), '... exists works'); |
102 | ok(!$a->exists(10), '... exists works'); |
103 | |
104 | is($a->pop(), 3, '... got the right pop-ed value'); |
105 | is_deeply($a, [ 4, 2, 6, 78, 101, 2 ], '... original value is now changed'); |
106 | |
107 | is($a->shift(), 4, '... got the right unshift-ed value'); |
108 | is_deeply($a, [ 2, 6, 78, 101, 2 ], '... original value is now changed'); |
109 | |
c11e6a74 |
110 | |
111 | is_deeply( |
112 | $a->slice([ 1, 2, 4 ]), |
113 | [ 6, 78, 2 ], |
114 | '... got the right sliced value'); |
115 | |
5f654d8e |
116 | is_deeply( |
117 | $a->unshift(10), |
118 | [ 10, 2, 6, 78, 101, 2 ], |
119 | '... got the correct unshifted value'); |
120 | |
121 | is_deeply( |
122 | $a->unshift(15, 20, 30), |
123 | [ 15, 20, 30, 10, 2, 6, 78, 101, 2 ], |
124 | '... got the correct unshifted value (multiple values)'); |
125 | |
126 | is_deeply( |
127 | $a->push(10), |
128 | [ 15, 20, 30, 10, 2, 6, 78, 101, 2, 10 ], |
129 | '... got the correct pushed value'); |
130 | |
131 | is_deeply( |
132 | $a->push(15, 20, 30), |
133 | [ 15, 20, 30, 10, 2, 6, 78, 101, 2, 10, 15, 20, 30 ], |
134 | '... got the correct pushed value (multiple values)'); |
135 | |
136 | is_deeply( |
137 | $a->sort(sub { $_[0] <=> $_[1] }), |
138 | [ 2, 2, 6, 10, 10, 15, 15, 20, 20, 30, 30, 78, 101 ], |
139 | '... got the correct sorted value'); |
140 | |
141 | is_deeply( |
142 | $a, |
143 | [ 15, 20, 30, 10, 2, 6, 78, 101, 2, 10, 15, 20, 30 ], |
144 | '... the original values are unchanged'); |
145 | |
146 | is_deeply( |
147 | []->push(10, 20, 30)->map(sub { ($_, $_ + 5) })->reverse, |
148 | [ 35, 30, 25, 20, 15, 10 ], |
149 | '... got the correct chained value'); |
150 | |
5dc78481 |
151 | is_deeply( |
152 | $a->keys, |
153 | [ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12 ], |
154 | '... the keys'); |
155 | |
156 | is_deeply( |
157 | $a->values, |
158 | [ 15, 20, 30, 10, 2, 6, 78, 101, 2, 10, 15, 20, 30 ], |
159 | '... the values'); |
160 | |
161 | is_deeply( |
162 | $a->kv, |
163 | [ [0, 15], [1, 20], [2, 30], [3, 10], [4, 2], [5, 6], [6, 78], |
164 | [7, 101], [8, 2], [9, 10], [10, 15], [11, 20], [12, 30] ], |
165 | '... [ k, v ]'); |
166 | |
167 | is([1, 2, 3, 4, 5]->reduce(sub { $_[0] + $_[1] }), 15, '... got the right reduction'); |
168 | |
169 | is_deeply( |
260cc81f |
170 | [1, 2, 3, 4, 5]->zip([ 5, 4, 3, 2, 1 ]), |
171 | [ [1, 5], [2, 4], [3, 3], [4, 2], [5, 1] ], |
172 | '... got the right zip'); |
5dc78481 |
173 | |
260cc81f |
174 | is_deeply( |
175 | [1, 2, 3, 4, 5]->zip([ 6, 5, 4, 3, 2, 1 ]), |
176 | [ [1, 6], [2, 5], [3, 4], [4, 3], [5, 2], [undef, 1] ], |
177 | '... got the right zip'); |
178 | |
179 | is($a->delete(2), 30, '... got the value deleted'); |
180 | is_deeply( |
181 | $a, |
182 | [ 15, 20, undef, 10, 2, 6, 78, 101, 2, 10, 15, 20, 30 ], |
183 | '... the value is correctly deleted'); |
184 | |
185 | $a->put(2, 30); |
186 | |
187 | is_deeply( |
188 | $a, |
189 | [ 15, 20, 30, 10, 2, 6, 78, 101, 2, 10, 15, 20, 30 ], |
190 | '... the value is correctly put'); |
5dc78481 |
191 | |
3f4dd8b7 |
192 | eval($a->dump); |
193 | is_deeply( $VAR1, |
194 | [ 15, 20, 30, 10, 2, 6, 78, 101, 2, 10, 15, 20, 30 ], |
195 | '... the value is correctly dumped'); |
9b2ca73c |
196 | |
9b2ca73c |
197 | is( $a->dump, |
198 | $a->perl, |
199 | '... the value is correctly dumped with perl()' ); |
200 | |
aaf111de |
201 | is([1, 2, 3, 4, 5]->any, 3, '... any correctly found a value'); |
202 | is([1, 1, 2, 3, 4, 5, 5]->one, 2, '... one correctly found one value'); |
203 | is([1, 1, 2, 3, 4, 5, 5]->none , 6, '... none correctly did not find any of a value'); |
204 | is([3, 3, 3]->all, 3, '... all correctly found all of a value'); |
9b2ca73c |
205 | |
5f654d8e |
206 | # Hash |
207 | |
208 | my $h = { one => 1, two => 2, three => 3 }; |
209 | |
210 | ok($h->defined, '... got the right defined value'); |
211 | |
5dc78481 |
212 | is_deeply( |
213 | $h->keys->sort, |
214 | [ qw/one three two/ ], |
215 | '... the keys'); |
216 | |
217 | is_deeply( |
218 | $h->values->sort, |
219 | [ 1, 2, 3 ], |
220 | '... the values'); |
5f654d8e |
221 | |
260cc81f |
222 | is_deeply( |
223 | $h->kv->sort(sub { $_[0]->[1] <=> $_[1]->[1] }), |
224 | [ ['one', 1], ['two', 2], ['three', 3] ], |
225 | '... the kvs'); |
226 | |
5dc78481 |
227 | ok($h->exists('two'), '... exists works'); |
228 | ok(!$h->exists('five'), '... !exists works'); |
260cc81f |
229 | |
230 | $h->put('four' => 4); |
231 | is_deeply( |
232 | $h, |
233 | { one => 1, two => 2, three => 3, four => 4 }, |
234 | '... got the value added correctly'); |
235 | |
236 | is($h->at('four'), 4, '... got the value at "four"'); |
237 | |
238 | $h->delete('four'); |
239 | is_deeply( |
240 | $h, |
241 | { one => 1, two => 2, three => 3 }, |
242 | '... got the value deleted correctly'); |
243 | |
bc9177cb |
244 | is_deeply( |
245 | $h->merge({ three => 33, four => 44 }), |
246 | { one => 1, two => 2, three => 33, four => 44 }, |
247 | '... got the hashes merged correctly'); |
248 | |
3f4dd8b7 |
249 | eval($h->dump); |
250 | is_deeply( $VAR1, |
251 | { one => 1, two => 2, three => 3 }, |
252 | '... the value is correctly dumped'); |
253 | |
254 | is( $h->dump, |
255 | $h->perl, |
256 | '... the value is correctly dumped with perl()' ); |
260cc81f |
257 | |
18ef6e1c |
258 | is_deeply( { one => 1, two => 2, three => 3 }->slice([qw/three one/]), |
259 | [ qw/3 1/ ], |
260 | '... hash slices ok' ); |
f7ea23f6 |
261 | |
262 | is_deeply( { one => 1, two => 2, three => 3 }->hslice([qw/two three/]), |
263 | { two => 2, three => 3 }, |
264 | '... hash hslices ok' ); |