X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_ctl.c;h=58ab34ccda41c9af62f77ca9cb2f0e0734c4d848;hb=9f8d30d514938e706a878aae5fd5b902550604e2;hp=999b2ccc6736a30f94c024de6d425043073c4fa5;hpb=bbce6d69784bf43b0e69e8d312042d65f258af23;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pp_ctl.c b/pp_ctl.c index 999b2cc..58ab34c 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -109,6 +109,8 @@ PP(pp_substcont) if (cx->sb_iters > cx->sb_maxiters) DIE("Substitution loop"); + if (!cx->sb_rxtainted) + cx->sb_rxtainted = SvTAINTED(TOPs); sv_catsv(dstr, POPs); if (rx->subbase) Safefree(rx->subbase); @@ -131,6 +133,8 @@ PP(pp_substcont) (void)SvPOK_only(targ); SvSETMAGIC(targ); + if (cx->sb_rxtainted) + SvTAINTED_on(targ); PUSHs(sv_2mortal(newSViv((I32)cx->sb_iters - 1))); LEAVE_SCOPE(cx->sb_oldsave); POPSUBST(cx); @@ -148,6 +152,7 @@ PP(pp_substcont) sv_catpvn(dstr, s, m-s); cx->sb_s = rx->endp[0]; cx->sb_subbase = rx->subbase; + cx->sb_rxtainted |= rx->exec_tainted; rx->subbase = Nullch; /* so recursion works */ RETURNOP(pm->op_pmreplstart); @@ -378,7 +383,7 @@ PP(pp_formline) gotsome = TRUE; value = SvNV(sv); /* Formats aren't yet marked for locales, so assume "yes". */ - NUMERIC_LOCAL(); + SET_NUMERIC_LOCAL(); if (arg & 256) { sprintf(t, "%#*.*f", (int) fieldsize, (int) arg & 255, value); } else { @@ -607,10 +612,9 @@ PP(pp_sort) while (MARK < SP) { /* This may or may not shift down one here. */ /*SUPPRESS 560*/ if (*up = *++MARK) { /* Weed out nulls. */ - if (!SvPOK(*up)) + SvTEMP_off(*up); + if (!sortcop && !SvPOK(*up)) (void)sv_2pv(*up, &na); - else - SvTEMP_off(*up); up++; } } @@ -859,7 +863,7 @@ I32 startingblock; switch (cx->cx_type) { case CXt_SUBST: if (dowarn) - warn("Exiting substitition via %s", op_name[op->op_type]); + warn("Exiting substitution via %s", op_name[op->op_type]); break; case CXt_SUB: if (dowarn) @@ -906,55 +910,6 @@ I32 cxix; } } -#ifdef I_STDARG -OP * -die(char* pat, ...) -#else -/*VARARGS0*/ -OP * -die(pat, va_alist) - char *pat; - va_dcl -#endif -{ - va_list args; - char *message; - int oldrunlevel = runlevel; - int was_in_eval = in_eval; - HV *stash; - GV *gv; - CV *cv; - - /* We have to switch back to mainstack or die_where may try to pop - * the eval block from the wrong stack if die is being called from a - * signal handler. - dkindred@cs.cmu.edu */ - if (curstack != mainstack) { - dSP; - SWITCHSTACK(curstack, mainstack); - } -#ifdef I_STDARG - va_start(args, pat); -#else - va_start(args); -#endif - message = mess(pat, &args); - va_end(args); - if (diehook && (cv = sv_2cv(diehook, &stash, &gv, 0)) && !CvDEPTH(cv)) { - dSP; - - PUSHMARK(sp); - EXTEND(sp, 1); - PUSHs(sv_2mortal(newSVpv(message,0))); - PUTBACK; - perl_call_sv((SV*)cv, G_DISCARD); - message = mess(pat, &args); /* Static buffer could be reused. */ - } - restartop = die_where(message); - if ((!restartop && was_in_eval) || oldrunlevel > 1) - Siglongjmp(top_env, 3); - return restartop; -} - OP * die_where(message) char *message; @@ -1298,11 +1253,8 @@ PP(pp_enteriter) PUSHBLOCK(cx, CXt_LOOP, SP); PUSHLOOP(cx, svp, MARK); - if (op->op_flags & OPf_STACKED) { - AV* av = (AV*)POPs; - cx->blk_loop.iterary = av; - cx->blk_loop.iterix = -1; - } + if (op->op_flags & OPf_STACKED) + cx->blk_loop.iterary = (AV*)SvREFCNT_inc(POPs); else { cx->blk_loop.iterary = curstack; AvFILL(curstack) = sp - stack_base; @@ -1634,6 +1586,7 @@ PP(pp_goto) EXTEND(stack_sp, items); /* @_ could have been extended. */ Copy(AvARRAY(av), stack_sp, items, SV*); stack_sp += items; + SvREFCNT_dec(GvAV(defgv)); GvAV(defgv) = cx->blk_sub.savearray; AvREAL_off(av); av_clear(av); @@ -1675,8 +1628,7 @@ PP(pp_goto) (void)SvREFCNT_inc(cv); else { /* save temporaries on recursion? */ if (CvDEPTH(cv) == 100 && dowarn) - warn("Deep recursion on subroutine \"%s\"", - GvENAME(CvGV(cv))); + sub_crush_depth(cv); if (CvDEPTH(cv) > AvFILL(padlist)) { AV *newpad = newAV(); SV **oldpad = AvARRAY(svp[CvDEPTH(cv)-1]); @@ -1685,8 +1637,10 @@ PP(pp_goto) for ( ;ix > 0; ix--) { if (svp[ix] != &sv_undef) { char *name = SvPVX(svp[ix]); - if (SvFLAGS(svp[ix]) & SVf_FAKE) { - /* outer lexical? */ + if ((SvFLAGS(svp[ix]) & SVf_FAKE) + || *name == '&') + { + /* outer lexical or anon code */ av_store(newpad, ix, SvREFCNT_inc(oldpad[ix]) ); } @@ -1724,7 +1678,7 @@ PP(pp_goto) cx->blk_sub.savearray = GvAV(defgv); cx->blk_sub.argarray = av; - GvAV(defgv) = cx->blk_sub.argarray; + GvAV(defgv) = (AV*)SvREFCNT_inc(av); ++mark; if (items >= AvMAX(av) + 1) { @@ -1750,12 +1704,13 @@ PP(pp_goto) } } if (perldb && curstash != debstash) { - /* &xsub is not copying @_ */ + /* + * We do not care about using sv to call CV; + * it's for informational purposes only. + */ SV *sv = GvSV(DBsub); save_item(sv); gv_efullname3(sv, CvGV(cv), Nullch); - /* We do not care about using sv to call CV, - * just for info. */ } RETURNOP(CvSTART(cv)); } @@ -1947,6 +1902,7 @@ int gimme; dSP; OP *saveop = op; HV *newstash; + CV *caller; AV* comppadlist; in_eval = 1; @@ -1963,9 +1919,11 @@ int gimme; SAVEI32(min_intro_pending); SAVEI32(max_intro_pending); + caller = compcv; SAVESPTR(compcv); compcv = (CV*)NEWSV(1104,0); sv_upgrade((SV *)compcv, SVt_PVCV); + CvUNIQUE_on(compcv); comppad = newAV(); comppad_name = newAV(); @@ -1980,6 +1938,10 @@ int gimme; av_store(comppadlist, 0, (SV*)comppad_name); av_store(comppadlist, 1, (SV*)comppad); CvPADLIST(compcv) = comppadlist; + + if (saveop->op_type != OP_REQUIRE) + CvOUTSIDE(compcv) = (CV*)SvREFCNT_inc(caller); + SAVEFREESV(compcv); /* make sure we compile in the right package */ @@ -2072,7 +2034,7 @@ PP(pp_require) sv = POPs; if (SvNIOKp(sv) && !SvPOKp(sv)) { - NUMERIC_STANDARD(); + SET_NUMERIC_STANDARD(); if (atof(patchlevel) + 0.00000999 < SvNV(sv)) DIE("Perl %s required--this is only version %s, stopped", SvPV(sv,na),patchlevel); @@ -2411,13 +2373,12 @@ SV *sv; skipspaces++; arg -= skipspaces; if (arg) { - if (postspace) { + if (postspace) *fpc++ = FF_SPACE; - postspace = FALSE; - } *fpc++ = FF_LITERAL; *fpc++ = arg; } + postspace = FALSE; if (s <= send) skipspaces--; if (skipspaces) {