From: Paul Marquess Date: Sat, 9 Dec 2000 16:47:22 +0000 (+0000) Subject: RE: [ID 20001013.009] DB_File issues warning when setting element to undef X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=cbc5248d01a71061a57c964b98f44bd4cb3a75c0;p=p5sagit%2Fp5-mst-13.2.git 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 ; @@ -178,6 +178,7 @@ EOM close FILE ; BEGIN { push @INC, '.'; } + unlink ; eval 'use SubDB ; '; main::ok(13, $@ eq "") ; @@ -392,3 +393,24 @@ EOM untie %h; unlink ; } + +{ + # 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 ; + 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 ; +} diff --git a/t/lib/ndbm.t b/t/lib/ndbm.t index 4937a8c..a834444 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 ; @@ -391,3 +391,20 @@ EOM untie %h; unlink ; } + +{ + # 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 ; + 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 --- 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 ; @@ -394,6 +394,27 @@ EOM unlink ; } +{ + # 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 ; + 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 ; +} + if ($^O eq 'hpux') { print <; @@ -396,3 +396,24 @@ unlink , $Dfile; unlink ; } +{ + # 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 ; + 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 ; +}