This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Converge ext/[GNOS]DBM_File/t/[gnos]dbm.t by using the same filename.
authorNicholas Clark <nick@ccl4.org>
Thu, 16 Dec 2010 11:37:43 +0000 (11:37 +0000)
committerNicholas Clark <nick@ccl4.org>
Thu, 16 Dec 2010 14:51:53 +0000 (14:51 +0000)
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
ext/NDBM_File/t/ndbm.t
ext/ODBM_File/t/odbm.t
ext/SDBM_File/t/sdbm.t

index 12e380d..9f6807c 100644 (file)
@@ -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*>;
 }
index 8bbd293..7a2ae70 100644 (file)
@@ -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*>;
 }
index 55ba0ad..a1fdee5 100644 (file)
@@ -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') {
index 3af6a58..0496ad2 100644 (file)
@@ -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, "");