[dbsrgits/DBM-Deep.git] / t / 04_array.t

##
# DBM::Deep Test
##
use strict;
use Test::More tests => 89;
use Test::Exception;

use_ok( 'DBM::Deep' );

##
# basic file open
##
unlink "t/test.db";
my $db = DBM::Deep->new(
	file => "t/test.db",
	type => DBM::Deep->TYPE_ARRAY
);
if ($db->error()) {
	die "ERROR: " . $db->error();
}

TODO: {
    local $TODO = "How is this test ever supposed to pass?";
    ok( !$db->clear, "If the file has never been written to, clear() returns false" );
}

##
# basic put/get/push
##
$db->[0] = "elem1";
$db->push( "elem2" );
$db->put(2, "elem3");
$db->store(3, "elem4");
$db->unshift("elem0");

is( $db->[0], 'elem0', "Array get for shift works" );
is( $db->[1], 'elem1', "Array get for array set works" );
is( $db->[2], 'elem2', "Array get for push() works" );
is( $db->[3], 'elem3', "Array get for put() works" );
is( $db->[4], 'elem4', "Array get for store() works" );

is( $db->get(0), 'elem0', "get() for shift() works" );
is( $db->get(1), 'elem1', "get() for array set works" );
is( $db->get(2), 'elem2', "get() for push() works" );
is( $db->get(3), 'elem3', "get() for put() works" );
is( $db->get(4), 'elem4', "get() for store() works" );

is( $db->fetch(0), 'elem0', "fetch() for shift() works" );
is( $db->fetch(1), 'elem1', "fetch() for array set works" );
is( $db->fetch(2), 'elem2', "fetch() for push() works" );
is( $db->fetch(3), 'elem3', "fetch() for put() works" );
is( $db->fetch(4), 'elem4', "fetch() for store() works" );

is( $db->length, 5, "... and we have five elements" );

is( $db->[-1], $db->[4], "-1st index is 4th value" );
is( $db->[-2], $db->[3], "-2nd index is 3rd value" );
is( $db->[-3], $db->[2], "-3rd index is 2nd value" );
is( $db->[-4], $db->[1], "-4th index is 1st value" );
is( $db->[-5], $db->[0], "-5th index is 0th value" );
TODO: {
    local $TODO = "Going off the end of the array from the back is legal";
    eval { is( $db->[-6], undef, "-6th index is undef" ); };
}
is( $db->length, 5, "... and we have five elements after abortive -6 index lookup" );

my $popped = $db->pop;
is( $db->length, 4, "... and we have four after popping" );
is( $db->[0], 'elem0', "0th element still there after popping" );
is( $db->[1], 'elem1', "1st element still there after popping" );
is( $db->[2], 'elem2', "2nd element still there after popping" );
is( $db->[3], 'elem3', "3rd element still there after popping" );
is( $popped, 'elem4', "Popped value is correct" );

my $shifted = $db->shift;
is( $db->length, 3, "... and we have three after shifting" );
is( $db->[0], 'elem1', "0th element still there after shifting" );
is( $db->[1], 'elem2', "1st element still there after shifting" );
is( $db->[2], 'elem3', "2nd element still there after shifting" );
is( $shifted, 'elem0', "Shifted value is correct" );

##
# delete
##
my $deleted = $db->delete(0);
is( $db->length, 3, "... and we still have three after deleting" );
is( $db->[0], undef, "0th element now undef" );
is( $db->[1], 'elem2', "1st element still there after deleting" );
is( $db->[2], 'elem3', "2nd element still there after deleting" );
is( $deleted, 'elem1', "Deleted value is correct" );

is( $db->delete(99), undef, 'delete on an element not in the array returns undef' );
is( $db->length, 3, "... and we still have three after a delete on an out-of-range index" );

is( delete $db->[99], undef, 'DELETE on an element not in the array returns undef' );
is( $db->length, 3, "... and we still have three after a DELETE on an out-of-range index" );

is( $db->delete(-99), undef, 'delete on an element (neg) not in the array returns undef' );
is( $db->length, 3, "... and we still have three after a DELETE on an out-of-range negative index" );

is( delete $db->[-99], undef, 'DELETE on an element (neg) not in the array returns undef' );
is( $db->length, 3, "... and we still have three after a DELETE on an out-of-range negative index" );

$deleted = $db->delete(-2);
is( $db->length, 3, "... and we still have three after deleting" );
is( $db->[0], undef, "0th element still undef" );
TODO: {
    local $TODO = "delete on a negative array element should work";
    is( $db->[1], undef, "1st element now undef" );
}
is( $db->[2], 'elem3', "2nd element still there after deleting" );
TODO: {
    local $TODO = "delete on a negative array element should return the deleted value";
    is( $deleted, 'elem2', "Deleted value is correct" );
}

$db->[1] = 'elem2';

##
# exists
##
ok( $db->exists(1), "The 1st value exists" );
ok( !$db->exists(0), "The 0th value doesn't exists" );
ok( !$db->exists(22), "The 22nd value doesn't exists" );
TODO: {
    local $TODO = "exists on negative values should work";
    ok( $db->exists(-1), "The -1st value does exists" );
}
ok( !$db->exists(-22), "The -22nd value doesn't exists" );

##
# clear
##
ok( $db->clear(), "clear() returns true if the file was ever non-empty" );
is( $db->length(), 0, "After clear(), no more elements" );

is( $db->pop, undef, "pop on an empty array returns undef" );
is( $db->length(), 0, "After pop() on empty array, length is still 0" );

is( $db->shift, undef, "shift on an empty array returns undef" );
is( $db->length(), 0, "After shift() on empty array, length is still 0" );

is( $db->unshift( 1, 2, 3 ), 3, "unshift returns the number of elements in the array" );
is( $db->unshift( 1, 2, 3 ), 6, "unshift returns the number of elements in the array" );
is( $db->push( 1, 2, 3 ), 9, "push returns the number of elements in the array" );

is( $db->length(), 9, "After unshift and push on empty array, length is now 9" );

$db->clear;

##
# multi-push
##
$db->push( 'elem first', "elem middle", "elem last" );
is( $db->length, 3, "3-element push results in three elements" );
is($db->[0], "elem first", "First element is 'elem first'");
is($db->[1], "elem middle", "Second element is 'elem middle'");
is($db->[2], "elem last", "Third element is 'elem last'");

##
# splice with length 1
##
$db->splice( 1, 1, "middle A", "middle B" );
is($db->length(), 4);
is($db->[0], "elem first");
is($db->[1], "middle A");
is($db->[2], "middle B");
is($db->[3], "elem last");

##
# splice with length of 0
##
$db->splice( -1, 0, "middle C" );
is($db->length(), 5);
is($db->[0], "elem first");
is($db->[1], "middle A");
is($db->[2], "middle B");
is($db->[3], "middle C");
is($db->[4], "elem last");

##
# splice with length of 3
##
$db->splice( 1, 3, "middle ABC" );
is($db->length(), 3);
is($db->[0], "elem first");
is($db->[1], "middle ABC");
is($db->[2], "elem last");

# These tests verify that the hash methods cannot be called on arraytypes.
# They will be removed once the ARRAY and HASH types are refactored into their own classes.

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