From: Paul Marquess Date: Sun, 21 Oct 2001 21:11:15 +0000 (+0100) Subject: Fix for FETCH/NEXTKEY problem in all *DB*_File modules X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0bf2e7072c2c1360a32d348a7c800f40c1108f8a;p=p5sagit%2Fp5-mst-13.2.git Fix for FETCH/NEXTKEY problem in all *DB*_File modules Message-ID: p4raw-id: //depot/perl@12564 --- diff --git a/ext/DB_File/DB_File.xs b/ext/DB_File/DB_File.xs index db4382b..05e5319 100644 --- a/ext/DB_File/DB_File.xs +++ b/ext/DB_File/DB_File.xs @@ -1777,13 +1777,14 @@ db_FIRSTKEY(db) void db_NEXTKEY(db, key) DB_File db - DBTKEY key + DBTKEY key = NO_INIT PREINIT: int RETVAL; CODE: { DBT value ; + DBT_clear(key) ; DBT_clear(value) ; CurrentDB = db ; RETVAL = do_SEQ(db, key, value, R_NEXT) ; diff --git a/ext/DB_File/t/db-btree.t b/ext/DB_File/t/db-btree.t index 905cbe1..a380496 100755 --- a/ext/DB_File/t/db-btree.t +++ b/ext/DB_File/t/db-btree.t @@ -15,7 +15,7 @@ use strict; use DB_File; use Fcntl; -print "1..157\n"; +print "1..163\n"; sub ok { @@ -1295,4 +1295,46 @@ EOM unlink $Dfile; } +{ + # When iterating over a tied hash using "each", the key passed to FETCH + # will be recycled and passed to NEXTKEY. If a Source Filter modifies the + # key in FETCH via a filter_fetch_key method we need to check that the + # modified key doesn't get passed to NEXTKEY. + # Also Test "keys" & "values" while we are at it. + + use warnings ; + use strict ; + use DB_File ; + + unlink $Dfile; + my $bad_key = 0 ; + my %h = () ; + my $db ; + ok(158, $db = tie(%h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_BTREE ) ); + $db->filter_fetch_key (sub { $_ =~ s/^Beta_/Alpha_/ if defined $_}) ; + $db->filter_store_key (sub { $bad_key = 1 if /^Beta_/ ; $_ =~ s/^Alpha_/Beta_/}) ; + + $h{'Alpha_ABC'} = 2 ; + $h{'Alpha_DEF'} = 5 ; + + ok(159, $h{'Alpha_ABC'} == 2); + ok(160, $h{'Alpha_DEF'} == 5); + + my ($k, $v) = ("",""); + while (($k, $v) = each %h) {} + ok(161, $bad_key == 0); + + $bad_key = 0 ; + foreach $k (keys %h) {} + ok(162, $bad_key == 0); + + $bad_key = 0 ; + foreach $v (values %h) {} + ok(163, $bad_key == 0); + + undef $db ; + untie %h ; + unlink $Dfile; +} + exit ; diff --git a/ext/DB_File/t/db-hash.t b/ext/DB_File/t/db-hash.t index 12b0848..1d13dc0 100755 --- a/ext/DB_File/t/db-hash.t +++ b/ext/DB_File/t/db-hash.t @@ -15,7 +15,7 @@ use warnings; use DB_File; use Fcntl; -print "1..111\n"; +print "1..117\n"; sub ok { @@ -742,4 +742,46 @@ EOM unlink $Dfile; } +{ + # When iterating over a tied hash using "each", the key passed to FETCH + # will be recycled and passed to NEXTKEY. If a Source Filter modifies the + # key in FETCH via a filter_fetch_key method we need to check that the + # modified key doesn't get passed to NEXTKEY. + # Also Test "keys" & "values" while we are at it. + + use warnings ; + use strict ; + use DB_File ; + + unlink $Dfile; + my $bad_key = 0 ; + my %h = () ; + my $db ; + ok(112, $db = tie(%h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_HASH ) ); + $db->filter_fetch_key (sub { $_ =~ s/^Beta_/Alpha_/ if defined $_}) ; + $db->filter_store_key (sub { $bad_key = 1 if /^Beta_/ ; $_ =~ s/^Alpha_/Beta_/}) ; + + $h{'Alpha_ABC'} = 2 ; + $h{'Alpha_DEF'} = 5 ; + + ok(113, $h{'Alpha_ABC'} == 2); + ok(114, $h{'Alpha_DEF'} == 5); + + my ($k, $v) = ("",""); + while (($k, $v) = each %h) {} + ok(115, $bad_key == 0); + + $bad_key = 0 ; + foreach $k (keys %h) {} + ok(116, $bad_key == 0); + + $bad_key = 0 ; + foreach $v (values %h) {} + ok(117, $bad_key == 0); + + undef $db ; + untie %h ; + unlink $Dfile; +} + exit ; diff --git a/ext/GDBM_File/GDBM_File.xs b/ext/GDBM_File/GDBM_File.xs index ffdc41b..d58feec 100644 --- a/ext/GDBM_File/GDBM_File.xs +++ b/ext/GDBM_File/GDBM_File.xs @@ -17,6 +17,7 @@ typedef struct { typedef GDBM_File_type * GDBM_File ; typedef datum datum_key ; typedef datum datum_value ; +typedef datum datum_key_copy; #define ckFilter(arg,type,name) \ if (db->type) { \ @@ -122,7 +123,7 @@ gdbm_DESTROY(db) datum_value gdbm_FETCH(db, key) GDBM_File db - datum_key key + datum_key_copy key #define gdbm_STORE(db,key,value,flags) gdbm_store(db->dbp,key,value,flags) int @@ -154,7 +155,7 @@ gdbm_FIRSTKEY(db) datum_key gdbm_NEXTKEY(db, key) GDBM_File db - datum_key key + datum_key key #define gdbm_reorganize(db) gdbm_reorganize(db->dbp) int diff --git a/ext/GDBM_File/gdbm.t b/ext/GDBM_File/gdbm.t index 3ba19e8..7c26893 100755 --- a/ext/GDBM_File/gdbm.t +++ b/ext/GDBM_File/gdbm.t @@ -18,7 +18,7 @@ use warnings; use GDBM_File; -print "1..68\n"; +print "1..74\n"; unlink ; @@ -425,3 +425,46 @@ EOM untie %h; unlink ; } + +{ + # When iterating over a tied hash using "each", the key passed to FETCH + # will be recycled and passed to NEXTKEY. If a Source Filter modifies the + # key in FETCH via a filter_fetch_key method we need to check that the + # modified key doesn't get passed to NEXTKEY. + # Also Test "keys" & "values" while we are at it. + + use warnings ; + use strict ; + use GDBM_File ; + + unlink ; + my $bad_key = 0 ; + my %h = () ; + ok(69, my $db = tie(%h, 'GDBM_File','Op.dbmx', &GDBM_WRCREAT, 0640)); + $db->filter_fetch_key (sub { $_ =~ s/^Beta_/Alpha_/ if defined $_}) ; + $db->filter_store_key (sub { $bad_key = 1 if /^Beta_/ ; $_ =~ s/^Alpha_/Beta_/}) ; + + $h{'Alpha_ABC'} = 2 ; + $h{'Alpha_DEF'} = 5 ; + + ok(70, $h{'Alpha_ABC'} == 2); + ok(71, $h{'Alpha_DEF'} == 5); + + my ($k, $v) = ("",""); + while (($k, $v) = each %h) {} + ok(72, $bad_key == 0); + + $bad_key = 0 ; + foreach $k (keys %h) {} + ok(73, $bad_key == 0); + + $bad_key = 0 ; + foreach $v (values %h) {} + ok(74, $bad_key == 0); + + undef $db ; + untie %h ; + unlink ; +} + +exit ; diff --git a/ext/GDBM_File/typemap b/ext/GDBM_File/typemap index 1dd0630..8952938 100644 --- a/ext/GDBM_File/typemap +++ b/ext/GDBM_File/typemap @@ -3,6 +3,7 @@ # datum_key T_DATUM_K +datum_key_copy T_DATUM_K_C datum_value T_DATUM_V NDBM_File T_PTROBJ GDBM_File T_PTROBJ @@ -17,6 +18,18 @@ T_DATUM_K ckFilter($arg, filter_store_key, \"filter_store_key\"); $var.dptr = SvPV($arg, PL_na); $var.dsize = (int)PL_na; +T_DATUM_K_C + { + SV * tmpSV; + if (db->filter_store_key) { + tmpSV = sv_2mortal(newSVsv($arg)); + ckFilter(tmpSV, filter_store_key, \"filter_store_key\"); + } + else + tmpSV = $arg; + $var.dptr = SvPV(tmpSV, PL_na); + $var.dsize = (int)PL_na; + } T_DATUM_V ckFilter($arg, filter_store_value, \"filter_store_value\"); if (SvOK($arg)) { diff --git a/ext/NDBM_File/NDBM_File.xs b/ext/NDBM_File/NDBM_File.xs index 55dd639..78a56cb 100644 --- a/ext/NDBM_File/NDBM_File.xs +++ b/ext/NDBM_File/NDBM_File.xs @@ -107,7 +107,7 @@ ndbm_FIRSTKEY(db) datum_key ndbm_NEXTKEY(db, key) NDBM_File db - datum_key key + datum_key key = NO_INIT #define ndbm_error(db) dbm_error(db->dbp) int diff --git a/ext/NDBM_File/ndbm.t b/ext/NDBM_File/ndbm.t index f560343..a340e33 100755 --- a/ext/NDBM_File/ndbm.t +++ b/ext/NDBM_File/ndbm.t @@ -28,7 +28,7 @@ require NDBM_File; #If Fcntl is not available, try 0x202 or 0x102 for O_RDWR|O_CREAT use Fcntl; -print "1..65\n"; +print "1..71\n"; unlink ; @@ -418,3 +418,46 @@ EOM ok(65, tie(%h, 'NDBM_File','Op.dbmx', O_RDWR|O_CREAT, 0640)) ; } + +{ + # When iterating over a tied hash using "each", the key passed to FETCH + # will be recycled and passed to NEXTKEY. If a Source Filter modifies the + # key in FETCH via a filter_fetch_key method we need to check that the + # modified key doesn't get passed to NEXTKEY. + # Also Test "keys" & "values" while we are at it. + + use warnings ; + use strict ; + use NDBM_File ; + + unlink ; + my $bad_key = 0 ; + my %h = () ; + ok(66, my $db = tie(%h, 'NDBM_File','Op.dbmx', O_RDWR|O_CREAT, 0640)) ; + $db->filter_fetch_key (sub { $_ =~ s/^Beta_/Alpha_/ if defined $_}) ; + $db->filter_store_key (sub { $bad_key = 1 if /^Beta_/ ; $_ =~ s/^Alpha_/Beta_/}) ; + + $h{'Alpha_ABC'} = 2 ; + $h{'Alpha_DEF'} = 5 ; + + ok(67, $h{'Alpha_ABC'} == 2); + ok(68, $h{'Alpha_DEF'} == 5); + + my ($k, $v) = ("",""); + while (($k, $v) = each %h) {} + ok(69, $bad_key == 0); + + $bad_key = 0 ; + foreach $k (keys %h) {} + ok(70, $bad_key == 0); + + $bad_key = 0 ; + foreach $v (values %h) {} + ok(71, $bad_key == 0); + + undef $db ; + untie %h ; + unlink ; +} + +exit ; diff --git a/ext/ODBM_File/ODBM_File.xs b/ext/ODBM_File/ODBM_File.xs index 3724dae..5a556bf 100644 --- a/ext/ODBM_File/ODBM_File.xs +++ b/ext/ODBM_File/ODBM_File.xs @@ -53,6 +53,7 @@ typedef struct { typedef ODBM_File_type * ODBM_File ; typedef datum datum_key ; +typedef datum datum_key_copy ; typedef datum datum_value ; #define ckFilter(arg,type,name) \ @@ -133,7 +134,7 @@ DESTROY(db) datum_value odbm_FETCH(db, key) ODBM_File db - datum_key key + datum_key_copy key int odbm_STORE(db, key, value, flags = DBM_REPLACE) diff --git a/ext/ODBM_File/odbm.t b/ext/ODBM_File/odbm.t index a43e70b..ecffffd 100755 --- a/ext/ODBM_File/odbm.t +++ b/ext/ODBM_File/odbm.t @@ -28,7 +28,7 @@ require ODBM_File; #If Fcntl is not available, try 0x202 or 0x102 for O_RDWR|O_CREAT use Fcntl; -print "1..66\n"; +print "1..72\n"; unlink ; @@ -425,6 +425,48 @@ EOM unlink ; } +{ + # When iterating over a tied hash using "each", the key passed to FETCH + # will be recycled and passed to NEXTKEY. If a Source Filter modifies the + # key in FETCH via a filter_fetch_key method we need to check that the + # modified key doesn't get passed to NEXTKEY. + # Also Test "keys" & "values" while we are at it. + + use warnings ; + use strict ; + use ODBM_File ; + + unlink ; + my $bad_key = 0 ; + my %h = () ; + ok(67, my $db = tie(%h, 'ODBM_File','Op.dbmx', O_RDWR|O_CREAT, 0640)) ; + $db->filter_fetch_key (sub { $_ =~ s/^Beta_/Alpha_/ if defined $_}) ; + $db->filter_store_key (sub { $bad_key = 1 if /^Beta_/ ; $_ =~ s/^Alpha_/Beta_/}) ; + + $h{'Alpha_ABC'} = 2 ; + $h{'Alpha_DEF'} = 5 ; + + ok(68, $h{'Alpha_ABC'} == 2); + ok(69, $h{'Alpha_DEF'} == 5); + + my ($k, $v) = ("",""); + while (($k, $v) = each %h) {} + ok(70, $bad_key == 0); + + $bad_key = 0 ; + foreach $k (keys %h) {} + ok(71, $bad_key == 0); + + $bad_key = 0 ; + foreach $v (values %h) {} + ok(72, $bad_key == 0); + + undef $db ; + untie %h ; + unlink ; +} + +exit ; if ($^O eq 'hpux') { print <filter_store_key){ + tmpSV = sv_2mortal(newSVsv($arg)); + ckFilter(tmpSV, filter_store_key, \"filter_store_key\"); + } + else + tmpSV = $arg; + $var.dptr = SvPV(tmpSV, PL_na); + $var.dsize = (int)PL_na; + } T_DATUM_V ckFilter($arg, filter_store_value, \"filter_store_value\"); if (SvOK($arg)) { diff --git a/ext/SDBM_File/SDBM_File.xs b/ext/SDBM_File/SDBM_File.xs index 859730b..94fc305 100644 --- a/ext/SDBM_File/SDBM_File.xs +++ b/ext/SDBM_File/SDBM_File.xs @@ -119,7 +119,7 @@ sdbm_FIRSTKEY(db) datum_key sdbm_NEXTKEY(db, key) SDBM_File db - datum_key key + datum_key key = NO_INIT int sdbm_error(db) diff --git a/ext/SDBM_File/sdbm.t b/ext/SDBM_File/sdbm.t index 49bc9f1..e1ed259 100644 --- a/ext/SDBM_File/sdbm.t +++ b/ext/SDBM_File/sdbm.t @@ -28,7 +28,7 @@ require SDBM_File; #If Fcntl is not available, try 0x202 or 0x102 for O_RDWR|O_CREAT use Fcntl; -print "1..68\n"; +print "1..74\n"; unlink ; @@ -427,3 +427,46 @@ unlink , $Dfile; untie %h; unlink ; } + +{ + # When iterating over a tied hash using "each", the key passed to FETCH + # will be recycled and passed to NEXTKEY. If a Source Filter modifies the + # key in FETCH via a filter_fetch_key method we need to check that the + # modified key doesn't get passed to NEXTKEY. + # Also Test "keys" & "values" while we are at it. + + use warnings ; + use strict ; + use SDBM_File ; + + unlink ; + my $bad_key = 0 ; + my %h = () ; + ok(69, my $db = tie(%h, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640)) ; + $db->filter_fetch_key (sub { $_ =~ s/^Beta_/Alpha_/ if defined $_}) ; + $db->filter_store_key (sub { $bad_key = 1 if /^Beta_/ ; $_ =~ s/^Alpha_/Beta_/}) ; + + $h{'Alpha_ABC'} = 2 ; + $h{'Alpha_DEF'} = 5 ; + + ok(70, $h{'Alpha_ABC'} == 2); + ok(71, $h{'Alpha_DEF'} == 5); + + my ($k, $v) = ("",""); + while (($k, $v) = each %h) {} + ok(72, $bad_key == 0); + + $bad_key = 0 ; + foreach $k (keys %h) {} + ok(73, $bad_key == 0); + + $bad_key = 0 ; + foreach $v (values %h) {} + ok(74, $bad_key == 0); + + undef $db ; + untie %h ; + unlink ; +} + +exit ;