use strict;
use warnings;
-use Test::More tests => 81;
+use Test::More tests => 83;
use GDBM_File;
unlink <Op_dbmx.*>;
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);
package SubDB ;
use strict ;
+ use warnings ;
use vars qw(@ISA @EXPORT) ;
require Exporter ;
1 ;
EOM
- close FILE ;
+ close FILE or die "Could not close: $!";
BEGIN { push @INC, '.'; }
unlink <dbhash_tmp*> ;
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 { }) ;
$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($@, '');
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 ;
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
}
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);
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 ;
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 ;
unlink <Op_dbmx*>;
}
-
{
# Check that DBM Filter can cope with read-only $_
$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($@, '');
is($db->FIRSTKEY(), "fred");
- eval { grep { $h{$_} } (1, 2, 3) };
+ is_deeply([eval { map { $h{$_} } (1, 2, 3) }], [undef, undef, undef]);
is($@, '');
undef $db ;
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
}
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);
1 ;
EOM
- close FILE ;
+ close FILE or die "Could not close: $!";
BEGIN { push @INC, '.'; }
unlink <dbhash_tmp*> ;
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 &&
unlink <Op_dbmx*>;
}
-
{
# Check that DBM Filter can cope with read-only $_
$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($@, '');
is($db->FIRSTKEY(), "fred");
- eval { grep { $h{$_} } (1, 2, 3) };
+ is_deeply([eval { map { $h{$_} } (1, 2, 3) }], [undef, undef, undef]);
is($@, '');
undef $db ;
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
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 ;
unlink <Op_dbmx*>;
}
-
{
# Check that DBM Filter can cope with read-only $_
$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($@, '');
is($db->FIRSTKEY(), "fred");
- eval { map { $h{$_} } (1, 2, 3) };
+ is_deeply([eval { map { $h{$_} } (1, 2, 3) }], [undef, undef, undef]);
is($@, '');
undef $db ;