From: Paul Marquess <paul.marquess@btinternet.com>
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: <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
--- 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 <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
--- 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 <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
--- 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 <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
--- 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
--- 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 <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 ;