diff options
author | Nicholas Clark <nick@ccl4.org> | 2010-12-16 11:37:43 +0000 |
---|---|---|
committer | Nicholas Clark <nick@ccl4.org> | 2010-12-16 14:51:53 +0000 |
commit | 89cebecca5600bb94e404ffac30bb2fa04e516c3 (patch) | |
tree | 3865c895d1996d1a2684c0c4be87ec0f119bddde /ext | |
parent | 234e7be97d3fcde19aeeb0d1a009880870e75aa5 (diff) | |
download | perl-89cebecca5600bb94e404ffac30bb2fa04e516c3.tar.gz |
Converge ext/[GNOS]DBM_File/t/[gnos]dbm.t by using the same filename.
Choose the 1 dot form used by sdbm.t, to keep VMS happy. Also, propagate into
ndbm.t the part of the test for 20001013.009 that cbc5248d01a71061 missed.
Move the exist tests from f4b9d8806d76b352 earlier in sdbm.t, to increase
consistency - the alternative attempts to have 2 DBM files open simultaneously,
which ODBM_File doesn't support. (Implied TODO: add an explicit test for this
to the other 3.)
Diffstat (limited to 'ext')
-rw-r--r-- | ext/GDBM_File/t/gdbm.t | 60 | ||||
-rw-r--r-- | ext/NDBM_File/t/ndbm.t | 62 | ||||
-rw-r--r-- | ext/ODBM_File/t/odbm.t | 58 | ||||
-rw-r--r-- | ext/SDBM_File/t/sdbm.t | 13 |
4 files changed, 106 insertions, 87 deletions
diff --git a/ext/GDBM_File/t/gdbm.t b/ext/GDBM_File/t/gdbm.t index 12e380dd93..9f6807c183 100644 --- a/ext/GDBM_File/t/gdbm.t +++ b/ext/GDBM_File/t/gdbm.t @@ -16,16 +16,17 @@ use warnings; use Test::More tests => 81; use GDBM_File; -unlink <Op.dbmx*>; +unlink <Op_dbmx.*>; umask(0); my %h ; -isa_ok(tie(%h, 'GDBM_File', 'Op.dbmx', GDBM_WRCREAT, 0640), 'GDBM_File'); +isa_ok(tie(%h, 'GDBM_File', 'Op_dbmx', GDBM_WRCREAT, 0640), 'GDBM_File'); -my $Dfile = "Op.dbmx.pag"; +my $Dfile = "Op_dbmx.pag"; if (! -e $Dfile) { - ($Dfile) = <Op.dbmx*>; + ($Dfile) = <Op_dbmx*>; } + SKIP: { skip " different file permission semantics on $^O", 1 if $^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'dos' || $^O eq 'cygwin'; @@ -60,7 +61,7 @@ $h{'goner2'} = 'snork'; delete $h{'goner2'}; untie(%h); -isa_ok(tie(%h, 'GDBM_File', 'Op.dbmx', GDBM_WRITER, 0640), 'GDBM_File'); +isa_ok(tie(%h, 'GDBM_File', 'Op_dbmx', GDBM_WRITER, 0640), 'GDBM_File'); $h{'j'} = 'J'; $h{'k'} = 'K'; @@ -123,7 +124,7 @@ is($h{'foo'}, ''); is($h{''}, 'bar'); untie %h; -unlink 'Op.dbmx.dir', $Dfile; +unlink <Op_dbmx*>, $Dfile; { # sub-class test @@ -170,14 +171,14 @@ EOM close FILE ; BEGIN { push @INC, '.'; } - unlink <dbhash.tmp*> ; + unlink <dbhash_tmp*> ; eval 'use SubDB ; '; main::is($@, ""); my %h ; my $X ; eval ' - $X = tie(%h, "SubDB","dbhash.tmp", &GDBM_WRCREAT, 0640 ); + $X = tie(%h, "SubDB","dbhash_tmp", &GDBM_WRCREAT, 0640 ); ' ; main::is($@, ""); @@ -196,10 +197,13 @@ EOM undef $X; untie(%h); - unlink "SubDB.pm", <dbhash.tmp*> ; + unlink "SubDB.pm", <dbhash_tmp.*> ; } +untie %h; +unlink <Op_dbmx*>, $Dfile; + { # DBM Filter tests my (%h, $db) ; @@ -214,8 +218,8 @@ EOM $_ eq 'original' ; } - unlink <Op.dbmx*>; - $db = tie %h, 'GDBM_File', 'Op.dbmx', GDBM_WRCREAT, 0640; + unlink <Op_dbmx*>; + $db = tie %h, 'GDBM_File', 'Op_dbmx', GDBM_WRCREAT, 0640; isa_ok($db, 'GDBM_File'); $db->filter_fetch_key (sub { $fetch_key = $_ }) ; @@ -302,7 +306,7 @@ EOM undef $db ; untie %h; - unlink <Op.dbmx*>; + unlink <Op_dbmx*>; } { @@ -310,8 +314,8 @@ EOM my (%h, $db) ; - unlink <Op.dbmx*>; - $db = tie %h, 'GDBM_File','Op.dbmx', GDBM_WRCREAT, 0640; + unlink <Op_dbmx*>; + $db = tie %h, 'GDBM_File','Op_dbmx', GDBM_WRCREAT, 0640; isa_ok($db, 'GDBM_File'); my %result = () ; @@ -365,15 +369,15 @@ EOM undef $db ; untie %h; - unlink <Op.dbmx*>; -} + unlink <Op_dbmx*>; +} { # DBM Filter recursion detection my (%h, $db) ; - unlink <Op.dbmx*>; + unlink <Op_dbmx*>; - $db = tie %h, 'GDBM_File','Op.dbmx', GDBM_WRCREAT, 0640; + $db = tie %h, 'GDBM_File','Op_dbmx', GDBM_WRCREAT, 0640; isa_ok($db, 'GDBM_File'); $db->filter_store_key (sub { $_ = $h{$_} }) ; @@ -383,7 +387,7 @@ EOM undef $db ; untie %h; - unlink <Op.dbmx*>; + unlink <Op_dbmx*>; } { @@ -392,16 +396,16 @@ EOM # test that $hash{KEY} = undef doesn't produce the warning # Use of uninitialized value in null operation - unlink <Op.dbmx*>; + unlink <Op_dbmx*>; my %h ; my $a = ""; local $SIG{__WARN__} = sub {$a = $_[0]} ; - isa_ok(tie(%h, 'GDBM_File', 'Op.dbmx', GDBM_WRCREAT, 0640), 'GDBM_File'); + isa_ok(tie(%h, 'GDBM_File', 'Op_dbmx', GDBM_WRCREAT, 0640), 'GDBM_File'); $h{ABC} = undef; is($a, ""); untie %h; - unlink <Op.dbmx*>; + unlink <Op_dbmx*>; } { @@ -411,10 +415,10 @@ EOM # modified key doesn't get passed to NEXTKEY. # Also Test "keys" & "values" while we are at it. - unlink <Op.dbmx*>; + unlink <Op_dbmx*>; my $bad_key = 0 ; my %h = () ; - my $db = tie %h, 'GDBM_File', 'Op.dbmx', GDBM_WRCREAT, 0640; + my $db = tie %h, 'GDBM_File', 'Op_dbmx', GDBM_WRCREAT, 0640; isa_ok($db, 'GDBM_File'); $db->filter_fetch_key (sub { $_ =~ s/^Beta_/Alpha_/ if defined $_}) ; $db->filter_store_key (sub { $bad_key = 1 if /^Beta_/ ; $_ =~ s/^Alpha_/Beta_/}) ; @@ -439,16 +443,16 @@ EOM undef $db ; untie %h ; - unlink <Op.dbmx*>; + unlink <Op_dbmx*>; } { # Check that DBM Filter can cope with read-only $_ my %h ; - unlink <Op.dbmx*>; + unlink <Op1_dbmx*>; - my $db = tie %h, 'GDBM_File', 'Op.dbmx', GDBM_WRCREAT, 0640; + my $db = tie %h, 'GDBM_File', 'Op1_dbmx', GDBM_WRCREAT, 0640; isa_ok($db, 'GDBM_File'); @@ -483,5 +487,5 @@ EOM undef $db ; untie %h; - unlink <Op.dbmx*>; + unlink <Op1_dbmx*>; } diff --git a/ext/NDBM_File/t/ndbm.t b/ext/NDBM_File/t/ndbm.t index 8bbd2933b8..7a2ae7069c 100644 --- a/ext/NDBM_File/t/ndbm.t +++ b/ext/NDBM_File/t/ndbm.t @@ -13,21 +13,21 @@ BEGIN { use strict; use warnings; -use Test::More tests => 78; +use Test::More tests => 79; require NDBM_File; #If Fcntl is not available, try 0x202 or 0x102 for O_RDWR|O_CREAT use Fcntl; -unlink <Op.dbmx*>; +unlink <Op_dbmx.*>; umask(0); my %h; -isa_ok(tie(%h,'NDBM_File','Op.dbmx', O_RDWR|O_CREAT, 0640), 'NDBM_File'); +isa_ok(tie(%h,'NDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640), 'NDBM_File'); -my $Dfile = "Op.dbmx.pag"; +my $Dfile = "Op_dbmx.pag"; if (! -e $Dfile) { - ($Dfile) = <Op.dbmx*>; + ($Dfile) = <Op_dbmx*>; } SKIP: { skip "different file permission semantics on $^O", 1 @@ -62,7 +62,7 @@ $h{'goner2'} = 'snork'; delete $h{'goner2'}; untie(%h); -isa_ok(tie(%h,'NDBM_File','Op.dbmx', O_RDWR, 0640), 'NDBM_File'); +isa_ok(tie(%h,'NDBM_File','Op_dbmx', O_RDWR, 0640), 'NDBM_File'); $h{'j'} = 'J'; $h{'k'} = 'K'; @@ -125,7 +125,7 @@ is($h{'foo'}, ''); is($h{''}, 'bar'); untie %h; -unlink <Op.dbmx*>, $Dfile; +unlink <Op_dbmx*>, $Dfile; { # sub-class test @@ -173,13 +173,14 @@ EOM close FILE ; BEGIN { push @INC, '.'; } + unlink <dbhash_tmp*> ; eval 'use SubDB ; use Fcntl ; '; main::is($@, ""); my %h ; my $X ; eval ' - $X = tie(%h, "SubDB","dbhash.tmp", O_RDWR|O_CREAT, 0640 ); + $X = tie(%h, "SubDB","dbhash_tmp", O_RDWR|O_CREAT, 0640 ); ' ; main::is($@, ""); @@ -194,10 +195,13 @@ EOM undef $X; untie(%h); - unlink "SubDB.pm", <dbhash.tmp*> ; + unlink "SubDB.pm", <dbhash_tmp.*> ; } +untie %h; +unlink <Op_dbmx*>, $Dfile; + { # DBM Filter tests my (%h, $db) ; @@ -212,8 +216,8 @@ EOM $_ eq 'original' ; } - unlink <Op.dbmx*>; - $db = tie %h, 'NDBM_File', 'Op.dbmx', O_RDWR|O_CREAT, 0640; + unlink <Op_dbmx*>; + $db = tie %h, 'NDBM_File', 'Op_dbmx', O_RDWR|O_CREAT, 0640; isa_ok($db, 'NDBM_File'); $db->filter_fetch_key (sub { $fetch_key = $_ }) ; @@ -300,7 +304,7 @@ EOM undef $db ; untie %h; - unlink <Op.dbmx*>; + unlink <Op_dbmx*>; } { @@ -308,8 +312,8 @@ EOM my (%h, $db) ; - unlink <Op.dbmx*>; - $db = tie %h, 'NDBM_File', 'Op.dbmx', O_RDWR|O_CREAT, 0640; + unlink <Op_dbmx*>; + $db = tie %h, 'NDBM_File', 'Op_dbmx', O_RDWR|O_CREAT, 0640; isa_ok($db, 'NDBM_File'); my %result = () ; @@ -363,15 +367,15 @@ EOM undef $db ; untie %h; - unlink <Op.dbmx*>; + unlink <Op_dbmx*>; } { # DBM Filter recursion detection my (%h, $db) ; - unlink <Op.dbmx*>; + unlink <Op_dbmx*>; - $db = tie %h, 'NDBM_File', 'Op.dbmx', O_RDWR|O_CREAT, 0640; + $db = tie %h, 'NDBM_File', 'Op_dbmx', O_RDWR|O_CREAT, 0640; isa_ok($db, 'NDBM_File'); $db->filter_store_key (sub { $_ = $h{$_} }) ; @@ -381,7 +385,7 @@ EOM undef $db ; untie %h; - unlink <Op.dbmx*>; + unlink <Op_dbmx*>; } { @@ -390,12 +394,16 @@ EOM # test that $hash{KEY} = undef doesn't produce the warning # Use of uninitialized value in null operation - unlink <Op.dbmx*>; + unlink <Op_dbmx*>; my %h ; my $a = ""; local $SIG{__WARN__} = sub {$a = $_[0]} ; - - isa_ok(tie(%h, 'NDBM_File','Op.dbmx', O_RDWR|O_CREAT, 0640), 'NDBM_File'); + + isa_ok(tie(%h, 'NDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640), 'NDBM_File'); + $h{ABC} = undef; + is($a, ""); + untie %h; + unlink <Op_dbmx*>; } { @@ -405,10 +413,10 @@ EOM # modified key doesn't get passed to NEXTKEY. # Also Test "keys" & "values" while we are at it. - unlink <Op.dbmx*>; + unlink <Op_dbmx*>; my $bad_key = 0 ; my %h = () ; - my $db = tie %h, 'NDBM_File','Op.dbmx', O_RDWR|O_CREAT, 0640; + my $db = tie %h, 'NDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640; isa_ok($db, 'NDBM_File'); $db->filter_fetch_key (sub { $_ =~ s/^Beta_/Alpha_/ if defined $_}) ; $db->filter_store_key (sub { $bad_key = 1 if /^Beta_/ ; $_ =~ s/^Alpha_/Beta_/}) ; @@ -433,7 +441,7 @@ EOM undef $db ; untie %h ; - unlink <Op.dbmx*>; + unlink <Op_dbmx*>; } @@ -441,9 +449,9 @@ EOM # Check that DBM Filter can cope with read-only $_ my %h ; - unlink <Op.dbmx*>; + unlink <Op1_dbmx*>; - my $db = tie %h, 'NDBM_File','Op.dbmx', O_RDWR|O_CREAT, 0640; + my $db = tie %h, 'NDBM_File','Op1_dbmx', O_RDWR|O_CREAT, 0640; isa_ok($db, 'NDBM_File'); $db->filter_fetch_key (sub { }) ; @@ -477,5 +485,5 @@ EOM undef $db ; untie %h; - unlink <Op.dbmx*>; + unlink <Op1_dbmx*>; } diff --git a/ext/ODBM_File/t/odbm.t b/ext/ODBM_File/t/odbm.t index 55ba0ad2ad..a1fdee5439 100644 --- a/ext/ODBM_File/t/odbm.t +++ b/ext/ODBM_File/t/odbm.t @@ -19,15 +19,15 @@ require ODBM_File; #If Fcntl is not available, try 0x202 or 0x102 for O_RDWR|O_CREAT use Fcntl; -unlink <Op.dbmx*>; +unlink <Op_dbmx.*>; umask(0); my %h; -isa_ok(tie(%h, 'ODBM_File', 'Op.dbmx', O_RDWR|O_CREAT, 0640), 'ODBM_File'); +isa_ok(tie(%h, 'ODBM_File', 'Op_dbmx', O_RDWR|O_CREAT, 0640), 'ODBM_File'); -my $Dfile = "Op.dbmx.pag"; +my $Dfile = "Op_dbmx.pag"; if (! -e $Dfile) { - ($Dfile) = <Op.dbmx*>; + ($Dfile) = <Op_dbmx*>; } SKIP: { skip "different file permission semantics on $^O", 1 @@ -62,7 +62,7 @@ $h{'goner2'} = 'snork'; delete $h{'goner2'}; untie(%h); -isa_ok(tie(%h, 'ODBM_File', 'Op.dbmx', O_RDWR, 0640), 'ODBM_File'); +isa_ok(tie(%h, 'ODBM_File', 'Op_dbmx', O_RDWR, 0640), 'ODBM_File'); $h{'j'} = 'J'; $h{'k'} = 'K'; @@ -125,7 +125,7 @@ is($h{'foo'}, ''); is($h{''}, 'bar'); untie %h; -unlink 'Op.dbmx.dir', $Dfile; +unlink <Op_dbmx*>, $Dfile; { # sub-class test @@ -173,13 +173,14 @@ EOM close FILE ; BEGIN { push @INC, '.'; } + unlink <dbhash_tmp*> ; eval 'use SubDB ; use Fcntl ;'; main::is($@, ""); my %h ; my $X ; eval ' - $X = tie(%h, "SubDB","dbhash.tmp", O_RDWR|O_CREAT, 0640 ); + $X = tie(%h, "SubDB","dbhash_tmp", O_RDWR|O_CREAT, 0640 ); ' ; main::is($@, ""); @@ -194,10 +195,13 @@ EOM undef $X; untie(%h); - unlink "SubDB.pm", <dbhash.tmp*> ; + unlink "SubDB.pm", <dbhash_tmp.*> ; } +untie %h; +unlink <Op_dbmx*>, $Dfile; + { # DBM Filter tests my (%h, $db) ; @@ -214,8 +218,8 @@ EOM $_ eq 'original' ; } - unlink <Op.dbmx*>; - $db = tie %h, 'ODBM_File', 'Op.dbmx', O_RDWR|O_CREAT, 0640; + unlink <Op_dbmx*>; + $db = tie %h, 'ODBM_File', 'Op_dbmx', O_RDWR|O_CREAT, 0640; isa_ok($db, 'ODBM_File'); $db->filter_fetch_key (sub { $fetch_key = $_ }) ; @@ -302,7 +306,7 @@ EOM undef $db ; untie %h; - unlink <Op.dbmx*>; + unlink <Op_dbmx*>; } { @@ -310,8 +314,8 @@ EOM my (%h, $db) ; - unlink <Op.dbmx*>; - $db = tie %h, 'ODBM_File', 'Op.dbmx', O_RDWR|O_CREAT, 0640; + unlink <Op_dbmx*>; + $db = tie %h, 'ODBM_File', 'Op_dbmx', O_RDWR|O_CREAT, 0640; isa_ok($db, 'ODBM_File'); my %result = () ; @@ -365,15 +369,15 @@ EOM undef $db ; untie %h; - unlink <Op.dbmx*>; + unlink <Op_dbmx*>; } { # DBM Filter recursion detection my (%h, $db) ; - unlink <Op.dbmx*>; + unlink <Op_dbmx*>; - $db = tie %h, 'ODBM_File', 'Op.dbmx', O_RDWR|O_CREAT, 0640; + $db = tie %h, 'ODBM_File', 'Op_dbmx', O_RDWR|O_CREAT, 0640; isa_ok($db, 'ODBM_File'); $db->filter_store_key (sub { $_ = $h{$_} }) ; @@ -383,7 +387,7 @@ EOM undef $db ; untie %h; - unlink <Op.dbmx*>; + unlink <Op_dbmx*>; } { @@ -392,16 +396,16 @@ EOM # test that $hash{KEY} = undef doesn't produce the warning # Use of uninitialized value in null operation - unlink <Op.dbmx*>; + unlink <Op_dbmx*>; my %h ; my $a = ""; local $SIG{__WARN__} = sub {$a = $_[0]} ; - - isa_ok(tie(%h, 'ODBM_File', 'Op.dbmx', O_RDWR|O_CREAT, 0640), 'ODBM_File'); + + isa_ok(tie(%h, 'ODBM_File', 'Op_dbmx', O_RDWR|O_CREAT, 0640), 'ODBM_File'); $h{ABC} = undef; is($a, ""); untie %h; - unlink <Op.dbmx*>; + unlink <Op_dbmx*>; } { @@ -411,10 +415,10 @@ EOM # modified key doesn't get passed to NEXTKEY. # Also Test "keys" & "values" while we are at it. - unlink <Op.dbmx*>; + unlink <Op_dbmx*>; my $bad_key = 0 ; my %h = () ; - my $db = tie %h, 'ODBM_File','Op.dbmx', O_RDWR|O_CREAT, 0640; + my $db = tie %h, 'ODBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640; isa_ok($db, 'ODBM_File'); $db->filter_fetch_key (sub { $_ =~ s/^Beta_/Alpha_/ if defined $_}) ; $db->filter_store_key (sub { $bad_key = 1 if /^Beta_/ ; $_ =~ s/^Alpha_/Beta_/}) ; @@ -439,7 +443,7 @@ EOM undef $db ; untie %h ; - unlink <Op.dbmx*>; + unlink <Op_dbmx*>; } @@ -447,9 +451,9 @@ EOM # Check that DBM Filter can cope with read-only $_ my %h ; - unlink <Op.dbmx*>; + unlink <Op1_dbmx*>; - my $db = tie %h, 'ODBM_File','Op.dbmx', O_RDWR|O_CREAT, 0640; + my $db = tie %h, 'ODBM_File','Op1_dbmx', O_RDWR|O_CREAT, 0640; isa_ok($db, 'ODBM_File'); $db->filter_fetch_key (sub { }) ; @@ -483,7 +487,7 @@ EOM undef $db ; untie %h; - unlink <Op.dbmx*>; + unlink <Op1_dbmx*>; } if ($^O eq 'hpux') { diff --git a/ext/SDBM_File/t/sdbm.t b/ext/SDBM_File/t/sdbm.t index 3af6a583ce..0496ad261c 100644 --- a/ext/SDBM_File/t/sdbm.t +++ b/ext/SDBM_File/t/sdbm.t @@ -27,7 +27,7 @@ isa_ok(tie(%h, 'SDBM_File', 'Op_dbmx', O_RDWR|O_CREAT, 0640), 'SDBM_File'); my $Dfile = "Op_dbmx.pag"; if (! -e $Dfile) { - ($Dfile) = <Op_dbmx.*>; + ($Dfile) = <Op_dbmx*>; } SKIP: { skip "different file permission semantics on $^O", 1 @@ -124,6 +124,11 @@ is(join(':',200..400), join(':',@foo)); is($h{'foo'}, ''); is($h{''}, 'bar'); +is(exists $h{goner1}, ''); +is(exists $h{foo}, 1); + +untie %h; +unlink <Op_dbmx*>, $Dfile; { # sub-class test @@ -171,6 +176,7 @@ EOM close FILE or die "Could not close: $!"; BEGIN { push @INC, '.'; } + unlink <dbhash_tmp*> ; eval 'use SubDB ; use Fcntl ;'; main::is($@, ""); @@ -196,9 +202,6 @@ EOM } -is(exists $h{goner1}, ''); -is(exists $h{foo}, 1); - untie %h; unlink <Op_dbmx*>, $Dfile; @@ -398,7 +401,7 @@ unlink <Op_dbmx*>, $Dfile; my %h ; my $a = ""; local $SIG{__WARN__} = sub {$a = $_[0]} ; - + isa_ok(tie(%h, 'SDBM_File', 'Op_dbmx', O_RDWR|O_CREAT, 0640), 'SDBM_File'); $h{ABC} = undef; is($a, ""); |