Fix #14957.

[p5sagit/p5-mst-13.2.git] / ext / DB_File / t / db-recno.t

diff --git a/ext/DB_File/t/db-recno.t b/ext/DB_File/t/db-recno.t
index 748bedf..f077252 100755 (executable)
--- a/ext/DB_File/t/db-recno.t
+++ b/ext/DB_File/t/db-recno.t
@@ -22,7 +22,7 @@ BEGIN {
 
 use DB_File; 
 use Fcntl;
-use vars qw($dbh $Dfile $bad_ones $FA) ;
+our ($dbh, $Dfile, $bad_ones, $FA);
 
 # full tied array support started in Perl 5.004_57
 # Double check to see if it is available.
@@ -93,8 +93,8 @@ sub bad_one
 {
     print STDERR <<EOM unless $bad_ones++ ;
 #
-# Some older versions of Berkeley DB version 1 will fail tests 51,
-# 53 and 55.
+# Some older versions of Berkeley DB version 1 will fail tests 61,
+# 63 and 65.
 #
 # You can safely ignore the errors if you're never going to use the
 # broken functionality (recno databases with a modified bval). 
@@ -131,14 +131,14 @@ my $total_tests = 138 ;
 $total_tests += $splice_tests if $FA ;
 print "1..$total_tests\n";   
 
-my $Dfile = "recno.tmp";
+$Dfile = "recno.tmp";
 unlink $Dfile ;
 
 umask(0);
 
 # Check the interface to RECNOINFO
 
-my $dbh = new DB_File::RECNOINFO ;
+$dbh = new DB_File::RECNOINFO ;
 ok(1, ! defined $dbh->{bval}) ;
 ok(2, ! defined $dbh->{cachesize}) ;
 ok(3, ! defined $dbh->{psize}) ;
@@ -400,7 +400,7 @@ unlink $Dfile;
 
    use warnings ;
    use strict ;
-   use vars qw( @ISA @EXPORT) ;
+   our (@ISA, @EXPORT);
 
    require Exporter ;
    use DB_File;
@@ -444,7 +444,7 @@ unlink $Dfile;
    1 ;
 EOM
 
-    close FILE ;
+    close FILE  or die "Could not close: $!";
 
     BEGIN { push @INC, '.'; } 
     eval 'use SubDB ; ';
@@ -454,6 +454,7 @@ EOM
     eval '
        $X = tie(@h, "SubDB","recno.tmp", O_RDWR|O_CREAT, 0640, $DB_RECNO );
        ' ;
+    die "Could not tie: $!" unless $X;
 
     main::ok(68, $@ eq "") ;
 
@@ -792,7 +793,7 @@ EOM
 
     use warnings FATAL => qw(all);
     use strict ;
-    use vars qw(@h $H $file $i) ;
+    our (@h, $H, $file, $i);
     use DB_File ;
     use Fcntl ;
     
@@ -1061,13 +1062,14 @@ sub test_splice {
     my @array = @$array;
     my @list = @$list;
 
-    open(TEXT, ">$tmp") or die "cannot write to $tmp: $!";
-    foreach (@array) { print TEXT "$_\n" }
-    close TEXT or die "cannot close $tmp: $!";
+    unlink $tmp;
     
     my @h;
-    my $H = tie @h, 'DB_File', $tmp, O_RDWR, 0644, $DB_RECNO
+    my $H = tie @h, 'DB_File', $tmp, O_CREAT|O_RDWR, 0644, $DB_RECNO
       or die "cannot open $tmp: $!";
+
+    my $i = 0;
+    foreach ( @array ) { $h[$i++] = $_ }
     
     return "basic DB_File sanity check failed"
       if list_diff(\@array, \@h);
@@ -1078,6 +1080,7 @@ sub test_splice {
     my ($s_r, $s_error, @s_warnings);
 
     my $gather_warning = sub { push @s_warnings, $_[0] };
+    $offset = $#array if $offset and $offset > @array;
     if ($context eq 'list') {
        my @r;
        eval {
@@ -1116,6 +1119,7 @@ sub test_splice {
     # Now do the same for DB_File's version of splice
     my ($ms_r, $ms_error, @ms_warnings);
     $gather_warning = sub { push @ms_warnings, $_[0] };
+    $offset = $#h if $offset and $offset > @h;
     if ($context eq 'list') {
        my @r;
        eval {