| 1 | #!./perl
|
|---|
| 2 |
|
|---|
| 3 | # $RCSfile: dbm.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:43 $
|
|---|
| 4 |
|
|---|
| 5 | BEGIN {
|
|---|
| 6 | chdir 't' if -d 't';
|
|---|
| 7 | @INC = '../lib';
|
|---|
| 8 | require Config; import Config;
|
|---|
| 9 | require Test::More; import Test::More;
|
|---|
| 10 | plan(tests, 12);
|
|---|
| 11 | }
|
|---|
| 12 |
|
|---|
| 13 | require AnyDBM_File;
|
|---|
| 14 | use Fcntl;
|
|---|
| 15 |
|
|---|
| 16 |
|
|---|
| 17 | $Is_Dosish = ($^O eq 'amigaos' || $^O eq 'MSWin32' ||
|
|---|
| 18 | $^O eq 'NetWare' || $^O eq 'dos' ||
|
|---|
| 19 | $^O eq 'os2' || $^O eq 'mint' ||
|
|---|
| 20 | $^O eq 'cygwin');
|
|---|
| 21 |
|
|---|
| 22 | unlink <Op_dbmx*>;
|
|---|
| 23 |
|
|---|
| 24 | umask(0);
|
|---|
| 25 |
|
|---|
| 26 | ok( tie(%h,AnyDBM_File,'Op_dbmx', O_RDWR|O_CREAT, 0640), "Tie");
|
|---|
| 27 |
|
|---|
| 28 | $Dfile = "Op_dbmx.pag";
|
|---|
| 29 | if (! -e $Dfile) {
|
|---|
| 30 | ($Dfile) = <Op_dbmx*>;
|
|---|
| 31 | }
|
|---|
| 32 |
|
|---|
| 33 | SKIP:
|
|---|
| 34 | {
|
|---|
| 35 | skip( "different file permission semantics",1)
|
|---|
| 36 | if ($Is_Dosish || $^O eq 'MacOS') ;
|
|---|
| 37 | ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
|
|---|
| 38 | $blksize,$blocks) = stat($Dfile);
|
|---|
| 39 | ok(($mode & 0777) == ($^O eq 'vos' ? 0750 : 0640) , "File permissions");
|
|---|
| 40 | }
|
|---|
| 41 |
|
|---|
| 42 | while (($key,$value) = each(%h)) {
|
|---|
| 43 | $i++;
|
|---|
| 44 | }
|
|---|
| 45 |
|
|---|
| 46 | ok(!$i,"Hash created empty");
|
|---|
| 47 |
|
|---|
| 48 | $h{'goner1'} = 'snork';
|
|---|
| 49 |
|
|---|
| 50 | $h{'abc'} = 'ABC';
|
|---|
| 51 | $h{'def'} = 'DEF';
|
|---|
| 52 | $h{'jkl','mno'} = "JKL\034MNO";
|
|---|
| 53 | $h{'a',2,3,4,5} = join("\034",'A',2,3,4,5);
|
|---|
| 54 | $h{'a'} = 'A';
|
|---|
| 55 | $h{'b'} = 'B';
|
|---|
| 56 | $h{'c'} = 'C';
|
|---|
| 57 | $h{'d'} = 'D';
|
|---|
| 58 | $h{'e'} = 'E';
|
|---|
| 59 | $h{'f'} = 'F';
|
|---|
| 60 | $h{'g'} = 'G';
|
|---|
| 61 | $h{'h'} = 'H';
|
|---|
| 62 | $h{'i'} = 'I';
|
|---|
| 63 |
|
|---|
| 64 | $h{'goner2'} = 'snork';
|
|---|
| 65 | delete $h{'goner2'};
|
|---|
| 66 |
|
|---|
| 67 | untie(%h);
|
|---|
| 68 | ok(tie(%h,AnyDBM_File,'Op_dbmx', O_RDWR, 0640),"Re-tie hash");
|
|---|
| 69 |
|
|---|
| 70 | $h{'j'} = 'J';
|
|---|
| 71 | $h{'k'} = 'K';
|
|---|
| 72 | $h{'l'} = 'L';
|
|---|
| 73 | $h{'m'} = 'M';
|
|---|
| 74 | $h{'n'} = 'N';
|
|---|
| 75 | $h{'o'} = 'O';
|
|---|
| 76 | $h{'p'} = 'P';
|
|---|
| 77 | $h{'q'} = 'Q';
|
|---|
| 78 | $h{'r'} = 'R';
|
|---|
| 79 | $h{'s'} = 'S';
|
|---|
| 80 | $h{'t'} = 'T';
|
|---|
| 81 | $h{'u'} = 'U';
|
|---|
| 82 | $h{'v'} = 'V';
|
|---|
| 83 | $h{'w'} = 'W';
|
|---|
| 84 | $h{'x'} = 'X';
|
|---|
| 85 | $h{'y'} = 'Y';
|
|---|
| 86 | $h{'z'} = 'Z';
|
|---|
| 87 |
|
|---|
| 88 | $h{'goner3'} = 'snork';
|
|---|
| 89 |
|
|---|
| 90 | delete $h{'goner1'};
|
|---|
| 91 | delete $h{'goner3'};
|
|---|
| 92 |
|
|---|
| 93 | @keys = keys(%h);
|
|---|
| 94 | @values = values(%h);
|
|---|
| 95 |
|
|---|
| 96 | ok( ($#keys == 29 && $#values == 29),'$#keys == $#values');
|
|---|
| 97 |
|
|---|
| 98 | while (($key,$value) = each(%h)) {
|
|---|
| 99 | if ($key eq $keys[$i] && $value eq $values[$i] && $key eq lc($value)) {
|
|---|
| 100 | $key =~ y/a-z/A-Z/;
|
|---|
|
|---|