Change 12564 by jhi@alpha on 2001/10/22 12:17:00
Subject: [PATCH @ ] Fix for FETCH/NEXTKEY problem in all *DB*_File modules
From: "Paul Marquess" <[EMAIL PROTECTED]>
Date: Sun, 21 Oct 2001 21:11:15 +0100
Message-ID: <[EMAIL PROTECTED]>
Affected files ...
... //depot/perl/ext/DB_File/DB_File.xs#51 edit
... //depot/perl/ext/DB_File/t/db-btree.t#4 edit
... //depot/perl/ext/DB_File/t/db-hash.t#4 edit
... //depot/perl/ext/GDBM_File/GDBM_File.xs#22 edit
... //depot/perl/ext/GDBM_File/gdbm.t#3 edit
... //depot/perl/ext/GDBM_File/typemap#13 edit
... //depot/perl/ext/NDBM_File/NDBM_File.xs#12 edit
... //depot/perl/ext/NDBM_File/ndbm.t#3 edit
... //depot/perl/ext/ODBM_File/ODBM_File.xs#19 edit
... //depot/perl/ext/ODBM_File/odbm.t#2 edit
... //depot/perl/ext/ODBM_File/typemap#10 edit
... //depot/perl/ext/SDBM_File/SDBM_File.xs#13 edit
... //depot/perl/ext/SDBM_File/sdbm.t#2 edit
Differences ...
==== //depot/perl/ext/DB_File/DB_File.xs#51 (text) ====
Index: perl/ext/DB_File/DB_File.xs
--- perl/ext/DB_File/DB_File.xs.~1~ Mon Oct 22 06:30:06 2001
+++ perl/ext/DB_File/DB_File.xs Mon Oct 22 06:30:06 2001
@@ -1777,13 +1777,14 @@
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) ;
==== //depot/perl/ext/DB_File/t/db-btree.t#4 (xtext) ====
Index: perl/ext/DB_File/t/db-btree.t
--- perl/ext/DB_File/t/db-btree.t.~1~ Mon Oct 22 06:30:06 2001
+++ perl/ext/DB_File/t/db-btree.t Mon Oct 22 06:30:06 2001
@@ -15,7 +15,7 @@
use DB_File;
use Fcntl;
-print "1..157\n";
+print "1..163\n";
sub ok
{
@@ -1295,4 +1295,46 @@
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 ;
==== //depot/perl/ext/DB_File/t/db-hash.t#4 (xtext) ====
Index: perl/ext/DB_File/t/db-hash.t
--- perl/ext/DB_File/t/db-hash.t.~1~ Mon Oct 22 06:30:06 2001
+++ perl/ext/DB_File/t/db-hash.t Mon Oct 22 06:30:06 2001
@@ -15,7 +15,7 @@
use DB_File;
use Fcntl;
-print "1..111\n";
+print "1..117\n";
sub ok
{
@@ -742,4 +742,46 @@
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 ;
==== //depot/perl/ext/GDBM_File/GDBM_File.xs#22 (text) ====
Index: perl/ext/GDBM_File/GDBM_File.xs
--- perl/ext/GDBM_File/GDBM_File.xs.~1~ Mon Oct 22 06:30:06 2001
+++ perl/ext/GDBM_File/GDBM_File.xs Mon Oct 22 06:30:06 2001
@@ -17,6 +17,7 @@
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 @@
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 @@
datum_key
gdbm_NEXTKEY(db, key)
GDBM_File db
- datum_key key
+ datum_key key
#define gdbm_reorganize(db) gdbm_reorganize(db->dbp)
int
==== //depot/perl/ext/GDBM_File/gdbm.t#3 (xtext) ====
Index: perl/ext/GDBM_File/gdbm.t
--- perl/ext/GDBM_File/gdbm.t.~1~ Mon Oct 22 06:30:06 2001
+++ perl/ext/GDBM_File/gdbm.t Mon Oct 22 06:30:06 2001
@@ -18,7 +18,7 @@
use GDBM_File;
-print "1..68\n";
+print "1..74\n";
unlink <Op.dbmx*>;
@@ -425,3 +425,46 @@
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 ;
==== //depot/perl/ext/GDBM_File/typemap#13 (text) ====
Index: perl/ext/GDBM_File/typemap
--- perl/ext/GDBM_File/typemap.~1~ Mon Oct 22 06:30:06 2001
+++ perl/ext/GDBM_File/typemap Mon Oct 22 06:30:06 2001
@@ -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 @@
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)) {
==== //depot/perl/ext/NDBM_File/NDBM_File.xs#12 (text) ====
Index: perl/ext/NDBM_File/NDBM_File.xs
--- perl/ext/NDBM_File/NDBM_File.xs.~1~ Mon Oct 22 06:30:06 2001
+++ perl/ext/NDBM_File/NDBM_File.xs Mon Oct 22 06:30:06 2001
@@ -107,7 +107,7 @@
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
==== //depot/perl/ext/NDBM_File/ndbm.t#3 (xtext) ====
Index: perl/ext/NDBM_File/ndbm.t
--- perl/ext/NDBM_File/ndbm.t.~1~ Mon Oct 22 06:30:06 2001
+++ perl/ext/NDBM_File/ndbm.t Mon Oct 22 06:30:06 2001
@@ -28,7 +28,7 @@
#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 @@
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 ;
==== //depot/perl/ext/ODBM_File/ODBM_File.xs#19 (text) ====
Index: perl/ext/ODBM_File/ODBM_File.xs
--- perl/ext/ODBM_File/ODBM_File.xs.~1~ Mon Oct 22 06:30:06 2001
+++ perl/ext/ODBM_File/ODBM_File.xs Mon Oct 22 06:30:06 2001
@@ -53,6 +53,7 @@
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 @@
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)
==== //depot/perl/ext/ODBM_File/odbm.t#2 (xtext) ====
Index: perl/ext/ODBM_File/odbm.t
--- perl/ext/ODBM_File/odbm.t.~1~ Mon Oct 22 06:30:06 2001
+++ perl/ext/ODBM_File/odbm.t Mon Oct 22 06:30:06 2001
@@ -28,7 +28,7 @@
#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 @@
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;
#
==== //depot/perl/ext/ODBM_File/typemap#10 (text) ====
Index: perl/ext/ODBM_File/typemap
--- perl/ext/ODBM_File/typemap.~1~ Mon Oct 22 06:30:06 2001
+++ perl/ext/ODBM_File/typemap Mon Oct 22 06:30:06 2001
@@ -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 @@
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)) {
==== //depot/perl/ext/SDBM_File/SDBM_File.xs#13 (text) ====
Index: perl/ext/SDBM_File/SDBM_File.xs
--- perl/ext/SDBM_File/SDBM_File.xs.~1~ Mon Oct 22 06:30:06 2001
+++ perl/ext/SDBM_File/SDBM_File.xs Mon Oct 22 06:30:06 2001
@@ -119,7 +119,7 @@
datum_key
sdbm_NEXTKEY(db, key)
SDBM_File db
- datum_key key
+ datum_key key = NO_INIT
int
sdbm_error(db)
==== //depot/perl/ext/SDBM_File/sdbm.t#2 (text) ====
Index: perl/ext/SDBM_File/sdbm.t
--- perl/ext/SDBM_File/sdbm.t.~1~ Mon Oct 22 06:30:06 2001
+++ perl/ext/SDBM_File/sdbm.t Mon Oct 22 06:30:06 2001
@@ -28,7 +28,7 @@
#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 @@
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 ;
End of Patch.
