In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/4596056478d3ae4ae183d2821eb95156aff83924?hp=37f6eaa490d61972fa887e4e7bbeaf0de90b3ee9>
- Log -----------------------------------------------------------------
commit 4596056478d3ae4ae183d2821eb95156aff83924
Author: David Mitchell <da...@iabyn.com>
Date: Sat Sep 11 23:30:44 2010 +0100
list cxt hash assign with dups gives garbage
Fix for #31865: weird results from reverse( %x = reverse %h )
Basically, anything of the form
@a = %h = (list with some duplicate keys)
may have left @a containing weird and/or freed values.
There was a partial fix for this with ca65944e, but it was broken
(it did one big block move on the stack at the end to remove duplicates,
but duplicates weren't necessarily all in one block.)
The new fix is a two-stage process. First, while pulling key/value pairs
of the stack and assigning them to the hash, each key/val pair is written
back to the stack - possibly at a lower position if there are duplicates to
be skipped.
Finally at the end if any duplicates have been detected, then in list
context, a single pass is made through the stack, and for each key/val
pair, the key is looked up and the val on the stack is overwritten with
the new value (replacing possibly freed or other garbage values).
-----------------------------------------------------------------------
Summary of changes:
pp_hot.c | 35 +++++++++++++++++++++++++++--------
t/op/hashassign.t | 6 ++++--
2 files changed, 31 insertions(+), 10 deletions(-)
diff --git a/pp_hot.c b/pp_hot.c
index daaed7a..031c2cf 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1061,6 +1061,7 @@ PP(pp_aassign)
break;
case SVt_PVHV: { /* normal hash */
SV *tmpstr;
+ SV** topelem = relem;
hash = MUTABLE_HV(sv);
magic = SvMAGICAL(hash) != 0;
@@ -1074,10 +1075,19 @@ PP(pp_aassign)
tmpstr = newSV(0);
if (*relem)
sv_setsv(tmpstr,*relem); /* value */
- *(relem++) = tmpstr;
- if (gimme != G_VOID && hv_exists_ent(hash, sv, 0))
- /* key overwrites an existing entry */
- duplicates += 2;
+ relem++;
+ if (gimme != G_VOID) {
+ if (hv_exists_ent(hash, sv, 0))
+ /* key overwrites an existing entry */
+ duplicates += 2;
+ else
+ if (gimme == G_ARRAY) {
+ /* copy element back: possibly to an earlier
+ * stack location if we encountered dups earlier */
+ *topelem++ = sv;
+ *topelem++ = tmpstr;
+ }
+ }
didstore = hv_store_ent(hash,sv,tmpstr,0);
if (magic) {
if (SvSMAGICAL(tmpstr))
@@ -1190,11 +1200,20 @@ PP(pp_aassign)
SP = lastrelem;
else if (hash) {
if (duplicates) {
- /* Removes from the stack the entries which ended up as
- * duplicated keys in the hash (fix for [perl #24380]) */
- Move(firsthashrelem + duplicates,
- firsthashrelem, duplicates, SV**);
+ /* at this point we have removed the duplicate key/value
+ * pairs from the stack, but the remaining values may be
+ * wrong; i.e. with (a 1 a 2 b 3) on the stack we've removed
+ * the (a 2), but the stack now probably contains
+ * (a <freed> b 3), because { hv_save(a,1); hv_save(a,2) }
+ * obliterates the earlier key. So refresh all values. */
lastrelem -= duplicates;
+ relem = firsthashrelem;
+ while (relem < lastrelem) {
+ HE *he;
+ sv = *relem++;
+ he = hv_fetch_ent(hash, sv, 0, 0);
+ *relem++ = (he ? HeVAL(he) : &PL_sv_undef);
+ }
}
SP = lastrelem;
}
diff --git a/t/op/hashassign.t b/t/op/hashassign.t
index 92ea5ca..db0cf92 100644
--- a/t/op/hashassign.t
+++ b/t/op/hashassign.t
@@ -8,7 +8,7 @@ BEGIN {
# use strict;
-plan tests => 217;
+plan tests => 218;
my @comma = ("key", "value");
@@ -273,11 +273,13 @@ foreach my $chr (60, 200, 600, 6000, 60000) {
}
# now some tests for hash assignment in scalar and list context with
-# duplicate keys [perl #24380]
+# duplicate keys [perl #24380], [perl #31865]
{
my %h; my $x; my $ar;
is( (join ':', %h = (1) x 8), '1:1',
'hash assignment in list context removes duplicates' );
+ is( (join ':', %h = qw(a 1 a 2 b 3 c 4 d 5 d 6)), 'a:2:b:3:c:4:d:6',
+ 'hash assignment in list context removes duplicates 2' );
is( scalar( %h = (1,2,1,3,1,4,1,5) ), 2,
'hash assignment in scalar context' );
is( scalar( ($x,%h) = (0,1,2,1,3,1,4,1,5) ), 3,
--
Perl5 Master Repository
