/* copy the new items down to the destination list */
dst = PL_stack_base + (PL_markstack_ptr[-2] += items) - 1;
if (gimme == G_ARRAY) {
- while (items-- > 0)
- *dst-- = SvTEMP(TOPs) ? POPs : sv_mortalcopy(POPs);
+ /* add returned items to the collection (making mortal copies
+ * if necessary), then clear the current temps stack frame
+ * *except* for those items. We do this splicing the items
+ * into the start of the tmps frame (so some items may be on
+ * the tmps stack twice), then moving PL_stack_floor above
+ * them, then freeing the frame. That way, the only tmps that
+ * accumulate over iterations are the return values for map.
+ * We have to do to this way so that everything gets correctly
+ * freed if we die during the map.
+ */
+ I32 tmpsbase;
+ I32 i = items;
+ /* make space for the slice */
+ EXTEND_MORTAL(items);
+ tmpsbase = PL_tmps_floor + 1;
+ Move(PL_tmps_stack + tmpsbase,
+ PL_tmps_stack + tmpsbase + items,
+ PL_tmps_ix - PL_tmps_floor,
+ SV*);
+ PL_tmps_ix += items;
+
+ while (i-- > 0) {
+ SV *sv = POPs;
+ if (!SvTEMP(sv))
+ sv = sv_mortalcopy(sv);
+ *dst-- = sv;
+ PL_tmps_stack[tmpsbase++] = SvREFCNT_inc_simple(sv);
+ }
+ /* clear the stack frame except for the items */
+ PL_tmps_floor += items;
+ FREETMPS;
+ /* FREETMPS may have cleared the TEMP flag on some of the items */
+ i = items;
+ while (i-- > 0)
+ SvTEMP_on(PL_tmps_stack[--tmpsbase]);
}
else {
/* scalar context: we don't care about which values map returns
(void)POPs;
*dst-- = &PL_sv_undef;
}
+ FREETMPS;
}
}
+ else {
+ FREETMPS;
+ }
LEAVE_with_name("grep_item"); /* exit inner scope */
/* All done yet? */
or skip_all("XS::APItest not available");
}
-plan tests => 5;
+plan tests => 17;
# run some code N times. If the number of SVs at the end of loop N is
# greater than (N-1)*delta at the end of loop 1, we've got a leak
# [perl #74484] repeated tries leaked SVs on the tmps stack
leak_expr(5, 0, q{"YYYYYa" =~ /.+?(a(.+?)|b)/ }, "trie leak");
+
+# [perl #48004] map/grep didn't free tmps till the end
+
+{
+ # qr/1/ just creates tmps that are hopefully freed per iteration
+
+ my $s;
+ my @a;
+ my @count = (0) x 4; # pre-allocate
+
+ grep qr/1/ && ($count[$_] = sv_count()) && 99, 0..3;
+ is(@count[3] - @count[0], 0, "void grep expr: no new tmps per iter");
+ grep { qr/1/ && ($count[$_] = sv_count()) && 99 } 0..3;
+ is(@count[3] - @count[0], 0, "void grep block: no new tmps per iter");
+
+ $s = grep qr/1/ && ($count[$_] = sv_count()) && 99, 0..3;
+ is(@count[3] - @count[0], 0, "scalar grep expr: no new tmps per iter");
+ $s = grep { qr/1/ && ($count[$_] = sv_count()) && 99 } 0..3;
+ is(@count[3] - @count[0], 0, "scalar grep block: no new tmps per iter");
+
+ @a = grep qr/1/ && ($count[$_] = sv_count()) && 99, 0..3;
+ is(@count[3] - @count[0], 0, "list grep expr: no new tmps per iter");
+ @a = grep { qr/1/ && ($count[$_] = sv_count()) && 99 } 0..3;
+ is(@count[3] - @count[0], 0, "list grep block: no new tmps per iter");
+
+
+ map qr/1/ && ($count[$_] = sv_count()) && 99, 0..3;
+ is(@count[3] - @count[0], 0, "void map expr: no new tmps per iter");
+ map { qr/1/ && ($count[$_] = sv_count()) && 99 } 0..3;
+ is(@count[3] - @count[0], 0, "void map block: no new tmps per iter");
+
+ $s = map qr/1/ && ($count[$_] = sv_count()) && 99, 0..3;
+ is(@count[3] - @count[0], 0, "scalar map expr: no new tmps per iter");
+ $s = map { qr/1/ && ($count[$_] = sv_count()) && 99 } 0..3;
+ is(@count[3] - @count[0], 0, "scalar map block: no new tmps per iter");
+
+ @a = map qr/1/ && ($count[$_] = sv_count()) && 99, 0..3;
+ is(@count[3] - @count[0], 3, "list map expr: one new tmp per iter");
+ @a = map { qr/1/ && ($count[$_] = sv_count()) && 99 } 0..3;
+ is(@count[3] - @count[0], 3, "list map block: one new tmp per iter");
+
+}