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 further.
authorNicholas Clark <nick@ccl4.org>
Thu, 16 Dec 2010 13:25:05 +0000 (13:25 +0000)
committerNicholas Clark <nick@ccl4.org>
Thu, 16 Dec 2010 14:51:53 +0000 (14:51 +0000)
Including Cross propagating some fixes:

grep in void context warning (f84167b37281b9fd c57cf257e9e58200), but improve
it by avoiding void context entirely, by actually testing the results :-)

"cleaner close on tests, take 2", d1e4d418969ad3c5

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 9f6807c..680b67f 100644 (file)
@@ -13,7 +13,7 @@ BEGIN {
 use strict;
 use warnings;
 
-use Test::More tests => 81;
+use Test::More tests => 83;
 use GDBM_File;
 
 unlink <Op_dbmx.*>;
@@ -26,11 +26,9 @@ my $Dfile = "Op_dbmx.pag";
 if (! -e $Dfile) {
        ($Dfile) = <Op_dbmx*>;
 }
-
 SKIP: {
-    skip " different file permission semantics on $^O", 1
+    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';
-
     my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
      $blksize,$blocks) = stat($Dfile);
     is($mode & 0777, 0640);
@@ -137,6 +135,7 @@ unlink <Op_dbmx*>, $Dfile;
    package SubDB ;
 
    use strict ;
+   use warnings ;
    use vars qw(@ISA @EXPORT) ;
 
    require Exporter ;
@@ -168,7 +167,7 @@ unlink <Op_dbmx*>, $Dfile;
    1 ;
 EOM
 
-    close FILE ;
+    close FILE  or die "Could not close: $!";
 
     BEGIN { push @INC, '.'; }
     unlink <dbhash_tmp*> ;
@@ -455,7 +454,6 @@ unlink <Op_dbmx*>, $Dfile;
    my $db = tie %h, 'GDBM_File', 'Op1_dbmx', GDBM_WRCREAT, 0640;
    isa_ok($db, 'GDBM_File');
 
-
    $db->filter_fetch_key   (sub { }) ;
    $db->filter_store_key   (sub { }) ;
    $db->filter_fetch_value (sub { }) ;
@@ -466,7 +464,7 @@ unlink <Op_dbmx*>, $Dfile;
    $h{"fred"} = "joe" ;
    is($h{"fred"}, "joe");
 
-   eval { my @r= grep { $h{$_} } (1, 2, 3) };
+   is_deeply([eval { map { $h{$_} } (1, 2, 3) }], [undef, undef, undef]);
    is($@, '');
 
 
@@ -482,7 +480,7 @@ unlink <Op_dbmx*>, $Dfile;
 
    is($db->FIRSTKEY(), "fred");
    
-   eval { my @r= grep { $h{$_} } (1, 2, 3) };
+   is_deeply([eval { map { $h{$_} } (1, 2, 3) }], [undef, undef, undef]);
    is($@, '');
 
    undef $db ;
index 7a2ae70..03b78c4 100644 (file)
@@ -13,7 +13,7 @@ BEGIN {
 use strict;
 use warnings;
 
-use Test::More tests => 79;
+use Test::More tests => 81;
 
 require NDBM_File;
 #If Fcntl is not available, try 0x202 or 0x102 for O_RDWR|O_CREAT
@@ -31,7 +31,7 @@ if (! -e $Dfile) {
 }
 SKIP: {
     skip "different file permission semantics on $^O", 1
-       if $^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'NetWare';
+       if $^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'dos' || $^O eq 'cygwin';
     my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
      $blksize,$blocks) = stat($Dfile);
     is($mode & 0777, 0640);
@@ -144,7 +144,7 @@ unlink <Op_dbmx*>, $Dfile;
    require Exporter ;
    use NDBM_File;
    @ISA=qw(NDBM_File);
-   @EXPORT = @NDBM_File::EXPORT if defined @NDBM_File::EXPORT ;
+   @EXPORT = @NDBM_File::EXPORT ;
 
    sub STORE { 
        my $self = shift ;
@@ -170,12 +170,12 @@ unlink <Op_dbmx*>, $Dfile;
    1 ;
 EOM
 
-    close FILE ;
+    close FILE  or die "Could not close: $!";
 
     BEGIN { push @INC, '.'; }
     unlink <dbhash_tmp*> ;
 
-    eval 'use SubDB ; use Fcntl ; ';
+    eval 'use SubDB ; use Fcntl ;';
     main::is($@, "");
     my %h ;
     my $X ;
@@ -444,7 +444,6 @@ unlink <Op_dbmx*>, $Dfile;
     unlink <Op_dbmx*>;
 }
 
-
 {
    # Check that DBM Filter can cope with read-only $_
 
@@ -464,7 +463,7 @@ unlink <Op_dbmx*>, $Dfile;
    $h{"fred"} = "joe" ;
    is($h{"fred"}, "joe");
 
-   eval { grep { $h{$_} } (1, 2, 3) };
+   is_deeply([eval { map { $h{$_} } (1, 2, 3) }], [undef, undef, undef]);
    is($@, '');
 
 
@@ -480,7 +479,7 @@ unlink <Op_dbmx*>, $Dfile;
 
    is($db->FIRSTKEY(), "fred");
    
-   eval { grep { $h{$_} } (1, 2, 3) };
+   is_deeply([eval { map { $h{$_} } (1, 2, 3) }], [undef, undef, undef]);
    is($@, '');
 
    undef $db ;
index a1fdee5..6416ad1 100644 (file)
@@ -13,7 +13,7 @@ BEGIN {
 use strict;
 use warnings;
 
-use Test::More tests => 79;
+use Test::More tests => 81;
 
 require ODBM_File;
 #If Fcntl is not available, try 0x202 or 0x102 for O_RDWR|O_CREAT
@@ -31,7 +31,7 @@ if (! -e $Dfile) {
 }
 SKIP: {
     skip "different file permission semantics on $^O", 1
-       if $^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'NetWare';
+       if $^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32' || $^O eq 'NetWare' || $^O eq 'dos' || $^O eq 'cygwin';
     my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
      $blksize,$blocks) = stat($Dfile);
     is($mode & 0777, 0640);
@@ -170,7 +170,7 @@ unlink <Op_dbmx*>, $Dfile;
    1 ;
 EOM
 
-    close FILE ;
+    close FILE  or die "Could not close: $!";
 
     BEGIN { push @INC, '.'; }
     unlink <dbhash_tmp*> ;
@@ -210,8 +210,6 @@ unlink <Op_dbmx*>, $Dfile;
    sub checkOutput
    {
        my($fk, $sk, $fv, $sv) = @_ ;
-       print "# ", join('|', $fetch_key, $fk, $store_key, $sk,
-                       $fetch_value, $fv, $store_value, $sv, $_), "\n";
        return
            $fetch_key eq $fk && $store_key eq $sk && 
           $fetch_value eq $fv && $store_value eq $sv &&
@@ -446,7 +444,6 @@ unlink <Op_dbmx*>, $Dfile;
     unlink <Op_dbmx*>;
 }
 
-
 {
    # Check that DBM Filter can cope with read-only $_
 
@@ -466,7 +463,7 @@ unlink <Op_dbmx*>, $Dfile;
    $h{"fred"} = "joe" ;
    is($h{"fred"}, "joe");
 
-   eval { grep { $h{$_} } (1, 2, 3) };
+   is_deeply([eval { map { $h{$_} } (1, 2, 3) }], [undef, undef, undef]);
    is($@, '');
 
 
@@ -482,7 +479,7 @@ unlink <Op_dbmx*>, $Dfile;
 
    is($db->FIRSTKEY(), "fred");
    
-   eval { grep { $h{$_} } (1, 2, 3) };
+   is_deeply([eval { map { $h{$_} } (1, 2, 3) }], [undef, undef, undef]);
    is($@, '');
 
    undef $db ;
index 0496ad2..cfc67b1 100644 (file)
@@ -13,7 +13,7 @@ BEGIN {
 use strict;
 use warnings;
 
-use Test::More tests => 81;
+use Test::More tests => 83;
 
 require SDBM_File;
 #If Fcntl is not available, try 0x202 or 0x102 for O_RDWR|O_CREAT
@@ -142,12 +142,12 @@ unlink <Op_dbmx*>, $Dfile;
 
    use strict ;
    use warnings ;
-   use vars qw( @ISA @EXPORT) ;
+   use vars qw(@ISA @EXPORT) ;
 
    require Exporter ;
    use SDBM_File;
    @ISA=qw(SDBM_File);
-   @EXPORT = @SDBM_File::EXPORT if @SDBM_File::EXPORT ;
+   @EXPORT = @SDBM_File::EXPORT ;
 
    sub STORE { 
        my $self = shift ;
@@ -447,7 +447,6 @@ unlink <Op_dbmx*>, $Dfile;
     unlink <Op_dbmx*>;
 }
 
-
 {
    # Check that DBM Filter can cope with read-only $_
 
@@ -467,7 +466,7 @@ unlink <Op_dbmx*>, $Dfile;
    $h{"fred"} = "joe" ;
    is($h{"fred"}, "joe");
 
-   eval { grep { $h{$_} } (1, 2, 3) };
+   is_deeply([eval { map { $h{$_} } (1, 2, 3) }], [undef, undef, undef]);
    is($@, '');
 
 
@@ -483,7 +482,7 @@ unlink <Op_dbmx*>, $Dfile;
 
    is($db->FIRSTKEY(), "fred");
    
-   eval { map { $h{$_} } (1, 2, 3) };
+   is_deeply([eval { map { $h{$_} } (1, 2, 3) }], [undef, undef, undef]);
    is($@, '');
 
    undef $db ;