Navigation Menu

Skip to content

Commit

Permalink
Avoid leak in multiconcat with overloading.
Browse files Browse the repository at this point in the history
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.
  • Loading branch information
iabyn committed Feb 5, 2019
1 parent 1387476 commit 4e521aa
Show file tree
Hide file tree
Showing 2 changed files with 29 additions and 5 deletions.
21 changes: 20 additions & 1 deletion lib/overload.t
Expand Up @@ -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);

Expand Down Expand Up @@ -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");
}
13 changes: 9 additions & 4 deletions pp_hot.c
Expand Up @@ -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;
}
Expand Down

0 comments on commit 4e521aa

Please sign in to comment.