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

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

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 (file)
--- 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 (executable)
--- 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 (executable)
--- 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 (file)
--- 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 (executable)
--- 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 1dd0630..8952938 100644 (file)
--- 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 (file)
--- 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 (executable)
--- 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 <Op.dbmx*>;
 
@@ -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 <Op.dbmx*>;
+    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 <Op.dbmx*>;
+}
+
+exit ;

diff --git a/ext/ODBM_File/ODBM_File.xs b/ext/ODBM_File/ODBM_File.xs
index 3724dae..5a556bf 100644 (file)
--- 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 (executable)
--- 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 <Op.dbmx*>;
 
@@ -425,6 +425,48 @@ EOM
     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 ODBM_File ;
+
+    unlink <Op.dbmx*>;
+    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 <Op.dbmx*>;
+}
+
+exit ;
 if ($^O eq 'hpux') {
     print <<EOM;
 #

diff --git a/ext/ODBM_File/typemap b/ext/ODBM_File/typemap
index 096427e..62b8622 100644 (file)
--- a/ext/ODBM_File/typemap
+++ b/ext/ODBM_File/typemap
@@ -3,6 +3,7 @@
 #
 
 datum_key              T_DATUM_K
+datum_key_copy         T_DATUM_K_C
 datum_value            T_DATUM_V
 gdatum                 T_GDATUM
 NDBM_File              T_PTROBJ
@@ -18,6 +19,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/SDBM_File/SDBM_File.xs b/ext/SDBM_File/SDBM_File.xs
index 859730b..94fc305 100644 (file)
--- 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 (file)
--- 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 <Op_dbmx.*>;
 
@@ -427,3 +427,46 @@ unlink <Op_dbmx*>, $Dfile;
     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 SDBM_File ;
+
+    unlink <Op.dbmx*>;
+    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 <Op.dbmx*>;
+}
+
+exit ;