X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_ctl.c;h=ec21e69bb9c34b02c160225bb08bd59b9e7f6990;hb=7fddc82f0212c2b411408f0a05ebb86f9e431bd9;hp=fe6c9f665efaf048ab5ead38598f83110bd5afc6;hpb=a1b950687051c32e26de8681b0ed639ad32adfb4;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pp_ctl.c b/pp_ctl.c index fe6c9f6..ec21e69 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -1,7 +1,7 @@ /* pp_ctl.c * * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, - * 2000, 2001, 2002, 2003, by Larry Wall and others + * 2000, 2001, 2002, 2003, 2004, by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -863,14 +863,19 @@ PP(pp_grepstart) 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) @@ -934,8 +939,19 @@ PP(pp_mapwhile) } /* 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) { + (void)POPs; + *dst-- = &PL_sv_undef; + } + } } LEAVE; /* exit inner scope */ @@ -949,8 +965,15 @@ PP(pp_mapwhile) (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; @@ -965,7 +988,10 @@ PP(pp_mapwhile) /* 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); } @@ -1032,8 +1058,9 @@ PP(pp_flip) #define RANGE_IS_NUMERIC(left,right) ( \ SvNIOKp(left) || (SvOK(left) && !SvPOKp(left)) || \ SvNIOKp(right) || (SvOK(right) && !SvPOKp(right)) || \ - (looks_like_number(left) && SvPOKp(left) && *SvPVX(left) != '0' && \ - looks_like_number(right))) + (((!SvOK(left) && SvOK(right)) || ((!SvOK(left) || \ + looks_like_number(left)) && SvPOKp(left) && *SvPVX(left) != '0')) \ + && (!SvOK(right) || looks_like_number(right)))) PP(pp_flop) { @@ -1041,9 +1068,9 @@ PP(pp_flop) if (GIMME == G_ARRAY) { dPOPPOPssrl; - register I32 i, j; + register IV i, j; register SV *sv; - I32 max; + IV max; if (SvGMAGICAL(left)) mg_get(left); @@ -1051,7 +1078,8 @@ PP(pp_flop) mg_get(right); if (RANGE_IS_NUMERIC(left,right)) { - if (SvNV(left) < IV_MIN || SvNV(right) > IV_MAX) + if ((SvOK(left) && SvNV(left) < IV_MIN) || + (SvOK(right) && SvNV(right) > IV_MAX)) DIE(aTHX_ "Range iterator outside integer range"); i = SvIV(left); max = SvIV(right); @@ -1701,7 +1729,6 @@ PP(pp_dbstate) PUSHBLOCK(cx, CXt_SUB, SP); PUSHSUB_DB(cx); CvDEPTH(cv)++; - (void)SvREFCNT_inc(cv); PAD_SET_CUR(CvPADLIST(cv),1); RETURNOP(CvSTART(cv)); } @@ -1765,15 +1792,20 @@ PP(pp_enteriter) cx->blk_loop.iterary = (AV*)SvREFCNT_inc(POPs); if (SvTYPE(cx->blk_loop.iterary) != SVt_PVAV) { dPOPss; - if (RANGE_IS_NUMERIC(sv,(SV*)cx->blk_loop.iterary)) { - if (SvNV(sv) < IV_MIN || - SvNV((SV*)cx->blk_loop.iterary) >= IV_MAX) - DIE(aTHX_ "Range iterator outside integer range"); - cx->blk_loop.iterix = SvIV(sv); - cx->blk_loop.itermax = SvIV((SV*)cx->blk_loop.iterary); + SV *right = (SV*)cx->blk_loop.iterary; + if (RANGE_IS_NUMERIC(sv,right)) { + if ((SvOK(sv) && SvNV(sv) < IV_MIN) || + (SvOK(right) && SvNV(right) >= IV_MAX)) + DIE(aTHX_ "Range iterator outside integer range"); + cx->blk_loop.iterix = SvIV(sv); + cx->blk_loop.itermax = SvIV(right); } - else + else { + STRLEN n_a; cx->blk_loop.iterlval = newSVsv(sv); + (void) SvPV_force(cx->blk_loop.iterlval,n_a); + (void) SvPV(right,n_a); + } } } else { @@ -2090,6 +2122,7 @@ PP(pp_redo) TOPBLOCK(cx); oldsave = PL_scopestack[PL_scopestack_ix - 1]; LEAVE_SCOPE(oldsave); + FREETMPS; return cx->blk_loop.redo_op; } @@ -2157,6 +2190,7 @@ PP(pp_goto) 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) { @@ -2217,7 +2251,7 @@ PP(pp_goto) 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; @@ -2243,6 +2277,9 @@ PP(pp_goto) /* 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 @@ -2700,7 +2737,6 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, char *code, PAD** padp) #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;