summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRafael Garcia-Suarez <rgarciasuarez@gmail.com>2003-11-13 18:55:37 +0000
committerRafael Garcia-Suarez <rgarciasuarez@gmail.com>2003-11-13 18:55:37 +0000
commitca65944e8ff8fff6e36ea7476ba807be16cfe2a9 (patch)
tree854c7a750e4e61d1b9844a003ba85cdb144270dd
parenta9d9270b1989803b2cc2c5f6d551fe8565bcc2d0 (diff)
downloadperl-ca65944e8ff8fff6e36ea7476ba807be16cfe2a9.tar.gz
Fix bug [perl #24380] : assigning to a hash in list
or scalar context yielded a wrong value if the list contained duplicated keys for the hash. This is fixed by counting the number of duplicate keys and trimming the stack by the corresponding number of items. p4raw-id: //depot/perl@21714
-rw-r--r--pp_hot.c22
-rw-r--r--t/op/hashassign.t20
2 files changed, 37 insertions, 5 deletions
diff --git a/pp_hot.c b/pp_hot.c
index 8f2f3e05cb..5f23bb3bf0 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -966,8 +966,11 @@ PP(pp_aassign)
HV *hash;
I32 i;
int magic;
+ int duplicates = 0;
+ SV **firsthashrelem;
PL_delaymagic = DM_DELAY; /* catch simultaneous items */
+ gimme = GIMME_V;
/* If there's a common identifier on both sides we have to take
* special care that assigning the identifier on the left doesn't
@@ -1021,6 +1024,7 @@ PP(pp_aassign)
hash = (HV*)sv;
magic = SvMAGICAL(hash) != 0;
hv_clear(hash);
+ firsthashrelem = relem;
while (relem < lastrelem) { /* gobble up all the rest */
HE *didstore;
@@ -1032,6 +1036,9 @@ PP(pp_aassign)
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;
didstore = hv_store_ent(hash,sv,tmpstr,0);
if (magic) {
if (SvSMAGICAL(tmpstr))
@@ -1132,17 +1139,26 @@ PP(pp_aassign)
}
PL_delaymagic = 0;
- gimme = GIMME_V;
if (gimme == G_VOID)
SP = firstrelem - 1;
else if (gimme == G_SCALAR) {
dTARGET;
SP = firstrelem;
- SETi(lastrelem - firstrelem + 1);
+ SETi(lastrelem - firstrelem + 1 - duplicates);
}
else {
- if (ary || hash)
+ if (ary)
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**);
+ lastrelem -= duplicates;
+ }
+ SP = lastrelem;
+ }
else
SP = firstrelem + (lastlelem - firstlelem);
lelem = firstlelem + (relem - firstrelem);
diff --git a/t/op/hashassign.t b/t/op/hashassign.t
index a1c66c38dc..7058d75df1 100644
--- a/t/op/hashassign.t
+++ b/t/op/hashassign.t
@@ -8,7 +8,7 @@ BEGIN {
# use strict;
-plan tests => 206;
+plan tests => 213;
my @comma = ("key", "value");
@@ -272,4 +272,20 @@ foreach my $chr (60, 200, 600, 6000, 60000) {
}
-
+# now some tests for hash assignment in scalar and list context with
+# duplicate keys [perl #24380]
+{
+ my %h; my $x; my $ar;
+ is( (join ':', %h = (1) x 8), '1:1',
+ 'hash assignment in list context removes duplicates' );
+ 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,
+ 'scalar + hash assignment in scalar context' );
+ $ar = [ %h = (1,2,1,3,1,4,1,5) ];
+ is( $#$ar, 1, 'hash assignment in list context' );
+ is( "@$ar", "1 5", '...gets the last values' );
+ $ar = [ ($x,%h) = (0,1,2,1,3,1,4,1,5) ];
+ is( $#$ar, 2, 'scalar + hash assignment in list context' );
+ is( "@$ar", "0 1 5", '...gets the last values' );
+}