1*0Sstevel@tonic-gate#!./perl 2*0Sstevel@tonic-gate 3*0Sstevel@tonic-gate# $RCSfile: dbm.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:43 $ 4*0Sstevel@tonic-gate 5*0Sstevel@tonic-gateBEGIN { 6*0Sstevel@tonic-gate chdir 't' if -d 't'; 7*0Sstevel@tonic-gate @INC = '../lib'; 8*0Sstevel@tonic-gate require Config; import Config; 9*0Sstevel@tonic-gate require Test::More; import Test::More; 10*0Sstevel@tonic-gate plan(tests, 12); 11*0Sstevel@tonic-gate} 12*0Sstevel@tonic-gate 13*0Sstevel@tonic-gaterequire AnyDBM_File; 14*0Sstevel@tonic-gateuse Fcntl; 15*0Sstevel@tonic-gate 16*0Sstevel@tonic-gate 17*0Sstevel@tonic-gate$Is_Dosish = ($^O eq 'amigaos' || $^O eq 'MSWin32' || 18*0Sstevel@tonic-gate $^O eq 'NetWare' || $^O eq 'dos' || 19*0Sstevel@tonic-gate $^O eq 'os2' || $^O eq 'mint' || 20*0Sstevel@tonic-gate $^O eq 'cygwin'); 21*0Sstevel@tonic-gate 22*0Sstevel@tonic-gateunlink <Op_dbmx*>; 23*0Sstevel@tonic-gate 24*0Sstevel@tonic-gateumask(0); 25*0Sstevel@tonic-gate 26*0Sstevel@tonic-gateok( tie(%h,AnyDBM_File,'Op_dbmx', O_RDWR|O_CREAT, 0640), "Tie"); 27*0Sstevel@tonic-gate 28*0Sstevel@tonic-gate$Dfile = "Op_dbmx.pag"; 29*0Sstevel@tonic-gateif (! -e $Dfile) { 30*0Sstevel@tonic-gate ($Dfile) = <Op_dbmx*>; 31*0Sstevel@tonic-gate} 32*0Sstevel@tonic-gate 33*0Sstevel@tonic-gateSKIP: 34*0Sstevel@tonic-gate{ 35*0Sstevel@tonic-gate skip( "different file permission semantics",1) 36*0Sstevel@tonic-gate if ($Is_Dosish || $^O eq 'MacOS') ; 37*0Sstevel@tonic-gate ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, 38*0Sstevel@tonic-gate $blksize,$blocks) = stat($Dfile); 39*0Sstevel@tonic-gate ok(($mode & 0777) == ($^O eq 'vos' ? 0750 : 0640) , "File permissions"); 40*0Sstevel@tonic-gate} 41*0Sstevel@tonic-gate 42*0Sstevel@tonic-gatewhile (($key,$value) = each(%h)) { 43*0Sstevel@tonic-gate $i++; 44*0Sstevel@tonic-gate} 45*0Sstevel@tonic-gate 46*0Sstevel@tonic-gateok(!$i,"Hash created empty"); 47*0Sstevel@tonic-gate 48*0Sstevel@tonic-gate$h{'goner1'} = 'snork'; 49*0Sstevel@tonic-gate 50*0Sstevel@tonic-gate$h{'abc'} = 'ABC'; 51*0Sstevel@tonic-gate$h{'def'} = 'DEF'; 52*0Sstevel@tonic-gate$h{'jkl','mno'} = "JKL\034MNO"; 53*0Sstevel@tonic-gate$h{'a',2,3,4,5} = join("\034",'A',2,3,4,5); 54*0Sstevel@tonic-gate$h{'a'} = 'A'; 55*0Sstevel@tonic-gate$h{'b'} = 'B'; 56*0Sstevel@tonic-gate$h{'c'} = 'C'; 57*0Sstevel@tonic-gate$h{'d'} = 'D'; 58*0Sstevel@tonic-gate$h{'e'} = 'E'; 59*0Sstevel@tonic-gate$h{'f'} = 'F'; 60*0Sstevel@tonic-gate$h{'g'} = 'G'; 61*0Sstevel@tonic-gate$h{'h'} = 'H'; 62*0Sstevel@tonic-gate$h{'i'} = 'I'; 63*0Sstevel@tonic-gate 64*0Sstevel@tonic-gate$h{'goner2'} = 'snork'; 65*0Sstevel@tonic-gatedelete $h{'goner2'}; 66*0Sstevel@tonic-gate 67*0Sstevel@tonic-gateuntie(%h); 68*0Sstevel@tonic-gateok(tie(%h,AnyDBM_File,'Op_dbmx', O_RDWR, 0640),"Re-tie hash"); 69*0Sstevel@tonic-gate 70*0Sstevel@tonic-gate$h{'j'} = 'J'; 71*0Sstevel@tonic-gate$h{'k'} = 'K'; 72*0Sstevel@tonic-gate$h{'l'} = 'L'; 73*0Sstevel@tonic-gate$h{'m'} = 'M'; 74*0Sstevel@tonic-gate$h{'n'} = 'N'; 75*0Sstevel@tonic-gate$h{'o'} = 'O'; 76*0Sstevel@tonic-gate$h{'p'} = 'P'; 77*0Sstevel@tonic-gate$h{'q'} = 'Q'; 78*0Sstevel@tonic-gate$h{'r'} = 'R'; 79*0Sstevel@tonic-gate$h{'s'} = 'S'; 80*0Sstevel@tonic-gate$h{'t'} = 'T'; 81*0Sstevel@tonic-gate$h{'u'} = 'U'; 82*0Sstevel@tonic-gate$h{'v'} = 'V'; 83*0Sstevel@tonic-gate$h{'w'} = 'W'; 84*0Sstevel@tonic-gate$h{'x'} = 'X'; 85*0Sstevel@tonic-gate$h{'y'} = 'Y'; 86*0Sstevel@tonic-gate$h{'z'} = 'Z'; 87*0Sstevel@tonic-gate 88*0Sstevel@tonic-gate$h{'goner3'} = 'snork'; 89*0Sstevel@tonic-gate 90*0Sstevel@tonic-gatedelete $h{'goner1'}; 91*0Sstevel@tonic-gatedelete $h{'goner3'}; 92*0Sstevel@tonic-gate 93*0Sstevel@tonic-gate@keys = keys(%h); 94*0Sstevel@tonic-gate@values = values(%h); 95*0Sstevel@tonic-gate 96*0Sstevel@tonic-gateok( ($#keys == 29 && $#values == 29),'$#keys == $#values'); 97*0Sstevel@tonic-gate 98*0Sstevel@tonic-gatewhile (($key,$value) = each(%h)) { 99*0Sstevel@tonic-gate if ($key eq $keys[$i] && $value eq $values[$i] && $key eq lc($value)) { 100*0Sstevel@tonic-gate $key =~ y/a-z/A-Z/; 101*0Sstevel@tonic-gate $i++ if $key eq $value; 102*0Sstevel@tonic-gate } 103*0Sstevel@tonic-gate} 104*0Sstevel@tonic-gate 105*0Sstevel@tonic-gateok($i == 30,"keys and values match"); 106*0Sstevel@tonic-gate 107*0Sstevel@tonic-gate@keys = ('blurfl', keys(%h), 'dyick'); 108*0Sstevel@tonic-gateok($#keys == 31,"Correct number of keys"); 109*0Sstevel@tonic-gate 110*0Sstevel@tonic-gate$h{'foo'} = ''; 111*0Sstevel@tonic-gate$h{''} = 'bar'; 112*0Sstevel@tonic-gate 113*0Sstevel@tonic-gate# check cache overflow and numeric keys and contents 114*0Sstevel@tonic-gate$ok = 1; 115*0Sstevel@tonic-gatefor ($i = 1; $i < 200; $i++) { $h{$i + 0} = $i + 0; } 116*0Sstevel@tonic-gatefor ($i = 1; $i < 200; $i++) { $ok = 0 unless $h{$i} == $i; } 117*0Sstevel@tonic-gateok($ok, "cache overflow and numeric keys and contents"); 118*0Sstevel@tonic-gate 119*0Sstevel@tonic-gate($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, 120*0Sstevel@tonic-gate $blksize,$blocks) = stat($Dfile); 121*0Sstevel@tonic-gateok($size > 0, "check file size"); 122*0Sstevel@tonic-gate 123*0Sstevel@tonic-gate@h{0..200} = 200..400; 124*0Sstevel@tonic-gate@foo = @h{0..200}; 125*0Sstevel@tonic-gateok( join(':',200..400) eq join(':',@foo), "hash slice"); 126*0Sstevel@tonic-gate 127*0Sstevel@tonic-gateok($h{'foo'} eq '', "empty value"); 128*0Sstevel@tonic-gate 129*0Sstevel@tonic-gatemy $compact = ''; 130*0Sstevel@tonic-gate 131*0Sstevel@tonic-gateif ($AnyDBM_File::ISA[0] eq 'DB_File' && ($DB_File::db_ver >= 2.004010 && $DB_File::db_ver < 3.001)) { 132*0Sstevel@tonic-gate ($major, $minor, $patch) = ($DB_File::db_ver =~ /^(\d+)\.(\d\d\d)(\d\d\d)/) ; 133*0Sstevel@tonic-gate $major =~ s/^0+// ; 134*0Sstevel@tonic-gate $minor =~ s/^0+// ; 135*0Sstevel@tonic-gate $patch =~ s/^0+// ; 136*0Sstevel@tonic-gate $compact = "$major.$minor.$patch" ; 137*0Sstevel@tonic-gate # 138*0Sstevel@tonic-gate # anydbm.t test 12 will fail when AnyDBM_File uses the combination of 139*0Sstevel@tonic-gate # DB_File and Berkeley DB 2.4.10 (or greater). 140*0Sstevel@tonic-gate # You are using DB_File $DB_File::VERSION and Berkeley DB $compact 141*0Sstevel@tonic-gate # 142*0Sstevel@tonic-gate # Berkeley DB 2 from version 2.4.10 onwards does not allow null keys. 143*0Sstevel@tonic-gate # This feature returned with version 3.1 144*0Sstevel@tonic-gate # 145*0Sstevel@tonic-gate} 146*0Sstevel@tonic-gate 147*0Sstevel@tonic-gateSKIP: 148*0Sstevel@tonic-gate{ 149*0Sstevel@tonic-gate skip( "db v$compact, no null key support", 1) if $compact; 150*0Sstevel@tonic-gate ok($h{''} eq 'bar','null key'); 151*0Sstevel@tonic-gate} 152*0Sstevel@tonic-gate 153*0Sstevel@tonic-gateuntie %h; 154*0Sstevel@tonic-gate 155*0Sstevel@tonic-gateif ($^O eq 'VMS') { 156*0Sstevel@tonic-gate unlink 'Op_dbmx.sdbm_dir', $Dfile; 157*0Sstevel@tonic-gate} else { 158*0Sstevel@tonic-gate unlink 'Op_dbmx.dir', $Dfile; 159*0Sstevel@tonic-gate} 160