source: trunk/essentials/dev-lang/perl/lib/AnyDBM_File.t@ 3951

Last change on this file since 3951 was 3181, checked in by bird, 19 years ago

perl 5.8.8

File size: 3.4 KB
Line 
1#!./perl
2
3# $RCSfile: dbm.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:43 $
4
5BEGIN {
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
13require AnyDBM_File;
14use 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
22unlink <Op_dbmx*>;
23
24umask(0);
25
26ok( tie(%h,AnyDBM_File,'Op_dbmx', O_RDWR|O_CREAT, 0640), "Tie");
27
28$Dfile = "Op_dbmx.pag";
29if (! -e $Dfile) {
30 ($Dfile) = <Op_dbmx*>;
31}
32
33SKIP:
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
42while (($key,$value) = each(%h)) {
43 $i++;
44}
45
46ok(!$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';
65delete $h{'goner2'};
66
67untie(%h);
68ok(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
90delete $h{'goner1'};
91delete $h{'goner3'};
92
93@keys = keys(%h);
94@values = values(%h);
95
96ok( ($#keys == 29 && $#values == 29),'$#keys == $#values');
97
98while (($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/;