From 89cebecca5600bb94e404ffac30bb2fa04e516c3 Mon Sep 17 00:00:00 2001 From: Nicholas Clark Date: Thu, 16 Dec 2010 11:37:43 +0000 Subject: [PATCH] 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.) --- ext/GDBM_File/t/gdbm.t | 60 +++++++++++++++++++++++++----------------------- ext/NDBM_File/t/ndbm.t | 62 ++++++++++++++++++++++++++++---------------------- ext/ODBM_File/t/odbm.t | 58 ++++++++++++++++++++++++---------------------- 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 12e380d..9f6807c 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 ; +unlink ; 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) = ; + ($Dfile) = ; } + 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 , $Dfile; { # sub-class test @@ -170,14 +171,14 @@ EOM close FILE ; BEGIN { push @INC, '.'; } - unlink ; + unlink ; 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", ; + unlink "SubDB.pm", ; } +untie %h; +unlink , $Dfile; + { # DBM Filter tests my (%h, $db) ; @@ -214,8 +218,8 @@ EOM $_ eq 'original' ; } - unlink ; - $db = tie %h, 'GDBM_File', 'Op.dbmx', GDBM_WRCREAT, 0640; + unlink ; + $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 ; + unlink ; } { @@ -310,8 +314,8 @@ EOM my (%h, $db) ; - unlink ; - $db = tie %h, 'GDBM_File','Op.dbmx', GDBM_WRCREAT, 0640; + unlink ; + $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 ; -} + unlink ; +} { # DBM Filter recursion detection my (%h, $db) ; - unlink ; + unlink ; - $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 ; + unlink ; } { @@ -392,16 +396,16 @@ EOM # test that $hash{KEY} = undef doesn't produce the warning # Use of uninitialized value in null operation - unlink ; + unlink ; 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 ; + unlink ; } { @@ -411,10 +415,10 @@ EOM # modified key doesn't get passed to NEXTKEY. # Also Test "keys" & "values" while we are at it. - unlink ; + unlink ; 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 ; + unlink ; } { # Check that DBM Filter can cope with read-only $_ my %h ; - unlink ; + unlink ; - 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 ; + unlink ; } diff --git a/ext/NDBM_File/t/ndbm.t b/ext/NDBM_File/t/ndbm.t index 8bbd293..7a2ae70 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 ; +unlink ; 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) = ; + ($Dfile) = ; } 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 , $Dfile; +unlink , $Dfile; { # sub-class test @@ -173,13 +173,14 @@ EOM close FILE ; BEGIN { push @INC, '.'; } + unlink ; 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", ; + unlink "SubDB.pm", ; } +untie %h; +unlink , $Dfile; + { # DBM Filter tests my (%h, $db) ; @@ -212,8 +216,8 @@ EOM $_ eq 'original' ; } - unlink ; - $db = tie %h, 'NDBM_File', 'Op.dbmx', O_RDWR|O_CREAT, 0640; + unlink ; + $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 ; + unlink ; } { @@ -308,8 +312,8 @@ EOM my (%h, $db) ; - unlink ; - $db = tie %h, 'NDBM_File', 'Op.dbmx', O_RDWR|O_CREAT, 0640; + unlink ; + $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 ; + unlink ; } { # DBM Filter recursion detection my (%h, $db) ; - unlink ; + unlink ; - $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 ; + unlink ; } { @@ -390,12 +394,16 @@ EOM # test that $hash{KEY} = undef doesn't produce the warning # Use of uninitialized value in null operation - unlink ; + unlink ; 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 ; } { @@ -405,10 +413,10 @@ EOM # modified key doesn't get passed to NEXTKEY. # Also Test "keys" & "values" while we are at it. - unlink ; + unlink ; 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 ; + unlink ; } @@ -441,9 +449,9 @@ EOM # Check that DBM Filter can cope with read-only $_ my %h ; - unlink ; + unlink ; - 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 ; + unlink ; } diff --git a/ext/ODBM_File/t/odbm.t b/ext/ODBM_File/t/odbm.t index 55ba0ad..a1fdee5 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 ; +unlink ; 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) = ; + ($Dfile) = ; } 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 , $Dfile; { # sub-class test @@ -173,13 +173,14 @@ EOM close FILE ; BEGIN { push @INC, '.'; } + unlink ; 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", ; + unlink "SubDB.pm", ; } +untie %h; +unlink , $Dfile; + { # DBM Filter tests my (%h, $db) ; @@ -214,8 +218,8 @@ EOM $_ eq 'original' ; } - unlink ; - $db = tie %h, 'ODBM_File', 'Op.dbmx', O_RDWR|O_CREAT, 0640; + unlink ; + $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 ; + unlink ; } { @@ -310,8 +314,8 @@ EOM my (%h, $db) ; - unlink ; - $db = tie %h, 'ODBM_File', 'Op.dbmx', O_RDWR|O_CREAT, 0640; + unlink ; + $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 ; + unlink ; } { # DBM Filter recursion detection my (%h, $db) ; - unlink ; + unlink ; - $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 ; + unlink ; } { @@ -392,16 +396,16 @@ EOM # test that $hash{KEY} = undef doesn't produce the warning # Use of uninitialized value in null operation - unlink ; + unlink ; 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 ; + unlink ; } { @@ -411,10 +415,10 @@ EOM # modified key doesn't get passed to NEXTKEY. # Also Test "keys" & "values" while we are at it. - unlink ; + unlink ; 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 ; + unlink ; } @@ -447,9 +451,9 @@ EOM # Check that DBM Filter can cope with read-only $_ my %h ; - unlink ; + unlink ; - 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 ; + unlink ; } if ($^O eq 'hpux') { diff --git a/ext/SDBM_File/t/sdbm.t b/ext/SDBM_File/t/sdbm.t index 3af6a58..0496ad2 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) = ; + ($Dfile) = ; } 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 , $Dfile; { # sub-class test @@ -171,6 +176,7 @@ EOM close FILE or die "Could not close: $!"; BEGIN { push @INC, '.'; } + unlink ; eval 'use SubDB ; use Fcntl ;'; main::is($@, ""); @@ -196,9 +202,6 @@ EOM } -is(exists $h{goner1}, ''); -is(exists $h{foo}, 1); - untie %h; unlink , $Dfile; @@ -398,7 +401,7 @@ unlink , $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, ""); -- 2.7.4