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