Fix for FETCH/NEXTKEY problem in all *DB*_File modules

Message-ID: <AIEAJICLCBDNAAOLLOKLAEOMDCAA.paul.marquess@openwave.com>

p4raw-id: //depot/perl@12564

3 files changed, 60 insertions, 3 deletions

diff --git a/ext/GDBM_File/GDBM_File.xs b/ext/GDBM_File/GDBM_File.xs
index ffdc41b14c..d58feeccef 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 3ba19e8722..7c268936f3 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 <Op.dbmx*>;
 
@@ -425,3 +425,46 @@ EOM
     untie %h;
     unlink <Op.dbmx*>;
 }
+
+{
+    # 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 <Op.dbmx*>;
+    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 <Op.dbmx*>;
+}
+
+exit ;
diff --git a/ext/GDBM_File/typemap b/ext/GDBM_File/typemap
index 1dd063003a..8952938ccd 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)) {