diff options
| author | Father Chrysostomos <sprout@cpan.org> | 2011-06-16 06:27:50 -0700 |
|---|---|---|
| committer | Father Chrysostomos <sprout@cpan.org> | 2011-06-16 20:17:52 -0700 |
| commit | 3ed94dc04bd73c956fbfa66348a55f94c8a2268b (patch) | |
| tree | 0b97f0066f7f723345414b177a96044984551633 /pp_ctl.c | |
| parent | ad37a74e7dc5e204efc84791373a791f142ac7b4 (diff) | |
| download | perl-3ed94dc04bd73c956fbfa66348a55f94c8a2268b.tar.gz | |
[perl #81944] Non-lvalue subs do not copy return values
return and leavesub see if they can cheat by not copying anything
marked TEMP, since presumably nothing else is using it. That means
the return values of delete() and shift() are not copied. Since @_
aliases to the caller’s variables, sometimes what is returned *is*
used elsewhere and still marked TEMP. So cases like sub { return
delete $_[0] } ->($x) end up returning $x unchanged, instead of
copying it.
As mentioned in the ticket, the solution is to copy only if the refer-
ence count is 1.
This also allows me to simplify the lvalue-returning code without
spreading this bug further. (pp_leavesublv currently avoids calling
sv_2mortal, in order not to set the TEMP flag.)
Diffstat (limited to 'pp_ctl.c')
| -rw-r--r-- | pp_ctl.c | 6 |
1 files changed, 3 insertions, 3 deletions
@@ -2352,7 +2352,7 @@ PP(pp_return) if (MARK < SP) { if (popsub2) { if (cx->blk_sub.cv && CvDEPTH(cx->blk_sub.cv) > 1) { - if (SvTEMP(TOPs)) { + if (SvTEMP(TOPs) && SvREFCNT(TOPs) == 1) { *++newsp = SvREFCNT_inc(*SP); FREETMPS; sv_2mortal(*newsp); @@ -2365,7 +2365,7 @@ PP(pp_return) if (gmagic) SvGETMAGIC(sv); } } - else if (SvTEMP(*SP)) { + else if (SvTEMP(*SP) && SvREFCNT(*SP) == 1) { *++newsp = *SP; if (gmagic) SvGETMAGIC(*SP); } @@ -2380,7 +2380,7 @@ PP(pp_return) } else if (gimme == G_ARRAY) { while (++MARK <= SP) { - *++newsp = popsub2 && SvTEMP(*MARK) + *++newsp = popsub2 && SvTEMP(*MARK) && SvREFCNT(*MARK) == 1 ? *MARK : sv_mortalcopy(*MARK); TAINT_NOT; /* Each item is independent */ } |