From: Rafael Garcia-Suarez <rgarciasuarez@gmail.com>
Date: Thu, 13 Nov 2003 18:55:37 +0000 (+0000)
Subject: Fix bug [perl #24380] : assigning to a hash in list
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ca65944e8ff8fff6e36ea7476ba807be16cfe2a9;p=p5sagit%2Fp5-mst-13.2.git

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
---

diff --git a/pp_hot.c b/pp_hot.c
index 8f2f3e0..5f23bb3 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 a1c66c3..7058d75 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' );
+}