here's a test that shows the memory leak
[dbsrgits/DBM-Deep.git] / t / 15_digest.t
CommitLineData
ffed8b01 1##
2# DBM::Deep Test
3##
4use strict;
2a81bf9e 5use Test::More tests => 14;
fde3db1a 6use t::common qw( new_fh );
ffed8b01 7
2a81bf9e 8use_ok( 'DBM::Deep' );
9
fde3db1a 10my ($fh, $filename) = new_fh();
ffed8b01 11
12my $salt = 38473827;
13
ffed8b01 14my $db = new DBM::Deep(
2a81bf9e 15 file => $filename,
e0098e7f 16 digest => \&my_digest,
17 hash_size => 8,
ffed8b01 18);
ffed8b01 19
20##
ffed8b01 21# put/get key
22##
23$db->{key1} = "value1";
24ok( $db->{key1} eq "value1" );
25
26$db->put("key2", "value2");
27ok( $db->get("key2") eq "value2" );
28
29##
30# key exists
31##
32ok( $db->exists("key1") );
33ok( exists $db->{key2} );
34
35##
36# count keys
37##
38ok( scalar keys %$db == 2 );
39
40##
41# step through keys
42##
43my $temphash = {};
44while ( my ($key, $value) = each %$db ) {
45 $temphash->{$key} = $value;
46}
47
48ok( ($temphash->{key1} eq "value1") && ($temphash->{key2} eq "value2") );
49
50$temphash = {};
51my $key = $db->first_key();
52while ($key) {
53 $temphash->{$key} = $db->get($key);
54 $key = $db->next_key($key);
55}
56
57ok( ($temphash->{key1} eq "value1") && ($temphash->{key2} eq "value2") );
58
59##
60# delete keys
61##
62ok( delete $db->{key1} );
63ok( $db->delete("key2") );
64
65ok( scalar keys %$db == 0 );
66
67##
68# delete all keys
69##
70$db->put("another", "value");
71$db->clear();
72
73ok( scalar keys %$db == 0 );
74
75##
76# replace key
77##
78$db->put("key1", "value1");
79$db->put("key1", "value2");
80
81ok( $db->get("key1") eq "value2" );
82
83$db->put("key1", "value222222222222222222222222");
84
85ok( $db->get("key1") eq "value222222222222222222222222" );
86
ffed8b01 87sub my_digest {
88 ##
89 # Warning: This digest function is for testing ONLY
90 # It is NOT intended for actual use
91 ##
92 my $key = shift;
93 my $num = $salt;
94
95 for (my $k=0; $k<length($key); $k++) {
96 $num += ord( substr($key, $k, 1) );
97 }
98
99 return sprintf("%00000008d", $num);
100}