From 1050723fecc0e27677c39fadbb97cb892dfd27d2 Mon Sep 17 00:00:00 2001
From: David Mitchell <davem@iabyn.com>
Date: Wed, 15 Feb 2017 15:58:24 +0000
Subject: [PATCH] avoid a leak in list assign from/to magic values

RT #130766

A leak in list assignment was introduced by v5.23.6-89-gbeb08a1 and
extended with v5.23.6-90-g5c1db56.

Basically the code in S_aassign_copy_common() which does a mark-and-sweep
looking for common vars by temporarily setting SVf_BREAK on LHS SVs then
seeing if that flag was present on RHS vars, very temporarily removed that
flag from the RHS SV while mortal copying it, then set it again. After
those two commits, the "resetting" code could set SVf_BREAK on the RHS SV
even when it hadn't been been present earlier.

This meant that on exit from S_aassign_copy_common(), some SVs could be
left with SVf_BREAK on. When that SV was freed, the SVf_BREAK flag meant
that the SV head wasn't planted back in the arena (but PL_sv_count was
still decremented). This could lead to slow growth of the SV HEAD arenas.

The two circumstances that could trigger the leak were:

1) An SMG var on the LHS and a temporary on the RHS, e.g.

    use Tie::Scalar;
    my ($s, $t);
    tie $s, 'Tie::StdScalar'; # $s has set magic
    while (1) {
        ($s, $t) = ($t, map 1, 1, 2); # the map returns temporaries
    }

2) A temporary on the RHS which has GMG, e.g.

    my $s = "abc";
    pos($s) = 1;
    local our ($x, $y);
    while (1) {
        my $pr = \pos($s); # creates a ref to a TEMP with get magic
        ($x, $y) = (1, $$pr);
    }

Strictly speaking a TEMP isn't required for either case; just a situation
where there's always a fresh SV on the RHS for each iteration that will
soon get freed and thus leaked.

This commit doesn't include any tests since I can't think of a way of
testing it. svleak.t relies on PL_sv_count, which in this case doesn't
show the leak.
---
 pp_hot.c | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/pp_hot.c b/pp_hot.c
index a3ee2a7..7d6db0f 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1182,6 +1182,7 @@ S_aassign_copy_common(pTHX_ SV **firstlelem, SV **lastlelem,
         assert(svr);
 
         if (UNLIKELY(SvFLAGS(svr) & (SVf_BREAK|SVs_GMG) || copy_all)) {
+            U32 brk = (SvFLAGS(svr) & SVf_BREAK);
 
 #ifdef DEBUGGING
             if (fake) {
@@ -1217,7 +1218,7 @@ S_aassign_copy_common(pTHX_ SV **firstlelem, SV **lastlelem,
             /* ... but restore afterwards in case it's needed again,
              * e.g. ($a,$b,$c) = (1,$a,$a)
              */
-            SvFLAGS(svr) |= SVf_BREAK;
+            SvFLAGS(svr) |= brk;
         }
 
         if (!lcount)
-- 
1.8.3.1