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 (file)
--- 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 (file)
--- 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