X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_ctl.c;h=7920e514930ec0d0a45821da6ece3adadcbe4315;hb=ac1d45ba28d946eab50fa4af2a48e56aa1122da1;hp=999b2ccc6736a30f94c024de6d425043073c4fa5;hpb=bbce6d69784bf43b0e69e8d312042d65f258af23;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pp_ctl.c b/pp_ctl.c index 999b2cc..7920e51 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -1,6 +1,6 @@ /* pp_ctl.c * - * Copyright (c) 1991-1994, Larry Wall + * Copyright (c) 1991-1997, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -23,6 +23,9 @@ #define WORD_ALIGN sizeof(U16) #endif +#define DOCATCH(o) ((CATCH_GET == TRUE) ? docatch(o) : (o)) + +static OP *docatch _((OP *o)); static OP *doeval _((int gimme)); static OP *dofindlabel _((OP *op, char *label, OP **opstack)); static void doparseform _((SV *sv)); @@ -47,10 +50,14 @@ PP(pp_wantarray) if (cxix < 0) RETPUSHUNDEF; - if (cxstack[cxix].blk_gimme == G_ARRAY) + switch (cxstack[cxix].blk_gimme) { + case G_ARRAY: RETPUSHYES; - else + case G_SCALAR: RETPUSHNO; + default: + RETPUSHUNDEF; + } } PP(pp_regcmaybe) @@ -109,6 +116,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); @@ -121,6 +130,8 @@ PP(pp_substcont) SV *targ = cx->sb_targ; sv_catpvn(dstr, s, cx->sb_strend - s); + TAINT_IF(cx->sb_rxtainted || rx->exec_tainted); + (void)SvOOK_off(targ); Safefree(SvPVX(targ)); SvPVX(targ) = SvPVX(dstr); @@ -131,6 +142,7 @@ PP(pp_substcont) (void)SvPOK_only(targ); SvSETMAGIC(targ); + SvTAINT(targ); PUSHs(sv_2mortal(newSViv((I32)cx->sb_iters - 1))); LEAVE_SCOPE(cx->sb_oldsave); POPSUBST(cx); @@ -148,6 +160,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 +391,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 { @@ -453,7 +466,7 @@ PP(pp_grepstart) if (stack_base + *markstack_ptr == sp) { (void)POPMARK; - if (GIMME != G_ARRAY) + if (GIMME_V == G_SCALAR) XPUSHs(&sv_no); RETURNOP(op->op_next->op_next); } @@ -516,6 +529,7 @@ PP(pp_mapwhile) /* All done yet? */ if (markstack_ptr[-1] > *markstack_ptr) { I32 items; + I32 gimme = GIMME_V; (void)POPMARK; /* pop top */ LEAVE; /* exit outer scope */ @@ -523,12 +537,12 @@ PP(pp_mapwhile) items = --*markstack_ptr - markstack_ptr[-1]; (void)POPMARK; /* pop dst */ SP = stack_base + POPMARK; /* pop original mark */ - if (GIMME != G_ARRAY) { + if (gimme == G_SCALAR) { dTARGET; XPUSHi(items); - RETURN; } - SP += items; + else if (gimme == G_ARRAY) + SP += items; RETURN; } else { @@ -607,10 +621,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++; } } @@ -620,6 +633,7 @@ PP(pp_sort) AV *oldstack; CONTEXT *cx; SV** newsp; + bool oldcatch = CATCH_GET; SAVETMPS; SAVESPTR(op); @@ -630,6 +644,7 @@ PP(pp_sort) AvREAL_off(sortstack); av_extend(sortstack, 32); } + CATCH_SET(TRUE); SWITCHSTACK(curstack, sortstack); if (sortstash != stash) { firstgv = gv_fetchpv("a", TRUE, SVt_PV); @@ -639,13 +654,14 @@ PP(pp_sort) SAVESPTR(GvSV(firstgv)); SAVESPTR(GvSV(secondgv)); - PUSHBLOCK(cx, CXt_LOOP, stack_base); + PUSHBLOCK(cx, CXt_NULL, stack_base); sortcxix = cxstack_ix; qsort((char*)(myorigmark+1), max, sizeof(SV*), sortcv); POPBLOCK(cx,curpm); SWITCHSTACK(sortstack, oldstack); + CATCH_SET(oldcatch); } LEAVE; } @@ -780,14 +796,18 @@ char *label; if (dowarn) warn("Exiting eval via %s", op_name[op->op_type]); break; + case CXt_NULL: + if (dowarn) + warn("Exiting pseudo-block via %s", op_name[op->op_type]); + return -1; case CXt_LOOP: if (!cx->blk_loop.label || strNE(label, cx->blk_loop.label) ) { - DEBUG_l(deb("(Skipping label #%d %s)\n", - i, cx->blk_loop.label)); + DEBUG_l(deb("(Skipping label #%ld %s)\n", + (long)i, cx->blk_loop.label)); continue; } - DEBUG_l( deb("(Found label #%d %s)\n", i, label)); + DEBUG_l( deb("(Found label #%ld %s)\n", (long)i, label)); return i; } } @@ -797,16 +817,29 @@ char *label; I32 dowantarray() { + I32 gimme = block_gimme(); + return (gimme == G_VOID) ? G_SCALAR : gimme; +} + +I32 +block_gimme() +{ I32 cxix; cxix = dopoptosub(cxstack_ix); if (cxix < 0) return G_SCALAR; - if (cxstack[cxix].blk_gimme == G_ARRAY) - return G_ARRAY; - else + switch (cxstack[cxix].blk_gimme) { + case G_VOID: + return G_VOID; + case G_SCALAR: return G_SCALAR; + case G_ARRAY: + return G_ARRAY; + default: + croak("panic: bad gimme: %d\n", cxstack[cxix].blk_gimme); + } } static I32 @@ -822,7 +855,7 @@ I32 startingblock; continue; case CXt_EVAL: case CXt_SUB: - DEBUG_l( deb("(Found sub #%d)\n", i)); + DEBUG_l( deb("(Found sub #%ld)\n", (long)i)); return i; } } @@ -841,7 +874,7 @@ I32 startingblock; default: continue; case CXt_EVAL: - DEBUG_l( deb("(Found eval #%d)\n", i)); + DEBUG_l( deb("(Found eval #%ld)\n", (long)i)); return i; } } @@ -859,7 +892,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) @@ -869,8 +902,12 @@ I32 startingblock; if (dowarn) warn("Exiting eval via %s", op_name[op->op_type]); break; + case CXt_NULL: + if (dowarn) + warn("Exiting pseudo-block via %s", op_name[op->op_type]); + return -1; case CXt_LOOP: - DEBUG_l( deb("(Found loop #%d)\n", i)); + DEBUG_l( deb("(Found loop #%ld)\n", (long)i)); return i; } } @@ -900,61 +937,13 @@ I32 cxix; case CXt_LOOP: POPLOOP(cx); break; + case CXt_NULL: case CXt_SUBST: break; } } } -#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; @@ -1012,21 +1001,8 @@ char *message; } PerlIO_printf(PerlIO_stderr(), "%s",message); PerlIO_flush(PerlIO_stderr()); - if (e_tmpname) { - if (e_fp) { - PerlIO_close(e_fp); - e_fp = Nullfp; - } - (void)UNLINK(e_tmpname); - Safefree(e_tmpname); - e_tmpname = Nullch; - } - statusvalue = SHIFTSTATUS(statusvalue); -#ifdef VMS - my_exit((U32)vaxc$errno?vaxc$errno:errno?errno:statusvalue?statusvalue:SS$_ABORT); -#else - my_exit((I32)((errno&255)?errno:((statusvalue&255)?statusvalue:255))); -#endif + my_failure_exit(); + /* NOTREACHED */ return 0; } @@ -1078,6 +1054,7 @@ PP(pp_caller) register I32 cxix = dopoptosub(cxstack_ix); register CONTEXT *cx; I32 dbcxix; + I32 gimme; SV *sv; I32 count = 0; @@ -1129,7 +1106,11 @@ PP(pp_caller) PUSHs(sv_2mortal(newSVpv("(eval)",0))); PUSHs(sv_2mortal(newSViv(0))); } - PUSHs(sv_2mortal(newSViv((I32)cx->blk_gimme))); + gimme = (I32)cx->blk_gimme; + if (gimme == G_VOID) + PUSHs(&sv_undef); + else + PUSHs(sv_2mortal(newSViv(gimme & G_ARRAY))); if (cx->cx_type == CXt_EVAL) { if (cx->blk_eval.old_op_type == OP_ENTEREVAL) { PUSHs(cx->blk_eval.cur_text); @@ -1169,8 +1150,8 @@ sortcv(a, b) const void *a; const void *b; { - SV **str1 = (SV **) a; - SV **str2 = (SV **) b; + SV * const *str1 = (SV * const *)a; + SV * const *str2 = (SV * const *)b; I32 oldsaveix = savestack_ix; I32 oldscopeix = scopestack_ix; I32 result; @@ -1196,7 +1177,7 @@ sortcmp(a, b) const void *a; const void *b; { - return sv_cmp(*(SV **)a, *(SV **)b); + return sv_cmp(*(SV * const *)a, *(SV * const *)b); } static int @@ -1204,7 +1185,7 @@ sortcmp_locale(a, b) const void *a; const void *b; { - return sv_cmp_locale(*(SV **)a, *(SV **)b); + return sv_cmp_locale(*(SV * const *)a, *(SV * const *)b); } PP(pp_reset) @@ -1281,7 +1262,7 @@ PP(pp_enteriter) { dSP; dMARK; register CONTEXT *cx; - I32 gimme = GIMME; + I32 gimme = GIMME_V; SV **svp; ENTER; @@ -1298,11 +1279,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; @@ -1316,7 +1294,7 @@ PP(pp_enterloop) { dSP; register CONTEXT *cx; - I32 gimme = GIMME; + I32 gimme = GIMME_V; ENTER; SAVETMPS; @@ -1332,6 +1310,7 @@ PP(pp_leaveloop) { dSP; register CONTEXT *cx; + struct block_loop cxloop; I32 gimme; SV **newsp; PMOP *newpm; @@ -1339,27 +1318,30 @@ PP(pp_leaveloop) POPBLOCK(cx,newpm); mark = newsp; - POPLOOP(cx); - if (gimme == G_SCALAR) { - if (op->op_private & OPpLEAVE_VOID) - ; - else { - if (mark < SP) - *++newsp = sv_mortalcopy(*SP); - else - *++newsp = &sv_undef; - } + POPLOOP1(cx); /* Delay POPLOOP2 until stack values are safe */ + + if (gimme == G_VOID) + ; /* do nothing */ + else if (gimme == G_SCALAR) { + if (mark < SP) + *++newsp = sv_mortalcopy(*SP); + else + *++newsp = &sv_undef; } else { while (mark < SP) *++newsp = sv_mortalcopy(*++mark); } - curpm = newpm; /* Don't pop $1 et al till now */ - sp = newsp; + SP = newsp; + PUTBACK; + + POPLOOP2(); /* Stack values are safe: release loop vars ... */ + curpm = newpm; /* ... and pop $1 et al */ + LEAVE; LEAVE; - RETURN; + return NORMAL; } PP(pp_return) @@ -1367,6 +1349,8 @@ PP(pp_return) dSP; dMARK; I32 cxix; register CONTEXT *cx; + struct block_sub cxsub; + bool popsub2 = FALSE; I32 gimme; SV **newsp; PMOP *newpm; @@ -1391,13 +1375,15 @@ PP(pp_return) POPBLOCK(cx,newpm); switch (cx->cx_type) { case CXt_SUB: - POPSUB(cx); + POPSUB1(cx); /* Delay POPSUB2 until stack values are safe */ + popsub2 = TRUE; break; case CXt_EVAL: POPEVAL(cx); if (optype == OP_REQUIRE && (MARK == SP || (gimme == G_SCALAR && !SvTRUE(*SP))) ) { + /* Unassume the success we assumed earlier. */ char *name = cx->blk_eval.old_name; (void)hv_delete(GvHVn(incgv), name, strlen(name), G_DISCARD); DIE("%s did not return a true value", name); @@ -1405,22 +1391,28 @@ PP(pp_return) break; default: DIE("panic: return"); - break; } if (gimme == G_SCALAR) { if (MARK < SP) - *++newsp = sv_mortalcopy(*SP); + *++newsp = (popsub2 && SvTEMP(*SP)) + ? *SP : sv_mortalcopy(*SP); else *++newsp = &sv_undef; } - else { - while (MARK < SP) - *++newsp = sv_mortalcopy(*++MARK); + else if (gimme == G_ARRAY) { + while (++MARK <= SP) + *++newsp = (popsub2 && SvTEMP(*MARK)) + ? *MARK : sv_mortalcopy(*MARK); } - curpm = newpm; /* Don't pop $1 et al till now */ stack_sp = newsp; + /* Stack values are safe: */ + if (popsub2) { + POPSUB2(); /* release CV and @_ ... */ + } + curpm = newpm; /* ... and pop $1 et al */ + LEAVE; return pop_return(); } @@ -1430,6 +1422,9 @@ PP(pp_last) dSP; I32 cxix; register CONTEXT *cx; + struct block_loop cxloop; + struct block_sub cxsub; + I32 pop2 = 0; I32 gimme; I32 optype; OP *nextop; @@ -1453,38 +1448,52 @@ PP(pp_last) POPBLOCK(cx,newpm); switch (cx->cx_type) { case CXt_LOOP: - POPLOOP(cx); - nextop = cx->blk_loop.last_op->op_next; - LEAVE; + POPLOOP1(cx); /* Delay POPLOOP2 until stack values are safe */ + pop2 = CXt_LOOP; + nextop = cxloop.last_op->op_next; break; - case CXt_EVAL: - POPEVAL(cx); + case CXt_SUB: + POPSUB1(cx); /* Delay POPSUB2 until stack values are safe */ + pop2 = CXt_SUB; nextop = pop_return(); break; - case CXt_SUB: - POPSUB(cx); + case CXt_EVAL: + POPEVAL(cx); nextop = pop_return(); break; default: DIE("panic: last"); - break; } if (gimme == G_SCALAR) { - if (mark < SP) - *++newsp = sv_mortalcopy(*SP); + if (MARK < SP) + *++newsp = ((pop2 == CXt_SUB) && SvTEMP(*SP)) + ? *SP : sv_mortalcopy(*SP); else *++newsp = &sv_undef; } - else { - while (mark < SP) - *++newsp = sv_mortalcopy(*++mark); + else if (gimme == G_ARRAY) { + while (++MARK <= SP) + *++newsp = ((pop2 == CXt_SUB) && SvTEMP(*MARK)) + ? *MARK : sv_mortalcopy(*MARK); } - curpm = newpm; /* Don't pop $1 et al till now */ - sp = newsp; + SP = newsp; + PUTBACK; + + /* Stack values are safe: */ + switch (pop2) { + case CXt_LOOP: + POPLOOP2(); /* release loop vars ... */ + LEAVE; + break; + case CXt_SUB: + POPSUB2(); /* release CV and @_ ... */ + break; + } + curpm = newpm; /* ... and pop $1 et al */ LEAVE; - RETURNOP(nextop); + return nextop; } PP(pp_next) @@ -1634,6 +1643,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 +1685,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 +1694,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 +1735,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 +1761,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)); } @@ -1797,11 +1809,12 @@ PP(pp_goto) else gotoprobe = main_root; break; + case CXt_NULL: + DIE("Can't \"goto\" outside a block"); default: if (ix) DIE("panic: goto"); - else - gotoprobe = main_root; + gotoprobe = main_root; break; } retop = dofindlabel(gotoprobe, label, enterops); @@ -1852,7 +1865,7 @@ PP(pp_goto) if (curstack == signalstack) { restartop = retop; - Siglongjmp(top_env, 3); + JMPENV_JUMP(3); } RETURNOP(retop); @@ -1865,8 +1878,13 @@ PP(pp_exit) if (MAXARG < 1) anum = 0; - else + else { anum = SvIVx(POPs); +#ifdef VMSISH_EXIT + if (anum == 1 && VMSISH_EXIT) + anum = 0; +#endif + } my_exit(anum); PUSHs(&sv_undef); RETURN; @@ -1941,12 +1959,52 @@ SV *sv; } static OP * +docatch(o) +OP *o; +{ + int ret; + int oldrunlevel = runlevel; + OP *oldop = op; + dJMPENV; + + op = o; +#ifdef DEBUGGING + assert(CATCH_GET == TRUE); + DEBUG_l(deb("(Setting up local jumplevel, runlevel = %d)\n", runlevel+1)); +#endif + switch ((ret = JMPENV_PUSH)) { + default: /* topmost level handles it */ + JMPENV_POP; + runlevel = oldrunlevel; + op = oldop; + JMPENV_JUMP(ret); + /* NOTREACHED */ + case 3: + if (!restartop) { + PerlIO_printf(PerlIO_stderr(), "panic: restartop\n"); + break; + } + op = restartop; + restartop = 0; + /* FALL THROUGH */ + case 0: + runops(); + break; + } + JMPENV_POP; + runlevel = oldrunlevel; + op = oldop; + return Nullop; +} + +static OP * doeval(gimme) int gimme; { dSP; OP *saveop = op; HV *newstash; + CV *caller; AV* comppadlist; in_eval = 1; @@ -1963,9 +2021,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 +2040,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 */ @@ -2032,7 +2096,9 @@ int gimme; rs = SvREFCNT_inc(nrs); compiling.cop_line = 0; SAVEFREEOP(eval_root); - if (gimme & G_ARRAY) + if (gimme & G_VOID) + scalarvoid(eval_root); + else if (gimme & G_ARRAY) list(eval_root); else scalar(eval_root); @@ -2040,10 +2106,8 @@ int gimme; DEBUG_x(dump_eval()); /* Register with debugger: */ - if (perldb && saveop->op_type == OP_REQUIRE) { CV *cv = perl_get_cv("DB::postponed", FALSE); - if (cv) { dSP; PUSHMARK(sp); @@ -2055,6 +2119,8 @@ int gimme; /* compiled okay, so do it */ + CvDEPTH(compcv) = 1; + SP = stack_base + POPMARK; /* pop original mark */ RETURNOP(eval_start); } @@ -2072,7 +2138,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); @@ -2176,7 +2242,7 @@ PP(pp_require) compiling.cop_line = 0; PUTBACK; - return doeval(G_SCALAR); + return DOCATCH(doeval(G_SCALAR)); } PP(pp_dofile) @@ -2189,7 +2255,7 @@ PP(pp_entereval) dSP; register CONTEXT *cx; dPOPss; - I32 gimme = GIMME, was = sub_generation; + I32 gimme = GIMME_V, was = sub_generation; char tmpbuf[32], *safestr; STRLEN len; OP *ret; @@ -2205,7 +2271,7 @@ PP(pp_entereval) /* switch to eval mode */ SAVESPTR(compiling.cop_filegv); - sprintf(tmpbuf, "_<(eval %d)", ++evalseq); + sprintf(tmpbuf, "_<(eval %lu)", (unsigned long)++evalseq); compiling.cop_filegv = gv_fetchfile(tmpbuf+2); compiling.cop_line = 1; /* XXX For Cs within BEGIN {} blocks, this ends up @@ -2231,7 +2297,7 @@ PP(pp_entereval) if (perldb && was != sub_generation) { /* Some subs defined here. */ strcpy(safestr, "_<(eval )"); /* Anything fake and short. */ } - return ret; + return DOCATCH(ret); } PP(pp_leaveeval) @@ -2250,23 +2316,20 @@ PP(pp_leaveeval) POPEVAL(cx); retop = pop_return(); - if (gimme == G_SCALAR) { - if (op->op_private & OPpLEAVE_VOID) - MARK = newsp; + if (gimme == G_VOID) + MARK = newsp; + else if (gimme == G_SCALAR) { + MARK = newsp + 1; + if (MARK <= SP) { + if (SvFLAGS(TOPs) & SVs_TEMP) + *MARK = TOPs; + else + *MARK = sv_mortalcopy(TOPs); + } else { - MARK = newsp + 1; - if (MARK <= SP) { - if (SvFLAGS(TOPs) & SVs_TEMP) - *MARK = TOPs; - else - *MARK = sv_mortalcopy(TOPs); - } - else { - MEXTEND(mark,0); - *MARK = &sv_undef; - } + MEXTEND(mark,0); + *MARK = &sv_undef; } - SP = MARK; } else { for (mark = newsp + 1; mark <= SP; mark++) @@ -2276,17 +2339,23 @@ PP(pp_leaveeval) } curpm = newpm; /* Don't pop $1 et al till now */ - if (optype == OP_REQUIRE && - !(gimme == G_SCALAR ? SvTRUE(*sp) : sp > newsp)) { - char *name = cx->blk_eval.old_name; +#ifdef DEBUGGING + assert(CvDEPTH(compcv) == 1); +#endif + CvDEPTH(compcv) = 0; + if (optype == OP_REQUIRE && + !(gimme == G_SCALAR ? SvTRUE(*sp) : sp > newsp)) + { /* Unassume the success we assumed earlier. */ + char *name = cx->blk_eval.old_name; (void)hv_delete(GvHVn(incgv), name, strlen(name), G_DISCARD); retop = die("%s did not return a true value", name); } lex_end(); LEAVE; + if (!(save_flags & OPf_SPECIAL)) sv_setpv(GvSV(errgv),""); @@ -2297,7 +2366,7 @@ PP(pp_entertry) { dSP; register CONTEXT *cx; - I32 gimme = GIMME; + I32 gimme = GIMME_V; ENTER; SAVETMPS; @@ -2309,7 +2378,8 @@ PP(pp_entertry) in_eval = 1; sv_setpv(GvSV(errgv),""); - RETURN; + PUTBACK; + return DOCATCH(op->op_next); } PP(pp_leavetry) @@ -2326,21 +2396,19 @@ PP(pp_leavetry) POPEVAL(cx); pop_return(); - if (gimme == G_SCALAR) { - if (op->op_private & OPpLEAVE_VOID) - MARK = newsp; + if (gimme == G_VOID) + SP = newsp; + else if (gimme == G_SCALAR) { + MARK = newsp + 1; + if (MARK <= SP) { + if (SvFLAGS(TOPs) & (SVs_PADTMP|SVs_TEMP)) + *MARK = TOPs; + else + *MARK = sv_mortalcopy(TOPs); + } else { - MARK = newsp + 1; - if (MARK <= SP) { - if (SvFLAGS(TOPs) & (SVs_PADTMP|SVs_TEMP)) - *MARK = TOPs; - else - *MARK = sv_mortalcopy(TOPs); - } - else { - MEXTEND(mark,0); - *MARK = &sv_undef; - } + MEXTEND(mark,0); + *MARK = &sv_undef; } SP = MARK; } @@ -2411,13 +2479,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) {