RE: [ID 20001013.009] DB_File issues warning when setting element to undef

Message-ID: <002001c061ff$b3aba820$a20a140a@bfs.phone.com>

p4raw-id: //depot/perl@8068

16 files changed, 193 insertions, 21 deletions

diff --git a/ext/DB_File/typemap b/ext/DB_File/typemap
index 41a24f4a86..b244e53158 100644
--- a/ext/DB_File/typemap
+++ b/ext/DB_File/typemap
@@ -29,8 +29,10 @@ T_dbtkeydatum
 T_dbtdatum
 	ckFilter($arg, filter_store_value, \"filter_store_value\");
 	DBT_clear($var) ;
-	$var.data = SvPV($arg, PL_na);
-	$var.size = (int)PL_na;
+	if (SvOK($arg)) {
+	    $var.data = SvPV($arg, PL_na);
+	    $var.size = (int)PL_na;
+	}
 
 
 OUTPUT
diff --git a/ext/GDBM_File/GDBM_File.pm b/ext/GDBM_File/GDBM_File.pm
index ab866eecab..fe87dd0856 100644
--- a/ext/GDBM_File/GDBM_File.pm
+++ b/ext/GDBM_File/GDBM_File.pm
@@ -59,7 +59,7 @@ use XSLoader ();
 	GDBM_WRITER
 );
 
