X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_ctl.c;h=52fcf96016ee0136a12fe2cc1a7aaed60626b2ef;hb=181ea953f5037d8eebef8af5f5ba67f9ff02a565;hp=7fcdf3de51bd62a5956018f07e43afca77680793;hpb=e8f7dd13f8ad36b160a674831b76d23cb33bfe5a;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pp_ctl.c b/pp_ctl.c index 7fcdf3d..52fcf96 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -41,6 +41,12 @@ static void save_lines _((AV *array, SV *sv)); static I32 sortcv _((SV *a, SV *b)); static void qsortsv _((SV **array, size_t num_elts, I32 (*fun)(SV *a, SV *b))); static OP *doeval _((int gimme, OP** startop)); +static I32 sv_ncmp _((SV *a, SV *b)); +static I32 sv_i_ncmp _((SV *a, SV *b)); +static I32 amagic_ncmp _((SV *a, SV *b)); +static I32 amagic_i_ncmp _((SV *a, SV *b)); +static I32 amagic_cmp _((SV *str1, SV *str2)); +static I32 amagic_cmp_locale _((SV *str1, SV *str2)); #endif PP(pp_wantarray) @@ -162,8 +168,10 @@ PP(pp_substcont) /* Are we done */ if (cx->sb_once || !CALLREGEXEC(rx, s, cx->sb_strend, orig, - s == m, Nullsv, NULL, - cx->sb_safebase ? 0 : REXEC_COPY_STR)) + s == m, cx->sb_targ, NULL, + ((cx->sb_rflags & REXEC_COPY_STR) + ? REXEC_IGNOREPOS + : (REXEC_COPY_STR|REXEC_IGNOREPOS)))) { SV *targ = cx->sb_targ; sv_catpvn(dstr, s, cx->sb_strend - s); @@ -615,7 +623,13 @@ PP(pp_formline) break; case FF_MORE: - if (itemsize) { + s = chophere; + send = item + len; + if (chopspace) { + while (*s && isSPACE(*s) && s < send) + s++; + } + if (s < send) { arg = fieldsize - itemsize; if (arg) { fieldsize -= arg; @@ -660,12 +674,8 @@ PP(pp_grepstart) ENTER; /* enter outer scope */ SAVETMPS; -#ifdef USE_THREADS - /* SAVE_DEFSV does *not* suffice here */ - save_sptr(&THREADSV(0)); -#else - SAVESPTR(GvSV(PL_defgv)); -#endif /* USE_THREADS */ + /* SAVE_DEFSV does *not* suffice here for USE_THREADS */ + SAVESPTR(DEFSV); ENTER; /* enter inner scope */ SAVESPTR(PL_curpm); @@ -747,6 +757,119 @@ PP(pp_mapwhile) } } +STATIC I32 +sv_ncmp (SV *a, SV *b) +{ + double nv1 = SvNV(a); + double nv2 = SvNV(b); + return nv1 < nv2 ? -1 : nv1 > nv2 ? 1 : 0; +} +STATIC I32 +sv_i_ncmp (SV *a, SV *b) +{ + IV iv1 = SvIV(a); + IV iv2 = SvIV(b); + return iv1 < iv2 ? -1 : iv1 > iv2 ? 1 : 0; +} +#define tryCALL_AMAGICbin(left,right,meth,svp) STMT_START { \ + *svp = Nullsv; \ + if (PL_amagic_generation) { \ + if (SvAMAGIC(left)||SvAMAGIC(right))\ + *svp = amagic_call(left, \ + right, \ + CAT2(meth,_amg), \ + 0); \ + } \ + } STMT_END + +STATIC I32 +amagic_ncmp(register SV *a, register SV *b) +{ + SV *tmpsv; + tryCALL_AMAGICbin(a,b,ncmp,&tmpsv); + if (tmpsv) { + double d; + + if (SvIOK(tmpsv)) { + I32 i = SvIVX(tmpsv); + if (i > 0) + return 1; + return i? -1 : 0; + } + d = SvNV(tmpsv); + if (d > 0) + return 1; + return d? -1 : 0; + } + return sv_ncmp(a, b); +} + +STATIC I32 +amagic_i_ncmp(register SV *a, register SV *b) +{ + SV *tmpsv; + tryCALL_AMAGICbin(a,b,ncmp,&tmpsv); + if (tmpsv) { + double d; + + if (SvIOK(tmpsv)) { + I32 i = SvIVX(tmpsv); + if (i > 0) + return 1; + return i? -1 : 0; + } + d = SvNV(tmpsv); + if (d > 0) + return 1; + return d? -1 : 0; + } + return sv_i_ncmp(a, b); +} + +STATIC I32 +amagic_cmp(register SV *str1, register SV *str2) +{ + SV *tmpsv; + tryCALL_AMAGICbin(str1,str2,scmp,&tmpsv); + if (tmpsv) { + double d; + + if (SvIOK(tmpsv)) { + I32 i = SvIVX(tmpsv); + if (i > 0) + return 1; + return i? -1 : 0; + } + d = SvNV(tmpsv); + if (d > 0) + return 1; + return d? -1 : 0; + } + return sv_cmp(str1, str2); +} + +STATIC I32 +amagic_cmp_locale(register SV *str1, register SV *str2) +{ + SV *tmpsv; + tryCALL_AMAGICbin(str1,str2,scmp,&tmpsv); + if (tmpsv) { + double d; + + if (SvIOK(tmpsv)) { + I32 i = SvIVX(tmpsv); + if (i > 0) + return 1; + return i? -1 : 0; + } + d = SvNV(tmpsv); + if (d > 0) + return 1; + return d? -1 : 0; + } + return sv_cmp_locale(str1, str2); +} + PP(pp_sort) { djSP; dMARK; dORIGMARK; @@ -758,6 +881,7 @@ PP(pp_sort) CV *cv; I32 gimme = GIMME; OP* nextop = PL_op->op_next; + I32 overloading = 0; if (gimme != G_ARRAY) { SP = MARK; @@ -794,7 +918,7 @@ PP(pp_sort) } PL_sortcop = CvSTART(cv); SAVESPTR(CvROOT(cv)->op_ppaddr); - CvROOT(cv)->op_ppaddr = ppaddr[OP_NULL]; + CvROOT(cv)->op_ppaddr = PL_ppaddr[OP_NULL]; SAVESPTR(PL_curpad); PL_curpad = AvARRAY((AV*)AvARRAY(CvPADLIST(cv))[1]); @@ -810,8 +934,13 @@ PP(pp_sort) /*SUPPRESS 560*/ if (*up = *++MARK) { /* Weed out nulls. */ SvTEMP_off(*up); - if (!PL_sortcop && !SvPOK(*up)) - (void)sv_2pv(*up, &PL_na); + if (!PL_sortcop && !SvPOK(*up)) { + STRLEN n_a; + if (SvAMAGIC(*up)) + overloading = 1; + else + (void)sv_2pv(*up, &n_a); + } up++; } } @@ -849,6 +978,7 @@ PP(pp_sort) qsortsv((myorigmark+1), max, FUNC_NAME_TO_PTR(sortcv)); POPBLOCK(cx,PL_curpm); + PL_stack_sp = newsp; POPSTACK; CATCH_SET(oldcatch); } @@ -857,9 +987,30 @@ PP(pp_sort) if (max > 1) { MEXTEND(SP, 20); /* Can't afford stack realloc on signal. */ qsortsv(ORIGMARK+1, max, - (PL_op->op_private & OPpLOCALE) - ? FUNC_NAME_TO_PTR(sv_cmp_locale) - : FUNC_NAME_TO_PTR(sv_cmp)); + (PL_op->op_private & OPpSORT_NUMERIC) + ? ( (PL_op->op_private & OPpSORT_INTEGER) + ? ( overloading + ? FUNC_NAME_TO_PTR(amagic_i_ncmp) + : FUNC_NAME_TO_PTR(sv_i_ncmp)) + : ( overloading + ? FUNC_NAME_TO_PTR(amagic_ncmp) + : FUNC_NAME_TO_PTR(sv_ncmp))) + : ( (PL_op->op_private & OPpLOCALE) + ? ( overloading + ? FUNC_NAME_TO_PTR(amagic_cmp_locale) + : FUNC_NAME_TO_PTR(sv_cmp_locale)) + : ( overloading + ? FUNC_NAME_TO_PTR(amagic_cmp) + : FUNC_NAME_TO_PTR(sv_cmp) ))); + if (PL_op->op_private & OPpSORT_REVERSE) { + SV **p = ORIGMARK+1; + SV **q = ORIGMARK+max; + while (p < q) { + SV *tmp = *p; + *p++ = *q; + *q-- = tmp; + } + } } } LEAVE; @@ -914,33 +1065,41 @@ PP(pp_flop) if (GIMME == G_ARRAY) { dPOPPOPssrl; - register I32 i; + register I32 i, j; register SV *sv; I32 max; + if (SvGMAGICAL(left)) + mg_get(left); + if (SvGMAGICAL(right)) + mg_get(right); + if (SvNIOKp(left) || !SvPOKp(left) || (looks_like_number(left) && *SvPVX(left) != '0') ) { - if (SvNV(left) < IV_MIN || SvNV(right) >= IV_MAX) + if (SvNV(left) < IV_MIN || SvNV(right) > IV_MAX) croak("Range iterator outside integer range"); i = SvIV(left); max = SvIV(right); if (max >= i) { - EXTEND_MORTAL(max - i + 1); - EXTEND(SP, max - i + 1); + j = max - i + 1; + EXTEND_MORTAL(j); + EXTEND(SP, j); } - while (i <= max) { + else + j = 0; + while (j--) { sv = sv_2mortal(newSViv(i++)); PUSHs(sv); } } else { SV *final = sv_mortalcopy(right); - STRLEN len; + STRLEN len, n_a; char *tmps = SvPV(final, len); sv = sv_mortalcopy(left); - SvPV_force(sv,PL_na); + SvPV_force(sv,n_a); while (!SvNIOKp(sv) && SvCUR(sv) <= len) { XPUSHs(sv); if (strEQ(SvPVX(sv),tmps)) @@ -977,26 +1136,26 @@ dopoptolabel(char *label) for (i = cxstack_ix; i >= 0; i--) { cx = &cxstack[i]; - switch (cx->cx_type) { + switch (CxTYPE(cx)) { case CXt_SUBST: if (ckWARN(WARN_UNSAFE)) warner(WARN_UNSAFE, "Exiting substitution via %s", - op_name[PL_op->op_type]); + PL_op_name[PL_op->op_type]); break; case CXt_SUB: if (ckWARN(WARN_UNSAFE)) warner(WARN_UNSAFE, "Exiting subroutine via %s", - op_name[PL_op->op_type]); + PL_op_name[PL_op->op_type]); break; case CXt_EVAL: if (ckWARN(WARN_UNSAFE)) warner(WARN_UNSAFE, "Exiting eval via %s", - op_name[PL_op->op_type]); + PL_op_name[PL_op->op_type]); break; case CXt_NULL: if (ckWARN(WARN_UNSAFE)) warner(WARN_UNSAFE, "Exiting pseudo-block via %s", - op_name[PL_op->op_type]); + PL_op_name[PL_op->op_type]); return -1; case CXt_LOOP: if (!cx->blk_loop.label || @@ -1058,7 +1217,7 @@ dopoptosub_at(PERL_CONTEXT *cxstk, I32 startingblock) register PERL_CONTEXT *cx; for (i = startingblock; i >= 0; i--) { cx = &cxstk[i]; - switch (cx->cx_type) { + switch (CxTYPE(cx)) { default: continue; case CXt_EVAL: @@ -1078,7 +1237,7 @@ dopoptoeval(I32 startingblock) register PERL_CONTEXT *cx; for (i = startingblock; i >= 0; i--) { cx = &cxstack[i]; - switch (cx->cx_type) { + switch (CxTYPE(cx)) { default: continue; case CXt_EVAL: @@ -1097,26 +1256,26 @@ dopoptoloop(I32 startingblock) register PERL_CONTEXT *cx; for (i = startingblock; i >= 0; i--) { cx = &cxstack[i]; - switch (cx->cx_type) { + switch (CxTYPE(cx)) { case CXt_SUBST: if (ckWARN(WARN_UNSAFE)) warner(WARN_UNSAFE, "Exiting substitution via %s", - op_name[PL_op->op_type]); + PL_op_name[PL_op->op_type]); break; case CXt_SUB: if (ckWARN(WARN_UNSAFE)) warner(WARN_UNSAFE, "Exiting subroutine via %s", - op_name[PL_op->op_type]); + PL_op_name[PL_op->op_type]); break; case CXt_EVAL: if (ckWARN(WARN_UNSAFE)) warner(WARN_UNSAFE, "Exiting eval via %s", - op_name[PL_op->op_type]); + PL_op_name[PL_op->op_type]); break; case CXt_NULL: if (ckWARN(WARN_UNSAFE)) warner(WARN_UNSAFE, "Exiting pseudo-block via %s", - op_name[PL_op->op_type]); + PL_op_name[PL_op->op_type]); return -1; case CXt_LOOP: DEBUG_l( deb("(Found loop #%ld)\n", (long)i)); @@ -1137,9 +1296,9 @@ dounwind(I32 cxix) while (cxstack_ix > cxix) { cx = &cxstack[cxstack_ix]; DEBUG_l(PerlIO_printf(Perl_debug_log, "Unwinding block %ld, type %s\n", - (long) cxstack_ix, block_type[cx->cx_type])); + (long) cxstack_ix, PL_block_type[CxTYPE(cx)])); /* Note: we don't need to restore the base context info till the end. */ - switch (cx->cx_type) { + switch (CxTYPE(cx)) { case CXt_SUBST: POPSUBST(cx); continue; /* not break */ @@ -1163,6 +1322,7 @@ OP * die_where(char *message) { dSP; + STRLEN n_a; if (PL_in_eval) { I32 cxix; register PERL_CONTEXT *cx; @@ -1186,6 +1346,10 @@ die_where(char *message) SvGROW(err, SvCUR(err)+sizeof(prefix)+klen); sv_catpvn(err, prefix, sizeof(prefix)-1); sv_catpvn(err, message, klen); + if (ckWARN(WARN_UNSAFE)) { + STRLEN start = SvCUR(err)-klen-sizeof(prefix)+1; + warner(WARN_UNSAFE, SvPVX(err)+start); + } } sv_inc(*svp); } @@ -1194,7 +1358,7 @@ die_where(char *message) sv_setpv(ERRSV, message); } else - message = SvPVx(ERRSV, PL_na); + message = SvPVx(ERRSV, n_a); while ((cxix = dopoptoeval(cxstack_ix)) < 0 && PL_curstackinfo->si_prev) { dounwind(-1); @@ -1208,7 +1372,7 @@ die_where(char *message) dounwind(cxix); POPBLOCK(cx,PL_curpm); - if (cx->cx_type != CXt_EVAL) { + if (CxTYPE(cx) != CXt_EVAL) { PerlIO_printf(PerlIO_stderr(), "panic: die %s", message); my_exit(1); } @@ -1221,12 +1385,14 @@ die_where(char *message) LEAVE; if (optype == OP_REQUIRE) { - char* msg = SvPVx(ERRSV, PL_na); + char* msg = SvPVx(ERRSV, n_a); DIE("%s", *msg ? msg : "Compilation failed in require"); } return pop_return(); } } + if (!message) + message = SvPVx(ERRSV, n_a); PerlIO_printf(PerlIO_stderr(), "%s",message); PerlIO_flush(PerlIO_stderr()); my_failure_exit(); @@ -1298,7 +1464,7 @@ PP(pp_caller) } cx = &ccstack[cxix]; - if (ccstack[cxix].cx_type == CXt_SUB) { + if (CxTYPE(cx) == CXt_SUB) { dbcxix = dopoptosub_at(ccstack, cxix - 1); /* We expect that ccstack[dbcxix] is CXt_SUB, anyway, the field below is defined for any cx. */ @@ -1327,7 +1493,7 @@ PP(pp_caller) PUSHs(sv_2mortal(newSViv((I32)cx->blk_oldcop->cop_line))); if (!MAXARG) RETURN; - if (cx->cx_type == CXt_SUB) { /* So is ccstack[dbcxix]. */ + if (CxTYPE(cx) == CXt_SUB) { /* So is ccstack[dbcxix]. */ sv = NEWSV(49, 0); gv_efullname3(sv, CvGV(ccstack[cxix].blk_sub.cv), Nullch); PUSHs(sv_2mortal(sv)); @@ -1342,7 +1508,7 @@ PP(pp_caller) PUSHs(&PL_sv_undef); else PUSHs(sv_2mortal(newSViv(gimme & G_ARRAY))); - if (cx->cx_type == CXt_EVAL) { + if (CxTYPE(cx) == CXt_EVAL) { if (cx->blk_eval.old_op_type == OP_ENTEREVAL) { PUSHs(cx->blk_eval.cur_text); PUSHs(&PL_sv_no); @@ -1353,7 +1519,7 @@ PP(pp_caller) PUSHs(&PL_sv_yes); } } - else if (cx->cx_type == CXt_SUB && + else if (CxTYPE(cx) == CXt_SUB && cx->blk_sub.hasargs && PL_curcop->cop_stash == PL_debstash) { @@ -1404,11 +1570,12 @@ PP(pp_reset) { djSP; char *tmps; + STRLEN n_a; if (MAXARG < 1) tmps = ""; else - tmps = POPp; + tmps = POPpx; sv_reset(tmps, PL_curcop->cop_stash); PUSHs(&PL_sv_yes); RETURN; @@ -1481,8 +1648,12 @@ PP(pp_enteriter) SAVETMPS; #ifdef USE_THREADS - if (PL_op->op_flags & OPf_SPECIAL) - svp = save_threadsv(PL_op->op_targ); /* per-thread variable */ + if (PL_op->op_flags & OPf_SPECIAL) { + dTHR; + svp = &THREADSV(PL_op->op_targ); /* per-thread variable */ + SAVEGENERICSV(*svp); + *svp = NEWSV(0,0); + } else #endif /* USE_THREADS */ if (PL_op->op_targ) { @@ -1490,9 +1661,9 @@ PP(pp_enteriter) SAVESPTR(*svp); } else { - GV *gv = (GV*)POPs; - (void)save_scalar(gv); - svp = &GvSV(gv); /* symbol table variable */ + svp = &GvSV((GV*)POPs); /* symbol table variable */ + SAVEGENERICSV(*svp); + *svp = NEWSV(0,0); } ENTER; @@ -1610,7 +1781,7 @@ PP(pp_return) dounwind(cxix); POPBLOCK(cx,newpm); - switch (cx->cx_type) { + switch (CxTYPE(cx)) { case CXt_SUB: POPSUB1(cx); /* Delay POPSUB2 until stack values are safe */ popsub2 = TRUE; @@ -1698,7 +1869,7 @@ PP(pp_last) dounwind(cxix); POPBLOCK(cx,newpm); - switch (cx->cx_type) { + switch (CxTYPE(cx)) { case CXt_LOOP: POPLOOP1(cx); /* Delay POPLOOP2 until stack values are safe */ pop2 = CXt_LOOP; @@ -1860,10 +2031,12 @@ PP(pp_goto) OP *enterops[GOTO_DEPTH]; char *label; int do_dump = (PL_op->op_type == OP_DUMP); + static char must_have_label[] = "goto must have label"; label = 0; if (PL_op->op_flags & OPf_STACKED) { SV *sv = POPs; + STRLEN n_a; /* This egregious kludge implements goto &subroutine */ if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVCV) { @@ -1873,6 +2046,7 @@ PP(pp_goto) SV** mark; I32 items = 0; I32 oldsave; + int arg_was_real = 0; retry: if (!CvROOT(cv) && !CvXSUB(cv)) { @@ -1901,10 +2075,10 @@ PP(pp_goto) if (cxix < cxstack_ix) dounwind(cxix); TOPBLOCK(cx); - if (cx->cx_type == CXt_EVAL && cx->blk_eval.old_op_type == OP_ENTEREVAL) + if (CxTYPE(cx) == CXt_EVAL && cx->blk_eval.old_op_type == OP_ENTEREVAL) DIE("Can't goto subroutine from an eval-string"); mark = PL_stack_sp; - if (cx->cx_type == CXt_SUB && + if (CxTYPE(cx) == CXt_SUB && cx->blk_sub.hasargs) { /* put @_ back onto stack */ AV* av = cx->blk_sub.argarray; @@ -1917,7 +2091,10 @@ PP(pp_goto) SvREFCNT_dec(GvAV(PL_defgv)); GvAV(PL_defgv) = cx->blk_sub.savearray; #endif /* USE_THREADS */ - AvREAL_off(av); + if (AvREAL(av)) { + arg_was_real = 1; + AvREAL_off(av); /* so av_clear() won't clobber elts */ + } av_clear(av); } else if (CvXSUB(cv)) { /* put GvAV(defgv) back onto stack */ @@ -1934,7 +2111,7 @@ PP(pp_goto) Copy(AvARRAY(av), PL_stack_sp, items, SV*); PL_stack_sp += items; } - if (cx->cx_type == CXt_SUB && + if (CxTYPE(cx) == CXt_SUB && !(CvDEPTH(cx->blk_sub.cv) = cx->blk_sub.olddepth)) SvREFCNT_dec(cx->blk_sub.cv); oldsave = PL_scopestack[PL_scopestack_ix - 1]; @@ -1973,7 +2150,7 @@ PP(pp_goto) else { AV* padlist = CvPADLIST(cv); SV** svp = AvARRAY(padlist); - if (cx->cx_type == CXt_EVAL) { + if (CxTYPE(cx) == CXt_EVAL) { PL_in_eval = cx->blk_eval.old_in_eval; PL_eval_root = cx->blk_eval.old_eval_root; cx->cx_type = CXt_SUB; @@ -2073,7 +2250,11 @@ PP(pp_goto) } Copy(mark,AvARRAY(av),items,SV*); AvFILLp(av) = items - 1; - + /* preserve @_ nature */ + if (arg_was_real) { + AvREIFY_off(av); + AvREAL_on(av); + } while (items--) { if (*mark) SvTEMP_off(*mark); @@ -2104,12 +2285,15 @@ PP(pp_goto) RETURNOP(CvSTART(cv)); } } - else - label = SvPV(sv,PL_na); + else { + label = SvPV(sv,n_a); + if (!(do_dump || *label)) + DIE(must_have_label); + } } else if (PL_op->op_flags & OPf_SPECIAL) { if (! do_dump) - DIE("goto must have label"); + DIE(must_have_label); } else label = cPVOP->op_pv; @@ -2123,7 +2307,7 @@ PP(pp_goto) *enterops = 0; for (ix = cxstack_ix; ix >= 0; ix--) { cx = &cxstack[ix]; - switch (cx->cx_type) { + switch (CxTYPE(cx)) { case CXt_EVAL: gotoprobe = PL_eval_root; /* XXX not good for nested eval */ break; @@ -2204,11 +2388,6 @@ PP(pp_goto) PL_do_undump = FALSE; } - if (PL_top_env->je_prev) { - PL_restartop = retop; - JMPENV_JUMP(3); - } - RETURNOP(retop); } @@ -2259,7 +2438,8 @@ PP(pp_cswitch) if (PL_multiline) PL_op = PL_op->op_next; /* can't assume anything */ else { - match = *(SvPVx(GvSV(cCOP->cop_gv), PL_na)) & 255; + STRLEN n_a; + match = *(SvPVx(GvSV(cCOP->cop_gv), n_a)) & 255; match -= cCOP->uop.scop.scop_offset; if (match < 0) match = 0; @@ -2313,15 +2493,14 @@ docatch(OP *o) JMPENV_PUSH(ret); switch (ret) { default: /* topmost level handles it */ +pass_the_buck: JMPENV_POP; PL_op = oldop; JMPENV_JUMP(ret); /* NOTREACHED */ case 3: - if (!PL_restartop) { - PerlIO_printf(PerlIO_stderr(), "panic: restartop\n"); - break; - } + if (!PL_restartop) + goto pass_the_buck; PL_op = PL_restartop; PL_restartop = 0; /* FALL THROUGH */ @@ -2380,7 +2559,7 @@ sv_compile_2op(SV *sv, OP** startop, char *code, AV** avp) PL_hints = 0; PL_op = &dummy; - PL_op->op_type = 0; /* Avoid uninit warning. */ + PL_op->op_type = OP_ENTEREVAL; PL_op->op_flags = 0; /* Avoid uninit warning. */ PUSHBLOCK(cx, CXt_EVAL, SP); PUSHEVAL(cx, 0, PL_compiling.cop_filegv); @@ -2389,11 +2568,11 @@ sv_compile_2op(SV *sv, OP** startop, char *code, AV** avp) POPEVAL(cx); (*startop)->op_type = OP_NULL; - (*startop)->op_ppaddr = ppaddr[OP_NULL]; + (*startop)->op_ppaddr = PL_ppaddr[OP_NULL]; lex_end(); *avp = (AV*)SvREFCNT_inc(PL_comppad); LEAVE; - if (curcop = &PL_compiling) + if (PL_curcop == &PL_compiling) PL_compiling.op_private = PL_hints; #ifdef OP_IN_REGISTER op = PL_opsave; @@ -2427,11 +2606,11 @@ doeval(int gimme, OP** startop) SAVEI32(PL_max_intro_pending); caller = PL_compcv; - for (i = cxstack_ix; i >= 0; i--) { + for (i = cxstack_ix - 1; i >= 0; i--) { PERL_CONTEXT *cx = &cxstack[i]; - if (cx->cx_type == CXt_EVAL) + if (CxTYPE(cx) == CXt_EVAL) break; - else if (cx->cx_type == CXt_SUB) { + else if (CxTYPE(cx) == CXt_SUB) { caller = cx->blk_sub.cv; break; } @@ -2499,6 +2678,7 @@ doeval(int gimme, OP** startop) I32 gimme; PERL_CONTEXT *cx; I32 optype = 0; /* Might be reset by POPEVAL. */ + STRLEN n_a; PL_op = saveop; if (PL_eval_root) { @@ -2514,10 +2694,10 @@ doeval(int gimme, OP** startop) lex_end(); LEAVE; if (optype == OP_REQUIRE) { - char* msg = SvPVx(ERRSV, PL_na); + char* msg = SvPVx(ERRSV, n_a); DIE("%s", *msg ? msg : "Compilation failed in require"); } else if (startop) { - char* msg = SvPVx(ERRSV, PL_na); + char* msg = SvPVx(ERRSV, n_a); POPBLOCK(cx,PL_curpm); POPEVAL(cx); @@ -2590,13 +2770,14 @@ PP(pp_require) SV** svp; I32 gimme = G_SCALAR; PerlIO *tryrsfp = 0; + STRLEN n_a; sv = POPs; if (SvNIOKp(sv) && !SvPOKp(sv)) { SET_NUMERIC_STANDARD(); if (atof(PL_patchlevel) + 0.00000999 < SvNV(sv)) DIE("Perl %s required--this is only version %s, stopped", - SvPV(sv,PL_na),PL_patchlevel); + SvPV(sv,n_a),PL_patchlevel); RETPUSHYES; } name = SvPV(sv, len); @@ -2639,7 +2820,7 @@ PP(pp_require) { namesv = NEWSV(806, 0); for (i = 0; i <= AvFILL(ar); i++) { - char *dir = SvPVx(*av_fetch(ar, i, TRUE), PL_na); + char *dir = SvPVx(*av_fetch(ar, i, TRUE), n_a); #ifdef VMS char *unixdir; if ((unixdir = tounixpath(dir, Nullch)) == Nullch) @@ -2649,6 +2830,7 @@ PP(pp_require) #else sv_setpvf(namesv, "%s/%s", dir, name); #endif + TAINT_PROPER("require"); tryname = SvPVX(namesv); tryrsfp = PerlIO_open(tryname, PERL_SCRIPT_MODE); if (tryrsfp) { @@ -2674,7 +2856,7 @@ PP(pp_require) sv_catpv(msg, " (did you run h2ph?)"); sv_catpv(msg, " (@INC contains:"); for (i = 0; i <= AvFILL(ar); i++) { - char *dir = SvPVx(*av_fetch(ar, i, TRUE), PL_na); + char *dir = SvPVx(*av_fetch(ar, i, TRUE), n_a); sv_setpvf(dirmsgsv, " %s", dir); sv_catsv(msg, dirmsgsv); } @@ -2686,7 +2868,7 @@ PP(pp_require) RETPUSHUNDEF; } else - errno = 0; + SETERRNO(0, SS$_NORMAL); /* Assume success here to prevent recursive requirement. */ (void)hv_store(GvHVn(PL_incgv), name, strlen(name), @@ -2695,10 +2877,8 @@ PP(pp_require) ENTER; SAVETMPS; lex_start(sv_2mortal(newSVpv("",0))); - if (PL_rsfp_filters){ - save_aptr(&PL_rsfp_filters); - PL_rsfp_filters = NULL; - } + SAVEGENERICSV(PL_rsfp_filters); + PL_rsfp_filters = Nullav; PL_rsfp = tryrsfp; name = savepv(name); @@ -2769,7 +2949,7 @@ PP(pp_entereval) SAVEDELETE(PL_defstash, safestr, strlen(safestr)); SAVEHINTS(); PL_hints = PL_op->op_targ; - SAVEPPTR(compiling.cop_warnings); + SAVEPPTR(PL_compiling.cop_warnings); if (PL_compiling.cop_warnings != WARN_ALL && PL_compiling.cop_warnings != WARN_NONE){ PL_compiling.cop_warnings = newSVsv(PL_compiling.cop_warnings) ; @@ -2777,7 +2957,7 @@ PP(pp_entereval) } push_return(PL_op->op_next); - PUSHBLOCK(cx, CXt_EVAL, SP); + PUSHBLOCK(cx, (CXt_EVAL|CXp_REAL), SP); PUSHEVAL(cx, 0, PL_compiling.cop_filegv); /* prepare to compile string */