Renamings
[dbsrgits/DBM-Deep.git] / t / 04_array.t
CommitLineData
ffed8b01 1##
2# DBM::Deep Test
3##
4use strict;
5use Test::More tests => 93;
6use Test::Exception;
7
8use_ok( 'DBM::Deep' );
9
10##
11# basic file open
12##
13unlink "t/test.db";
14my $db = DBM::Deep->new(
15 file => "t/test.db",
16 type => DBM::Deep->TYPE_ARRAY
17);
18if ($db->error()) {
19 die "ERROR: " . $db->error();
20}
21
22TODO: {
23 local $TODO = "How is this test ever supposed to pass?";
24 ok( !$db->clear, "If the file has never been written to, clear() returns false" );
25}
26
27##
28# basic put/get/push
29##
30$db->[0] = "elem1";
31$db->push( "elem2" );
32$db->put(2, "elem3");
33$db->store(3, "elem4");
34$db->unshift("elem0");
35
36is( $db->[0], 'elem0', "Array get for shift works" );
37is( $db->[1], 'elem1', "Array get for array set works" );
38is( $db->[2], 'elem2', "Array get for push() works" );
39is( $db->[3], 'elem3', "Array get for put() works" );
40is( $db->[4], 'elem4', "Array get for store() works" );
41
42is( $db->get(0), 'elem0', "get() for shift() works" );
43is( $db->get(1), 'elem1', "get() for array set works" );
44is( $db->get(2), 'elem2', "get() for push() works" );
45is( $db->get(3), 'elem3', "get() for put() works" );
46is( $db->get(4), 'elem4', "get() for store() works" );
47
48is( $db->fetch(0), 'elem0', "fetch() for shift() works" );
49is( $db->fetch(1), 'elem1', "fetch() for array set works" );
50is( $db->fetch(2), 'elem2', "fetch() for push() works" );
51is( $db->fetch(3), 'elem3', "fetch() for put() works" );
52is( $db->fetch(4), 'elem4', "fetch() for store() works" );
53
54is( $db->length, 5, "... and we have five elements" );
55
56is( $db->[-1], $db->[4], "-1st index is 4th value" );
57is( $db->[-2], $db->[3], "-2nd index is 3rd value" );
58is( $db->[-3], $db->[2], "-3rd index is 2nd value" );
59is( $db->[-4], $db->[1], "-4th index is 1st value" );
60is( $db->[-5], $db->[0], "-5th index is 0th value" );
61TODO: {
62 local $TODO = "Going off the end of the array from the back is legal";
63 eval { is( $db->[-6], undef, "-6th index is undef" ); };
64}
65is( $db->length, 5, "... and we have five elements after abortive -6 index lookup" );
66
67my $popped = $db->pop;
68is( $db->length, 4, "... and we have four after popping" );
69is( $db->[0], 'elem0', "0th element still there after popping" );
70is( $db->[1], 'elem1', "1st element still there after popping" );
71is( $db->[2], 'elem2', "2nd element still there after popping" );
72is( $db->[3], 'elem3', "3rd element still there after popping" );
73is( $popped, 'elem4', "Popped value is correct" );
74
75my $shifted = $db->shift;
76is( $db->length, 3, "... and we have three after shifting" );
77is( $db->[0], 'elem1', "0th element still there after shifting" );
78is( $db->[1], 'elem2', "1st element still there after shifting" );
79is( $db->[2], 'elem3', "2nd element still there after shifting" );
80is( $shifted, 'elem0', "Shifted value is correct" );
81
82##
83# delete
84##
85my $deleted = $db->delete(0);
86is( $db->length, 3, "... and we still have three after deleting" );
87is( $db->[0], undef, "0th element now undef" );
88is( $db->[1], 'elem2', "1st element still there after deleting" );
89is( $db->[2], 'elem3', "2nd element still there after deleting" );
90TODO: {
91 local $TODO = "delete on an array element should return the deleted value";
92 is( $deleted, 'elem1', "Deleted value is correct" );
93}
94
95is( $db->delete(99), undef, 'delete on an element not in the array returns undef' );
96is( $db->length, 3, "... and we still have three after a delete on an out-of-range index" );
97
98is( delete $db->[99], undef, 'DELETE on an element not in the array returns undef' );
99is( $db->length, 3, "... and we still have three after a DELETE on an out-of-range index" );
100
101is( $db->delete(-99), undef, 'delete on an element (neg) not in the array returns undef' );
102is( $db->length, 3, "... and we still have three after a DELETE on an out-of-range negative index" );
103
104is( delete $db->[-99], undef, 'DELETE on an element (neg) not in the array returns undef' );
105is( $db->length, 3, "... and we still have three after a DELETE on an out-of-range negative index" );
106
107$deleted = $db->delete(-2);
108is( $db->length, 3, "... and we still have three after deleting" );
109is( $db->[0], undef, "0th element still undef" );
110TODO: {
111 local $TODO = "delete on a negative array element should work";
112 is( $db->[1], undef, "1st element now undef" );
113}
114is( $db->[2], 'elem3', "2nd element still there after deleting" );
115TODO: {
116 local $TODO = "delete on an array element should return the deleted value";
117 is( $deleted, 'elem2', "Deleted value is correct" );
118}
119
120$db->[1] = 'elem2';
121
122##
123# exists
124##
125ok( $db->exists(1), "The 1st value exists" );
126ok( !$db->exists(0), "The 0th value doesn't exists" );
127ok( !$db->exists(22), "The 22nd value doesn't exists" );
128TODO: {
129 local $TODO = "exists on negative values should work";
130 ok( $db->exists(-1), "The -1st value does exists" );
131}
132ok( !$db->exists(-22), "The -22nd value doesn't exists" );
133
134##
135# clear
136##
137ok( $db->clear(), "clear() returns true if the file was ever non-empty" );
138is( $db->length(), 0, "After clear(), no more elements" );
139
140is( $db->pop, undef, "pop on an empty array returns undef" );
141is( $db->length(), 0, "After pop() on empty array, length is still 0" );
142
143is( $db->shift, undef, "shift on an empty array returns undef" );
144is( $db->length(), 0, "After shift() on empty array, length is still 0" );
145
146TODO: {
147 local $TODO = "unshift returns the number of elements in the array";
148 is( $db->unshift( 1, 2, 3 ), 3, "unshift returns the number of elements in the array" );
149 is( $db->unshift( 1, 2, 3 ), 6, "unshift returns the number of elements in the array" );
150 is( $db->push( 1, 2, 3 ), 9, "unshift returns the number of elements in the array" );
151}
152is( $db->length(), 9, "After unshift and push on empty array, length is now 9" );
153
154$db->clear;
155
156##
157# multi-push
158##
159$db->push( 'elem first', "elem middle", "elem last" );
160is( $db->length, 3, "3-element push results in three elements" );
161is($db->[0], "elem first", "First element is 'elem first'");
162is($db->[1], "elem middle", "Second element is 'elem middle'");
163is($db->[2], "elem last", "Third element is 'elem last'");
164
165##
166# splice with length 1
167##
168$db->splice( 1, 1, "middle A", "middle B" );
169is($db->length(), 4);
170is($db->[0], "elem first");
171is($db->[1], "middle A");
172is($db->[2], "middle B");
173is($db->[3], "elem last");
174
175##
176# splice with length of 0
177##
178$db->splice( -1, 0, "middle C" );
179is($db->length(), 5);
180is($db->[0], "elem first");
181is($db->[1], "middle A");
182is($db->[2], "middle B");
183is($db->[3], "middle C");
184is($db->[4], "elem last");
185
186##
187# splice with length of 3
188##
189$db->splice( 1, 3, "middle ABC" );
190is($db->length(), 3);
191is($db->[0], "elem first");
192is($db->[1], "middle ABC");
193is($db->[2], "elem last");
194
195# These tests verify that the hash methods cannot be called on arraytypes.
196# They will be removed once the ARRAY and HASH types are refactored into their own classes.
197
198$db->[0] = [ 1 .. 3 ];
199$db->[1] = { a => 'foo' };
200is( $db->[0]->length, 3, "Reuse of same space with array successful" );
201is( $db->[1]->fetch('a'), 'foo', "Reuse of same space with hash successful" );
202
203throws_ok {
204 $db->FIRSTKEY();
205} qr/FIRSTKEY method only supported for hashes/, "Cannot call FIRSTKEY on an array type";
206
207throws_ok {
208 $db->first_key();
209} qr/FIRSTKEY method only supported for hashes/, "Cannot call first_key on an array type";
210
211throws_ok {
212 $db->NEXTKEY();
213} qr/NEXTKEY method only supported for hashes/, "Cannot call NEXTKEY on an array type";
214
215throws_ok {
216 $db->next_key();
217} qr/NEXTKEY method only supported for hashes/, "Cannot call next_key on an array type";