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