#!./perl -w
BEGIN {
- unshift @INC, '../lib' if -d '../lib' ;
+ @INC = '../lib';
require Config; import Config;
if ($Config{'extensions'} !~ /\bDB_File\b/) {
print "1..0 # Skip: DB_File was not built\n";
use DB_File;
use Fcntl;
use strict ;
+use warnings;
use vars qw($dbh $Dfile $bad_ones $FA) ;
# full tied array support started in Perl 5.004_57
EOM
}
-print "1..126\n";
+print "1..128\n";
my $Dfile = "recno.tmp";
unlink $Dfile ;
package Another ;
+ use warnings ;
use strict ;
open(FILE, ">SubDB.pm") or die "Cannot open SubDB.pm: $!\n" ;
package SubDB ;
+ use warnings ;
use strict ;
use vars qw( @ISA @EXPORT) ;
{
# DBM Filter tests
+ use warnings ;
use strict ;
my (@h, $db) ;
my ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
{
# DBM Filter with a closure
+ use warnings ;
use strict ;
my (@h, $db) ;
{
# DBM Filter recursion detection
+ use warnings ;
use strict ;
my (@h, $db) ;
unlink $Dfile;
{
my $redirect = new Redirect $file ;
+ use warnings FATAL => qw(all);
use strict ;
use DB_File ;
{
my $redirect = new Redirect $save_output ;
+ use warnings FATAL => qw(all);
use strict ;
use vars qw(@h $H $file $i) ;
use DB_File ;
}
+{
+ # Bug ID 20001013.009
+ #
+ # test that $hash{KEY} = undef doesn't produce the warning
+ # Use of uninitialized value in null operation
+ use warnings ;
+ use strict ;
+ use DB_File ;
+
+ unlink $Dfile;
+ my @h ;
+ my $a = "";
+ local $SIG{__WARN__} = sub {$a = $_[0]} ;
+
+ tie @h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0664, $DB_RECNO
+ or die "Can't open file: $!\n" ;
+ $h[0] = undef;
+ ok(127, $a eq "") ;
+ untie @h ;
+ unlink $Dfile;
+}
+
+{
+ # test that %hash = () doesn't produce the warning
+ # Argument "" isn't numeric in entersub
+ use warnings ;
+ use strict ;
+ use DB_File ;
+ my $a = "";
+ local $SIG{__WARN__} = sub {$a = $_[0]} ;
+
+ unlink $Dfile;
+ my @h ;
+
+ tie @h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0664, $DB_RECNO
+ or die "Can't open file: $!\n" ;
+ @h = (); ;
+ ok(128, $a eq "") ;
+ untie @h ;
+ unlink $Dfile;
+}
+
exit ;