1N/A# $RCSfile: dbm.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:43 $ 1N/A chdir 't' if -d 't'; 1N/A print "1..0 # Skip: ODBM_File was not built\n"; 1N/A#If Fcntl is not available, try 0x202 or 0x102 for O_RDWR|O_CREAT 1N/Aif ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'NetWare') { 1N/A print "ok 2 # Skipped: different file permission semantics\n"; 1N/A my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, 1N/A print (($mode & 0777) == 0640 ? "ok 2\n" : "not ok 2\n"); 1N/Aprint (!$i ? "ok 3\n" : "not ok 3\n");
1N/A$h{
'goner1'} =
'snork';
1N/A$h{
'jkl',
'mno'} =
"JKL\034MNO";
1N/A$h{
'a',
2,
3,
4,
5} =
join("\034",'A',2,3,4,5);
1N/A$h{
'goner2'} =
'snork';
1N/A$h{
'goner3'} =
'snork';
1N/Aif ($#keys == 29 && $#values == 29) {
print "ok 5\n";}
else {
print "not ok 5\n";}
1N/Aif ($i == 30) {
print "ok 6\n";}
else {
print "not ok 6\n";}
1N/Aif ($#keys == 31) {
print "ok 7\n";}
else {
print "not ok 7\n";}
1N/A# check cache overflow and numeric keys and contents 1N/Afor ($i = 1; $i < 200; $i++) { $h{$i + 0} = $i + 0; } 1N/Afor ($i = 1; $i < 200; $i++) { $ok = 0 unless $h{$i} == $i; } 1N/Aprint ($ok ? "ok 8\n" : "not ok 8\n");
1N/Amy ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, 1N/Aprint ($size > 0 ? "ok 9\n" : "not ok 9\n");
1N/A@h{
0..
200} =
200..
400;
1N/Aprint ($h{'foo'} eq '' ? "ok 11\n" : "not ok 11\n");
1N/Aprint ($h{''} eq 'bar' ? "ok 12\n" : "not ok 12\n");
1N/A eval 'use SubDB ; use Fcntl ;'; 1N/A my $ret = eval '$h{"fred"} = 3 ; return $h{"fred"} ' ; 1N/A $ret = eval '$X->A_new_method("fred") ' ; 1N/A $h{"fred"} = "joe" ; 1N/A # replace the filters, but remember the previous set 1N/A $h{"Fred"} = "Joe" ; 1N/A # put the original filters back 1N/A $h{"fred"} = "joe" ; 1N/A # delete the filters 1N/A $h{"fred"} = "joe" ; 1N/A # DBM Filter with a closure 1N/A $h{"fred"} = "joe" ; 1N/A $h{"jim"} = "john" ; 1N/A # DBM Filter recursion detection 1N/A eval '$h{1} = 1234' ; 1N/A # Bug ID 20001013.009 1N/A # test that $hash{KEY} = undef doesn't produce the warning 1N/A # Use of uninitialized value in null operation 1N/A # When iterating over a tied hash using "each", the key passed to FETCH 1N/A # will be recycled and passed to NEXTKEY. If a Source Filter modifies the 1N/A # key in FETCH via a filter_fetch_key method we need to check that the 1N/A # modified key doesn't get passed to NEXTKEY. 1N/A # Also Test "keys" & "values" while we are at it. 1N/A $h{'Alpha_ABC'} = 2 ; 1N/A $h{'Alpha_DEF'} = 5 ; 1N/A ok(68, $h{'Alpha_ABC'} == 2); 1N/A ok(69, $h{'Alpha_DEF'} == 5); 1N/A my ($k, $v) = ("",""); 1N/A # Check that DBM Filter can cope with read-only $_ 1N/A $h{"fred"} = "joe" ; 1N/A eval { grep { $h{$_} } (1, 2, 3) }; 1N/A # delete the filters 1N/A $h{"fred"} = "joe" ; 1N/A eval { grep { $h{$_} } (1, 2, 3) }; 1N/A# If you experience failures with the odbm test in HP-UX, 1N/A# this is a well-known bug that's unfortunately very hard to fix. 1N/A# The suggested course of action is to avoid using the ODBM_File, 1N/A# but to use instead the NDBM_File extension.