diff options
| -rw-r--r-- | pp_ctl.c | 7 | ||||
| -rw-r--r-- | pp_hot.c | 9 | ||||
| -rw-r--r-- | t/op/gmagic.t | 14 |
3 files changed, 25 insertions, 5 deletions
@@ -2497,7 +2497,8 @@ PP(pp_return) if (MARK < SP) { if (popsub2) { if (cx->blk_sub.cv && CvDEPTH(cx->blk_sub.cv) > 1) { - if (SvTEMP(TOPs) && SvREFCNT(TOPs) == 1) { + if (SvTEMP(TOPs) && SvREFCNT(TOPs) == 1 + && !SvMAGICAL(TOPs)) { *++newsp = SvREFCNT_inc(*SP); FREETMPS; sv_2mortal(*newsp); @@ -2509,7 +2510,8 @@ PP(pp_return) SvREFCNT_dec(sv); } } - else if (SvTEMP(*SP) && SvREFCNT(*SP) == 1) { + else if (SvTEMP(*SP) && SvREFCNT(*SP) == 1 + && !SvMAGICAL(*SP)) { *++newsp = *SP; } else @@ -2524,6 +2526,7 @@ PP(pp_return) else if (gimme == G_ARRAY) { while (++MARK <= SP) { *++newsp = popsub2 && SvTEMP(*MARK) && SvREFCNT(*MARK) == 1 + && !SvGMAGICAL(*MARK) ? *MARK : sv_mortalcopy(*MARK); TAINT_NOT; /* Each item is independent */ } @@ -2492,7 +2492,8 @@ PP(pp_leavesub) MARK = newsp + 1; if (MARK <= SP) { if (cx->blk_sub.cv && CvDEPTH(cx->blk_sub.cv) > 1) { - if (SvTEMP(TOPs) && SvREFCNT(TOPs) == 1) { + if (SvTEMP(TOPs) && SvREFCNT(TOPs) == 1 + && !SvMAGICAL(TOPs)) { *MARK = SvREFCNT_inc(TOPs); FREETMPS; sv_2mortal(*MARK); @@ -2504,7 +2505,8 @@ PP(pp_leavesub) SvREFCNT_dec(sv); } } - else if (SvTEMP(TOPs) && SvREFCNT(TOPs) == 1) { + else if (SvTEMP(TOPs) && SvREFCNT(TOPs) == 1 + && !SvMAGICAL(TOPs)) { *MARK = TOPs; } else @@ -2518,7 +2520,8 @@ PP(pp_leavesub) } else if (gimme == G_ARRAY) { for (MARK = newsp + 1; MARK <= SP; MARK++) { - if (!SvTEMP(*MARK) || SvREFCNT(*MARK) != 1) { + if (!SvTEMP(*MARK) || SvREFCNT(*MARK) != 1 + || SvMAGICAL(*MARK)) { *MARK = sv_mortalcopy(*MARK); TAINT_NOT; /* Each item is independent */ } diff --git a/t/op/gmagic.t b/t/op/gmagic.t index 02ed53c305..96af298a46 100644 --- a/t/op/gmagic.t +++ b/t/op/gmagic.t @@ -166,6 +166,20 @@ ok($wgot == 0, 'a plain *foo causes no set-magic'); &$rsub; expected_tie_calls $tied_to, 1, 0, 'mortal magic var is explicitly returned in recursive autoviv context'; + + $tied_to = tie $_{elem}, "Tie::Monitor"; + my $x = \sub { delete $_{elem} }->(); + expected_tie_calls $tied_to, 1, 0, + 'mortal magic var is implicitly returned to refgen'; + is tied $$x, undef, + 'mortal magic var is copied when implicitly returned'; + + $tied_to = tie $_{elem}, "Tie::Monitor"; + $x = \sub { return delete $_{elem} }->(); + expected_tie_calls $tied_to, 1, 0, + 'mortal magic var is explicitly returned to refgen'; + is tied $$x, undef, + 'mortal magic var is copied when explicitly returned'; } done_testing(); |