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';
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';
is($h{''}, 'bar');
untie %h;
-unlink 'Op.dbmx.dir', $Dfile;
+unlink <Op_dbmx*>, $Dfile;
{
# sub-class test
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($@, "");
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) ;
$_ 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 = $_ }) ;
undef $db ;
untie %h;
- unlink <Op.dbmx*>;
+ unlink <Op_dbmx*>;
}
{
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 = () ;
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{$_} }) ;
undef $db ;
untie %h;
- unlink <Op.dbmx*>;
+ unlink <Op_dbmx*>;
}
{
# 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*>;
}
{
# 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_/}) ;
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');
undef $db ;
untie %h;
- unlink <Op.dbmx*>;
+ unlink <Op1_dbmx*>;
}
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
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';
is($h{''}, 'bar');
untie %h;
-unlink <Op.dbmx*>, $Dfile;
+unlink <Op_dbmx*>, $Dfile;
{
# sub-class test
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($@, "");
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) ;
$_ 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 = $_ }) ;
undef $db ;
untie %h;
- unlink <Op.dbmx*>;
+ unlink <Op_dbmx*>;
}
{
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 = () ;
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{$_} }) ;
undef $db ;
untie %h;
- unlink <Op.dbmx*>;
+ unlink <Op_dbmx*>;
}
{
# 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*>;
}
{
# 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_/}) ;
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, '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 { }) ;
undef $db ;
untie %h;
- unlink <Op.dbmx*>;
+ unlink <Op1_dbmx*>;
}
#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
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';
is($h{''}, 'bar');
untie %h;
-unlink 'Op.dbmx.dir', $Dfile;
+unlink <Op_dbmx*>, $Dfile;
{
# sub-class test
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($@, "");
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) ;
$_ 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 = $_ }) ;
undef $db ;
untie %h;
- unlink <Op.dbmx*>;
+ unlink <Op_dbmx*>;
}
{
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 = () ;
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{$_} }) ;
undef $db ;
untie %h;
- unlink <Op.dbmx*>;
+ unlink <Op_dbmx*>;
}
{
# 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*>;
}
{
# 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_/}) ;
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, '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 { }) ;
undef $db ;
untie %h;
- unlink <Op.dbmx*>;
+ unlink <Op1_dbmx*>;
}
if ($^O eq 'hpux') {
my $Dfile = "Op_dbmx.pag";
if (! -e $Dfile) {
- ($Dfile) = <Op_dbmx.*>;
+ ($Dfile) = <Op_dbmx*>;
}
SKIP: {
skip "different file permission semantics on $^O", 1
is($h{'foo'}, '');
is($h{''}, 'bar');
+is(exists $h{goner1}, '');
+is(exists $h{foo}, 1);
+
+untie %h;
+unlink <Op_dbmx*>, $Dfile;
{
# sub-class test
close FILE or die "Could not close: $!";
BEGIN { push @INC, '.'; }
+ unlink <dbhash_tmp*> ;
eval 'use SubDB ; use Fcntl ;';
main::is($@, "");
}
-is(exists $h{goner1}, '');
-is(exists $h{foo}, 1);
-
untie %h;
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, "");