5 #@INC = '../lib' if -d '../lib' ;
7 require Config; import Config;
8 if ($Config{'extensions'} !~ /\bDB_File\b/) {
24 print "not " unless $result ;
28 $Dfile = "dbhash.tmp";
33 # Check the interface to HASHINFO
35 my $dbh = new DB_File::HASHINFO ;
38 ok(1, $dbh->{bsize} == undef) ;
39 ok(2, $dbh->{ffactor} == undef) ;
40 ok(3, $dbh->{nelem} == undef) ;
41 ok(4, $dbh->{cachesize} == undef) ;
42 ok(5, $dbh->{hash} == undef) ;
43 ok(6, $dbh->{lorder} == undef) ;
46 $dbh->{bsize} = 3000 ;
47 ok(7, $dbh->{bsize} == 3000 );
49 $dbh->{ffactor} = 9000 ;
50 ok(8, $dbh->{ffactor} == 9000 );
53 ok(9, $dbh->{nelem} == 400 );
55 $dbh->{cachesize} = 65 ;
56 ok(10, $dbh->{cachesize} == 65 );
58 $dbh->{hash} = "abc" ;
59 ok(11, $dbh->{hash} eq "abc" );
61 $dbh->{lorder} = 1234 ;
62 ok(12, $dbh->{lorder} == 1234 );
64 # Check that an invalid entry is caught both for store & fetch
65 eval '$dbh->{fred} = 1234' ;
66 ok(13, $@ =~ /^DB_File::HASHINFO::STORE - Unknown element 'fred' at/ );
67 eval '$q = $dbh->{fred}' ;
68 ok(14, $@ =~ /^DB_File::HASHINFO::FETCH - Unknown element 'fred' at/ );
70 # Now check the interface to HASH
72 ok(15, $X = tie(%h, 'DB_File',$Dfile, O_RDWR|O_CREAT, 0640, $DB_HASH ) );
74 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
75 $blksize,$blocks) = stat($Dfile);
76 ok(16, ($mode & 0777) == ($^O eq 'os2' ? 0666 : 0640) );
78 while (($key,$value) = each(%h)) {
83 $h{'goner1'} = 'snork';
86 ok(18, $h{'abc'} eq 'ABC' );
87 ok(19, !defined $h{'jimmy'} );
88 ok(20, !exists $h{'jimmy'} );
89 ok(21, exists $h{'abc'} );
92 $h{'jkl','mno'} = "JKL\034MNO";
93 $h{'a',2,3,4,5} = join("\034",'A',2,3,4,5);
110 $h{'goner2'} = 'snork';
114 # IMPORTANT - $X must be undefined before the untie otherwise the
115 # underlying DB close routine will not get called.
120 # tie to the same file again, do not supply a type - should default to HASH
121 ok(22, $X = tie(%h,'DB_File',$Dfile, O_RDWR, 0640) );
123 # Modify an entry from the previous tie
144 $h{'goner3'} = 'snork';
147 $X->DELETE('goner3');
150 @values = values(%h);
152 ok(23, $#keys == 29 && $#values == 29) ;
155 while (($key,$value) = each(%h)) {
156 if ($key eq $keys[$i] && $value eq $values[$i] && $key eq lc($value)) {
158 $i++ if $key eq $value;
164 @keys = ('blurfl', keys(%h), 'dyick');
165 ok(25, $#keys == 31) ;
168 ok(26, $h{'foo'} eq '' );
171 ok(27, $h{''} eq 'bar' );
173 # check cache overflow and numeric keys and contents
175 for ($i = 1; $i < 200; $i++) { $h{$i + 0} = $i + 0; }
176 for ($i = 1; $i < 200; $i++) { $ok = 0 unless $h{$i} == $i; }
179 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
180 $blksize,$blocks) = stat($Dfile);
183 @h{0..200} = 200..400;
185 ok(30, join(':',200..400) eq join(':',@foo) );
188 # Now check all the non-tie specific stuff
190 # Check NOOVERWRITE will make put fail when attempting to overwrite
191 # an existing record.
193 $status = $X->put( 'x', 'newvalue', R_NOOVERWRITE) ;
194 ok(31, $status == 1 );
196 # check that the value of the key 'x' has not been changed by the
198 ok(32, $h{'x'} eq 'X' );
201 $status = $X->put('key', 'value') ;
202 ok(33, $status == 0 );
204 #check that previous put can be retrieved
206 $status = $X->get('key', $value) ;
207 ok(34, $status == 0 );
208 ok(35, $value eq 'value' );
210 # Attempting to delete an existing key should work
212 $status = $X->del('q') ;
213 ok(36, $status == 0 );
215 # Make sure that the key deleted, cannot be retrieved
217 ok(37, $h{'q'} eq undef );
220 # Attempting to delete a non-existant key should fail
222 $status = $X->del('joe') ;
223 ok(38, $status == 1 );
225 # Check the get interface
227 # First a non-existing key
228 $status = $X->get('aaaa', $value) ;
229 ok(39, $status == 1 );
231 # Next an existing key
232 $status = $X->get('a', $value) ;
233 ok(40, $status == 0 );
234 ok(41, $value eq 'A' );
239 # ditto, but use put to replace the key/value pair.
241 # use seq to walk backwards through a file - check that this reversed is
243 # check seq FIRST/LAST
249 ok(42, $status == 0 );
256 ok(43, $status != 0 );
266 ok(44, tie(%h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_HASH ) );
268 { $h{$_} = $_ * 100 }
270 # check that there are 10 elements in the hash
272 while (($key,$value) = each(%h)) {
282 while (($key,$value) = each(%h)) {
291 # Now try an in memory file
292 ok(47, $X = tie(%h, 'DB_File',undef, O_RDWR|O_CREAT, 0640, $DB_HASH ) );
294 # fd with an in memory file should return fail
296 ok(48, $status == -1 );