3 # $RCSfile: dbm.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:43 $
7 require Config; import Config;
8 if ($Config{'extensions'} !~ /\bGDBM_File\b/) {
21 print (tie(%h,GDBM_File,'Op.dbmx', &GDBM_WRCREAT, 0640) ? "ok 1\n" : "not ok 1\n");
23 $Dfile = "Op.dbmx.pag";
25 ($Dfile) = <Op.dbmx*>;
27 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
28 $blksize,$blocks) = stat($Dfile);
29 print (($mode & 0777) == ($^O eq 'os2' ? 0666 : 0640) || $^O eq 'amigaos'
30 ? "ok 2\n" : "not ok 2\n");
31 while (($key,$value) = each(%h)) {
34 print (!$i ? "ok 3\n" : "not ok 3\n");
36 $h{'goner1'} = 'snork';
40 $h{'jkl','mno'} = "JKL\034MNO";
41 $h{'a',2,3,4,5} = join("\034",'A',2,3,4,5);
52 $h{'goner2'} = 'snork';
56 print (tie(%h,GDBM_File,'Op.dbmx', &GDBM_WRCREAT, 0640) ? "ok 4\n" : "not ok 4\n");
76 $h{'goner3'} = 'snork';
84 if ($#keys == 29 && $#values == 29) {print "ok 5\n";} else {print "not ok 5\n";}
86 while (($key,$value) = each(h)) {
87 if ($key eq $keys[$i] && $value eq $values[$i] && $key eq lc($value)) {
89 $i++ if $key eq $value;
93 if ($i == 30) {print "ok 6\n";} else {print "not ok 6\n";}
95 @keys = ('blurfl', keys(h), 'dyick');
96 if ($#keys == 31) {print "ok 7\n";} else {print "not ok 7\n";}
101 # check cache overflow and numeric keys and contents
103 for ($i = 1; $i < 200; $i++) { $h{$i + 0} = $i + 0; }
104 for ($i = 1; $i < 200; $i++) { $ok = 0 unless $h{$i} == $i; }
105 print ($ok ? "ok 8\n" : "not ok 8\n");
107 ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
108 $blksize,$blocks) = stat($Dfile);
109 print ($size > 0 ? "ok 9\n" : "not ok 9\n");
111 @h{0..200} = 200..400;
113 print join(':',200..400) eq join(':',@foo) ? "ok 10\n" : "not ok 10\n";
115 print ($h{'foo'} eq '' ? "ok 11\n" : "not ok 11\n");
116 print ($h{''} eq 'bar' ? "ok 12\n" : "not ok 12\n");
119 unlink 'Op.dbmx.dir', $Dfile;