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

diff --git a/ext/DB_File/typemap b/ext/DB_File/typemap
index 41a24f4..b244e53 100644 (file)
--- 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 ab866ee..fe87dd0 100644 (file)
--- 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 4f79ae3..1dd0630 100644 (file)
--- 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 c9ef699..99aae17 100644 (file)
--- 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 eeb5d59..40b95f2 100644 (file)
--- 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 732ed60..4244eb9 100644 (file)
--- 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 7c23815..096427e 100644 (file)
--- 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 b3502b9..4d1411b 100644 (file)
--- 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 eeb5d59..40b95f2 100644 (file)
--- 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 75c661b..11e86af 100755 (executable)
--- 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 b701874..4627969 100755 (executable)
--- 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 18fb45b..f932a89 100755 (executable)
--- 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 54f5994..af83fdd 100755 (executable)
--- 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 4937a8c..a834444 100755 (executable)
--- 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 ccd3e60..f2c1bb6 100755 (executable)
--- 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 b6a1a69..d60447e 100755 (executable)
--- 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*>;
+}