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