From 4e521aaf3ed717774455b3906bd5aa46bc397319 Mon Sep 17 00:00:00 2001
From: David Mitchell <davem@iabyn.com>
Date: Tue, 5 Feb 2019 13:48:21 +0000
Subject: [PATCH] Avoid leak in multiconcat with overloading.

RT #133789

In the path taken through pp_multiconcat() when one or more args have
side-effects such tieing or overloading, multiconcat has to decide
whether to just return the result of all the concatting as-is, or to
first assign it to an expression or variable if the op includes an
implicit assign (such as $lex = x.y.z or $a[0] = x.y.z).

The code was getting this right for those two cases, and was also
getting it right for the append cases ($lex .= x.y.z and $a[0] .= x.y.z),
which don't need assigns. But for the bare case (x.y.z) it was assigning
to the op's targ as well as returning the value. Hence leaking a
reference until destruction of the sub and its pad.

This commit stops the assign in that last case.
---
 lib/overload.t | 21 ++++++++++++++++++++-
 pp_hot.c       | 13 +++++++++----
 2 files changed, 29 insertions(+), 5 deletions(-)

diff --git a/lib/overload.t b/lib/overload.t
index 055daab30ff7..5f2e0c290211 100644
--- a/lib/overload.t
+++ b/lib/overload.t
@@ -48,7 +48,7 @@ package main;
 
 $| = 1;
 BEGIN { require './test.pl'; require './charset_tools.pl' }
-plan tests => 5362;
+plan tests => 5363;
 
 use Scalar::Util qw(tainted);
 
@@ -3174,3 +3174,22 @@ package Stringify {
         ::is $count, $stringify, $code;
     }
 }
+
+# RT #133789: in multiconcat with overload, the overloaded ref returned
+# from the overload method was being assigned to the pad targ, causing
+# a delay to the freeing of the object
+
+package RT33789 {
+    use overload
+        '.'  => sub { $_[0] }
+    ;
+
+    my $destroy = 0;
+    sub DESTROY { $destroy++ }
+
+    {
+        my $o = bless [];
+        my $result = '1' . ( '2' . ( '3' . ( '4' . ( '5' . $o ) ) ) );
+    }
+    ::is($destroy, 1, "RT #133789: delayed destroy");
+}
diff --git a/pp_hot.c b/pp_hot.c
index fd439a5e4b74..7c6b3a8fc989 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1097,15 +1097,20 @@ PP(pp_multiconcat)
 
         SP = toparg - stack_adj + 1;
 
-        /* Assign result of all RHS concats (left) to LHS (targ).
+        /* Return the result of all RHS concats, unless this op includes
+         * an assign ($lex = x.y.z or expr = x.y.z), in which case copy
+         * to target (which will be $lex or expr).
          * If we are appending, targ will already have been appended to in
          * the loop */
-        if (is_append)
-            SvTAINT(targ);
-        else {
+        if (  !is_append
+            && (   (PL_op->op_flags   & OPf_STACKED)
+                || (PL_op->op_private & OPpTARGET_MY))
+        ) {
             sv_setsv(targ, left);
             SvSETMAGIC(targ);
         }
+        else
+            targ = left;
         SETs(targ);
         RETURN;
     }