ENTER; /* enter outer scope */
SAVETMPS;
- /* SAVE_DEFSV does *not* suffice here for USE_5005THREADS */
- SAVESPTR(DEFSV);
+ if (PL_op->op_private & OPpGREP_LEX)
+ SAVESPTR(PAD_SVl(PL_op->op_targ));
+ else
+ SAVE_DEFSV;
ENTER; /* enter inner scope */
SAVEVPTR(PL_curpm);
src = PL_stack_base[*PL_markstack_ptr];
SvTEMP_off(src);
- DEFSV = src;
+ if (PL_op->op_private & OPpGREP_LEX)
+ PAD_SVl(PL_op->op_targ) = src;
+ else
+ DEFSV = src;
PUTBACK;
if (PL_op->op_type == OP_MAPSTART)
}
/* copy the new items down to the destination list */
dst = PL_stack_base + (PL_markstack_ptr[-2] += items) - 1;
- while (items-- > 0)
- *dst-- = SvTEMP(TOPs) ? POPs : sv_mortalcopy(POPs);
+ if (gimme == G_ARRAY) {
+ while (items-- > 0)
+ *dst-- = SvTEMP(TOPs) ? POPs : sv_mortalcopy(POPs);
+ }
+ else {
+ /* scalar context: we don't care about which values map returns
+ * (we use undef here). And so we certainly don't want to do mortal
+ * copies of meaningless values. */
+ while (items-- > 0) {
+ POPs;
+ *dst-- = &PL_sv_undef;
+ }
+ }
}
LEAVE; /* exit inner scope */
(void)POPMARK; /* pop dst */
SP = PL_stack_base + POPMARK; /* pop original mark */
if (gimme == G_SCALAR) {
- dTARGET;
- XPUSHi(items);
+ if (PL_op->op_private & OPpGREP_LEX) {
+ SV* sv = sv_newmortal();
+ sv_setiv(sv, items);
+ PUSHs(sv);
+ }
+ else {
+ dTARGET;
+ XPUSHi(items);
+ }
}
else if (gimme == G_ARRAY)
SP += items;
/* set $_ to the new source item */
src = PL_stack_base[PL_markstack_ptr[-1]];
SvTEMP_off(src);
- DEFSV = src;
+ if (PL_op->op_private & OPpGREP_LEX)
+ PAD_SVl(PL_op->op_targ) = src;
+ else
+ DEFSV = src;
RETURNOP(cLOGOP->op_other);
}
PUSHBLOCK(cx, CXt_SUB, SP);
PUSHSUB_DB(cx);
CvDEPTH(cv)++;
- (void)SvREFCNT_inc(cv);
PAD_SET_CUR(CvPADLIST(cv),1);
RETURNOP(CvSTART(cv));
}
char *label;
int do_dump = (PL_op->op_type == OP_DUMP);
static char must_have_label[] = "goto must have label";
+ AV *oldav = Nullav;
label = 0;
if (PL_op->op_flags & OPf_STACKED) {
GvAV(PL_defgv) = cx->blk_sub.savearray;
/* abandon @_ if it got reified */
if (AvREAL(av)) {
- (void)sv_2mortal((SV*)av); /* delay until return */
+ oldav = av; /* delay until return */
av = newAV();
av_extend(av, items-1);
AvFLAGS(av) = AVf_REIFY;
/* Now do some callish stuff. */
SAVETMPS;
+ /* For reified @_, delay freeing till return from new sub */
+ if (oldav)
+ SAVEFREESV((SV*)oldav);
SAVEFREESV(cv); /* later, undo the 'avoid premature free' hack */
if (CvXSUB(cv)) {
#ifdef PERL_XSUB_OLDSTYLE
#else
SAVEVPTR(PL_op);
#endif
- PL_hints &= HINT_UTF8;
/* we get here either during compilation, or via pp_regcomp at runtime */
runtime = IN_PERL_RUNTIME;