diff options
author | David Mitchell <davem@iabyn.com> | 2019-02-05 13:48:21 +0000 |
---|---|---|
committer | David Mitchell <davem@iabyn.com> | 2019-02-05 14:03:05 +0000 |
commit | 4e521aaf3ed717774455b3906bd5aa46bc397319 (patch) | |
tree | d438e31c4fdfa0b4a01e34bf704f992dba2f49f2 | |
parent | 13874762cb298e7f922df49e6c78fd3f2308d860 (diff) | |
download | perl-4e521aaf3ed717774455b3906bd5aa46bc397319.tar.gz |
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.
-rw-r--r-- | lib/overload.t | 21 | ||||
-rw-r--r-- | pp_hot.c | 13 |
2 files changed, 29 insertions, 5 deletions
diff --git a/lib/overload.t b/lib/overload.t index 055daab30f..5f2e0c2902 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"); +} @@ -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; } |