From: Nicholas Clark <nick@ccl4.org>
Date: Sun, 2 May 2010 19:23:29 +0000 (+0100)
Subject: Better fix for RT #2140 (list assignment with duplicated temporaries)
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=61e5f455dc8214c9c23deb700f3fcf67b180afa5;p=p5sagit%2Fp5-mst-13.2.git

Better fix for RT #2140 (list assignment with duplicated temporaries)

4c8f17b905f2 (change 7867) took the approach of a special case in sv_setsv()
when PL_op indicated that the current OP was OP_AASSIGN. The problem is in one
part of pp_aassign, where it was using sv_mortalcopy() on values that were
correctly marked as temporaries, but also still needed later. Hence a more
targetted solution is to avoid that call, and to instead use API calls that
will not steal temporaries.
---

diff --git a/pp_hot.c b/pp_hot.c
index aa038d3..95a6822 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1004,7 +1004,17 @@ PP(pp_aassign)
 	for (relem = firstrelem; relem <= lastrelem; relem++) {
 	    if ((sv = *relem)) {
 		TAINT_NOT;	/* Each item is independent */
-		*relem = sv_mortalcopy(sv);
+
+		/* Dear TODO test in t/op/sort.t, I love you.
+		   (It's relying on a panic, not a "semi-panic" from newSVsv()
+		   and then an assertion failure below.)  */
+		if (SvIS_FREED(sv)) {
+		    Perl_croak(aTHX_ "panic: attempt to copy freed scalar %p",
+			       (void*)sv);
+		}
+		/* Specifically *not* sv_mortalcopy(), as that will steal TEMPs,
+		   and we need a second copy of a temp here.  */
+		*relem = sv_2mortal(newSVsv(sv));
 	    }
 	}
     }
diff --git a/sv.c b/sv.c
index a06b06c..782a300 100644
--- a/sv.c
+++ b/sv.c
@@ -4063,9 +4063,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV* sstr, const I32 flags)
 	         (!(flags & SV_NOSTEAL)) &&
 					/* and we're allowed to steal temps */
                  SvREFCNT(sstr) == 1 &&   /* and no other references to it? */
-                 SvLEN(sstr) 	&&	  /* and really is a string */
-	    			/* and won't be needed again, potentially */
-	      !(PL_op && PL_op->op_type == OP_AASSIGN))
+                 SvLEN(sstr))             /* and really is a string */
 #ifdef PERL_OLD_COPY_ON_WRITE
             && ((flags & SV_COW_SHARED_HASH_KEYS)
 		? (!((sflags & CAN_COW_MASK) == CAN_COW_FLAGS