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);
if (gmagic) SvGETMAGIC(sv);
}
}
- else if (SvTEMP(*SP)) {
+ else if (SvTEMP(*SP) && SvREFCNT(*SP) == 1) {
*++newsp = *SP;
if (gmagic) SvGETMAGIC(*SP);
}
}
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 */
}
MARK = newsp + 1;
if (MARK <= SP) {
if (cx->blk_sub.cv && CvDEPTH(cx->blk_sub.cv) > 1) {
- if (SvTEMP(TOPs)) {
+ if (SvTEMP(TOPs) && SvREFCNT(TOPs) == 1) {
*MARK = SvREFCNT_inc(TOPs);
FREETMPS;
sv_2mortal(*MARK);
SvREFCNT_dec(sv);
}
}
- else if (SvTEMP(TOPs)) {
+ else if (SvTEMP(TOPs) && SvREFCNT(TOPs) == 1) {
*MARK = TOPs;
if (gmagic) SvGETMAGIC(TOPs);
}
}
else if (gimme == G_ARRAY) {
for (MARK = newsp + 1; MARK <= SP; MARK++) {
- if (!SvTEMP(*MARK)) {
+ if (!SvTEMP(*MARK) || SvREFCNT(*MARK) != 1) {
*MARK = sv_mortalcopy(*MARK);
TAINT_NOT; /* Each item is independent */
}
require './test.pl';
}
-plan( tests => 8 );
+plan( tests => 14 );
sub empty_sub {}
push @a, 34, 35, &{$x == $x};
ok(eq_array(\@a, [34,35]), "yes without args");
}
+
+# [perl #81944] return should always copy
+{
+ $foo{bar} = 7;
+ for my $x ($foo{bar}) {
+ # Pity test.pl doesnt have isn't.
+ isnt \sub { delete $foo{bar} }->(), \$x,
+ 'result of delete(helem) is copied when returned';
+ }
+ $foo{bar} = 7;
+ for my $x ($foo{bar}) {
+ isnt \sub { return delete $foo{bar} }->(), \$x,
+ 'result of delete(helem) is copied when explicitly returned';
+ }
+ my $x;
+ isnt \sub { delete $_[0] }->($x), \$x,
+ 'result of delete(aelem) is copied when returned';
+ isnt \sub { return delete $_[0] }->($x), \$x,
+ 'result of delete(aelem) is copied when explicitly returned';
+ isnt \sub { ()=\@_; shift }->($x), \$x,
+ 'result of shift is copied when returned';
+ isnt \sub { ()=\@_; return shift }->($x), \$x,
+ 'result of shift is copied when explicitly returned';
+}