-$VERSION = "1.03";
+$VERSION = "1.04";
 
 sub AUTOLOAD {
     my($constname);
diff --git a/ext/GDBM_File/typemap b/ext/GDBM_File/typemap
index 4f79ae3e32..1dd063003a 100644
--- a/ext/GDBM_File/typemap
+++ b/ext/GDBM_File/typemap
@@ -19,8 +19,14 @@ T_DATUM_K
 	$var.dsize = (int)PL_na;
 T_DATUM_V
         ckFilter($arg, filter_store_value, \"filter_store_value\");
-	$var.dptr = SvPV($arg, PL_na);
-	$var.dsize = (int)PL_na;
+	if (SvOK($arg)) {
+	    $var.dptr = SvPV($arg, PL_na);
+	    $var.dsize = (int)PL_na;
+	}
+	else {
+	    $var.dptr = \"\";
+	    $var.dsize = 0;
+	}
 OUTPUT
 T_DATUM_K
 	output_datum(aTHX_ $arg, $var.dptr, $var.dsize);
diff --git a/ext/NDBM_File/NDBM_File.pm b/ext/NDBM_File/NDBM_File.pm
index c9ef6993a8..99aae17d5c 100644
--- a/ext/NDBM_File/NDBM_File.pm
+++ b/ext/NDBM_File/NDBM_File.pm
@@ -10,7 +10,7 @@ require Tie::Hash;
 use XSLoader ();
 
 our @ISA = qw(Tie::Hash);
-our $VERSION = "1.03";
+our $VERSION = "1.04";
 
 XSLoader::load 'NDBM_File', $VERSION;
 
diff --git a/ext/NDBM_File/typemap b/ext/NDBM_File/typemap
index eeb5d59027..40b95f22c0 100644
--- a/ext/NDBM_File/typemap
+++ b/ext/NDBM_File/typemap
@@ -20,8 +20,14 @@ T_DATUM_K
 	$var.dsize = (int)PL_na;
 T_DATUM_V
         ckFilter($arg, filter_store_value, \"filter_store_value\");
-	$var.dptr = SvPV($arg, PL_na);
-	$var.dsize = (int)PL_na;
+	if (SvOK($arg)) {
+	    $var.dptr = SvPV($arg, PL_na);
+	    $var.dsize = (int)PL_na;
+	}
+	else {
+	    $var.dptr = \"\";
+	    $var.dsize = 0;
+	}
 T_GDATUM
 	UNIMPLEMENTED
 OUTPUT
diff --git a/ext/ODBM_File/ODBM_File.pm b/ext/ODBM_File/ODBM_File.pm
index 732ed60930..4244eb966f 100644
--- a/ext/ODBM_File/ODBM_File.pm
+++ b/ext/ODBM_File/ODBM_File.pm
@@ -6,7 +6,7 @@ require Tie::Hash;
 use XSLoader ();
 
 our @ISA = qw(Tie::Hash);
-our $VERSION = "1.02";
+our $VERSION = "1.03";
 
 XSLoader::load 'ODBM_File', $VERSION;
 
diff --git a/ext/ODBM_File/typemap b/ext/ODBM_File/typemap
index 7c23815ec7..096427ea7f 100644
--- a/ext/ODBM_File/typemap
+++ b/ext/ODBM_File/typemap
@@ -20,8 +20,14 @@ T_DATUM_K
 	$var.dsize = (int)PL_na;
 T_DATUM_V
         ckFilter($arg, filter_store_value, \"filter_store_value\");
-	$var.dptr = SvPV($arg, PL_na);
-	$var.dsize = (int)PL_na;
+	if (SvOK($arg)) {
+	    $var.dptr = SvPV($arg, PL_na);
+	    $var.dsize = (int)PL_na;
+	}
+	else {
+	    $var.dptr = \"\";
+	    $var.dsize = 0;
+	}
 T_GDATUM
 	UNIMPLEMENTED
 OUTPUT
diff --git a/ext/SDBM_File/SDBM_File.pm b/ext/SDBM_File/SDBM_File.pm
index b3502b9837..4d1411bf34 100644
--- a/ext/SDBM_File/SDBM_File.pm
+++ b/ext/SDBM_File/SDBM_File.pm
@@ -6,7 +6,7 @@ require Tie::Hash;
 use XSLoader ();
 
 our @ISA = qw(Tie::Hash);
-our $VERSION = "1.02" ;
+our $VERSION = "1.03" ;
 
 XSLoader::load 'SDBM_File', $VERSION;
 
diff --git a/ext/SDBM_File/typemap b/ext/SDBM_File/typemap
index eeb5d59027..40b95f22c0 100644
--- a/ext/SDBM_File/typemap
+++ b/ext/SDBM_File/typemap
@@ -20,8 +20,14 @@ T_DATUM_K
 	$var.dsize = (int)PL_na;
 T_DATUM_V
         ckFilter($arg, filter_store_value, \"filter_store_value\");
-	$var.dptr = SvPV($arg, PL_na);
-	$var.dsize = (int)PL_na;
+	if (SvOK($arg)) {
+	    $var.dptr = SvPV($arg, PL_na);
+	    $var.dsize = (int)PL_na;
+	}
+	else {
+	    $var.dptr = \"\";
+	    $var.dsize = 0;
+	}
 T_GDATUM
 	UNIMPLEMENTED
 OUTPUT
diff --git a/t/lib/db-btree.t b/t/lib/db-btree.t
index 75c661bbee..11e86afc1d 100755
--- a/t/lib/db-btree.t
+++ b/t/lib/db-btree.t
@@ -12,7 +12,7 @@ BEGIN {
 use DB_File; 
 use Fcntl;
 
-print "1..155\n";
+print "1..156\n";
 
 sub ok
 {
@@ -1217,4 +1217,26 @@ EOM
 #   unlink $Dfile;
 #}
 
+{
+    # 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_BTREE 
+	or die "Can't open file: $!\n" ;
+    $h{ABC} = undef;
+    ok(156, $a eq "") ;
+    untie %h ;
+    unlink $Dfile;
+}
+
 exit ;
diff --git a/t/lib/db-hash.t b/t/lib/db-hash.t
index b7018742e4..462796926c 100755
--- a/t/lib/db-hash.t
+++ b/t/lib/db-hash.t
@@ -12,7 +12,7 @@ BEGIN {
 use DB_File; 
 use Fcntl;
 
-print "1..109\n";
+print "1..110\n";
 
 sub ok
 {
@@ -682,4 +682,25 @@ EOM
    
 }
 
+{
+    # 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 or die "Can't open file: $!\n" ;
+    $h{ABC} = undef;
+    ok(110, $a eq "") ;
+    untie %h;
+    unlink $Dfile;
+}
+
 exit ;
diff --git a/t/lib/db-recno.t b/t/lib/db-recno.t
index 18fb45b114..f932a8938c 100755
--- a/t/lib/db-recno.t
+++ b/t/lib/db-recno.t
@@ -99,7 +99,7 @@ sub bad_one
 EOM
 }
 
-print "1..126\n";
+print "1..127\n";
 
 my $Dfile = "recno.tmp";
 unlink $Dfile ;
@@ -836,4 +836,26 @@ EOM
    
 }
 
+{
+    # 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;
+}
+
 exit ;
diff --git a/t/lib/gdbm.t b/t/lib/gdbm.t
index 54f59946b7..af83fdda81 100755
--- a/t/lib/gdbm.t
+++ b/t/lib/gdbm.t
@@ -13,7 +13,7 @@ BEGIN {
 
 use GDBM_File;
 
-print "1..66\n";
+print "1..68\n";
 
 unlink <Op.dbmx*>;
 
@@ -178,6 +178,7 @@ EOM
     close FILE ;
 
     BEGIN { push @INC, '.'; }
+    unlink <dbhash.tmp*> ;
 
     eval 'use SubDB ; ';
     main::ok(13, $@ eq "") ;
@@ -392,3 +393,24 @@ EOM
    untie %h;
    unlink <Op.dbmx*>;
 }
+
+{
+    # 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 GDBM_File ;
+
+    unlink <Op.dbmx*>;
+    my %h ;
+    my $a = "";
+    local $SIG{__WARN__} = sub {$a = $_[0]} ;
+    
+    ok(67, tie(%h, 'GDBM_File','Op.dbmx', &GDBM_WRCREAT, 0640));
+    $h{ABC} = undef;
+    ok(68, $a eq "") ;
+    untie %h;
+    unlink <Op.dbmx*>;
+}
diff --git a/t/lib/ndbm.t b/t/lib/ndbm.t
index 4937a8ce31..a8344444c8 100755
--- a/t/lib/ndbm.t
+++ b/t/lib/ndbm.t
@@ -16,7 +16,7 @@ require NDBM_File;
 #If Fcntl is not available, try 0x202 or 0x102 for O_RDWR|O_CREAT
 use Fcntl;
 
-print "1..64\n";
+print "1..65\n";
 
 unlink <Op.dbmx*>;
 
@@ -391,3 +391,20 @@ EOM
    untie %h;
    unlink <Op.dbmx*>;
 }
+
+{
+    # 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 NDBM_File ;
+
+    unlink <Op.dbmx*>;
+    my %h ;
+    my $a = "";
+    local $SIG{__WARN__} = sub {$a = $_[0]} ;
+    
+    ok(65, tie(%h, 'NDBM_File','Op.dbmx', O_RDWR|O_CREAT, 0640)) ;
+}
diff --git a/t/lib/odbm.t b/t/lib/odbm.t
index ccd3e60319..f2c1bb6d32 100755
--- a/t/lib/odbm.t
+++ b/t/lib/odbm.t
@@ -16,7 +16,7 @@ require ODBM_File;
 #If Fcntl is not available, try 0x202 or 0x102 for O_RDWR|O_CREAT
 use Fcntl;
 
-print "1..64\n";
+print "1..66\n";
 
 unlink <Op.dbmx*>;
 
@@ -394,6 +394,27 @@ EOM
    unlink <Op.dbmx*>;
 }
 
+{
+    # 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 ODBM_File ;
+
+    unlink <Op.dbmx*>;
+    my %h ;
+    my $a = "";
+    local $SIG{__WARN__} = sub {$a = $_[0]} ;
+    
+    ok(65, tie(%h, 'ODBM_File','Op.dbmx', O_RDWR|O_CREAT, 0640)) ;
+    $h{ABC} = undef;
+    ok(66, $a eq "") ;
+    untie %h;
+    unlink <Op.dbmx*>;
+}
+
 if ($^O eq 'hpux') {
     print <<EOM;
 #
diff --git a/t/lib/sdbm.t b/t/lib/sdbm.t
index b6a1a69de0..d60447e960 100755
--- a/t/lib/sdbm.t
+++ b/t/lib/sdbm.t
@@ -15,7 +15,7 @@ require SDBM_File;
 #If Fcntl is not available, try 0x202 or 0x102 for O_RDWR|O_CREAT
 use Fcntl;
 
-print "1..66\n";
+print "1..68\n";
 
 unlink <Op_dbmx.*>;
 
@@ -396,3 +396,24 @@ unlink <Op_dbmx*>, $Dfile;
    unlink <Op_dbmx*>;
 }
 
+{
+    # 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 SDBM_File ;
+
+    unlink <Op_dbmx*>;
+    my %h ;
+    my $a = "";
+    local $SIG{__WARN__} = sub {$a = $_[0]} ;
+    
+    ok(67, tie(%h, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640)) ;
+    $h{ABC} = undef;
+    ok(68, $a eq "") ;
+
+    untie %h;
+    unlink <Op_dbmx*>;
+}