X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_ctl.c;h=da0f7a03c26182789671aa9d0d73504b8805805f;hb=54fbcc6e8ef8d379545ca2bc110f2f19a7c73715;hp=81b42812788b7aa2529fa2866f3597b3764d9d69;hpb=045c1f128ac729dc76c4da7e8ffe34bf12692b94;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pp_ctl.c b/pp_ctl.c index 81b4281..da0f7a0 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -26,7 +26,7 @@ #define DOCATCH(o) ((CATCH_GET == TRUE) ? docatch(o) : (o)) #ifdef PERL_OBJECT -#define CALLOP this->*op +#define CALLOP this->*PL_op #else #define CALLOP *PL_op static OP *docatch _((OP *o)); @@ -287,6 +287,7 @@ PP(pp_formline) double value; bool gotsome; STRLEN len; + STRLEN fudge = SvCUR(tmpForm) * (IN_UTF8 ? 3 : 1) + 1; if (!SvMAGICAL(tmpForm) || !SvCOMPILED(tmpForm)) { SvREADONLY_off(tmpForm); @@ -294,7 +295,7 @@ PP(pp_formline) } SvPV_force(PL_formtarget, len); - t = SvGROW(PL_formtarget, len + SvCUR(tmpForm) + 1); /* XXX SvCUR bad */ + t = SvGROW(PL_formtarget, len + fudge + 1); /* XXX SvCUR bad */ t += len; f = SvPV(tmpForm, len); /* need to jump to the next word */ @@ -356,14 +357,38 @@ PP(pp_formline) sv = *++MARK; else { sv = &PL_sv_no; - if (PL_dowarn) - warn("Not enough format arguments"); + if (ckWARN(WARN_SYNTAX)) + warner(WARN_SYNTAX, "Not enough format arguments"); } break; case FF_CHECKNL: item = s = SvPV(sv, len); itemsize = len; + if (IN_UTF8) { + itemsize = sv_len_utf8(sv); + if (itemsize != len) { + I32 itembytes; + if (itemsize > fieldsize) { + itemsize = fieldsize; + itembytes = itemsize; + sv_pos_u2b(sv, &itembytes, 0); + } + else + itembytes = len; + send = chophere = s + itembytes; + while (s < send) { + if (*s & ~31) + gotsome = TRUE; + else if (*s == '\n') + break; + s++; + } + itemsize = s - item; + sv_pos_b2u(sv, &itemsize); + break; + } + } if (itemsize > fieldsize) itemsize = fieldsize; send = chophere = s + itemsize; @@ -380,6 +405,47 @@ PP(pp_formline) case FF_CHECKCHOP: item = s = SvPV(sv, len); itemsize = len; + if (IN_UTF8) { + itemsize = sv_len_utf8(sv); + if (itemsize != len) { + I32 itembytes; + if (itemsize <= fieldsize) { + send = chophere = s + itemsize; + while (s < send) { + if (*s == '\r') { + itemsize = s - item; + break; + } + if (*s++ & ~31) + gotsome = TRUE; + } + } + else { + itemsize = fieldsize; + itembytes = itemsize; + sv_pos_u2b(sv, &itembytes, 0); + send = chophere = s + itembytes; + while (s < send || (s == send && isSPACE(*s))) { + if (isSPACE(*s)) { + if (chopspace) + chophere = s; + if (*s == '\r') + break; + } + else { + if (*s & ~31) + gotsome = TRUE; + if (strchr(PL_chopset, *s)) + chophere = s + 1; + } + s++; + } + itemsize = chophere - item; + sv_pos_b2u(sv, &itemsize); + } + break; + } + } if (itemsize <= fieldsize) { send = chophere = s + itemsize; while (s < send) { @@ -435,16 +501,34 @@ PP(pp_formline) case FF_ITEM: arg = itemsize; s = item; + if (IN_UTF8) { + while (arg--) { + if (*s & 0x80) { + switch (UTF8SKIP(s)) { + case 7: *t++ = *s++; + case 6: *t++ = *s++; + case 5: *t++ = *s++; + case 4: *t++ = *s++; + case 3: *t++ = *s++; + case 2: *t++ = *s++; + case 1: *t++ = *s++; + } + } + else { + if ( !((*t++ = *s++) & ~31) ) + t[-1] = ' '; + } + } + break; + } while (arg--) { -#if 'z' - 'a' != 25 +#ifdef EBCDIC int ch = *t++ = *s++; - if (!iscntrl(ch)) - t[-1] = ' '; + if (iscntrl(ch)) #else if ( !((*t++ = *s++) & ~31) ) - t[-1] = ' '; #endif - + t[-1] = ' '; } break; @@ -473,7 +557,7 @@ PP(pp_formline) } SvCUR_set(PL_formtarget, t - SvPVX(PL_formtarget)); sv_catpvn(PL_formtarget, item, itemsize); - SvGROW(PL_formtarget, SvCUR(PL_formtarget) + SvCUR(tmpForm) + 1); + SvGROW(PL_formtarget, SvCUR(PL_formtarget) + fudge + 1); t = SvPVX(PL_formtarget) + SvCUR(PL_formtarget); } break; @@ -856,7 +940,7 @@ PP(pp_flop) char *tmps = SvPV(final, len); sv = sv_mortalcopy(left); - SvPV_force(sv,na); + SvPV_force(sv,PL_na); while (!SvNIOKp(sv) && SvCUR(sv) <= len) { XPUSHs(sv); if (strEQ(SvPVX(sv),tmps)) @@ -895,20 +979,24 @@ dopoptolabel(char *label) cx = &cxstack[i]; switch (cx->cx_type) { case CXt_SUBST: - if (PL_dowarn) - warn("Exiting substitution via %s", op_name[PL_op->op_type]); + if (ckWARN(WARN_UNSAFE)) + warner(WARN_UNSAFE, "Exiting substitution via %s", + op_name[PL_op->op_type]); break; case CXt_SUB: - if (PL_dowarn) - warn("Exiting subroutine via %s", op_name[PL_op->op_type]); + if (ckWARN(WARN_UNSAFE)) + warner(WARN_UNSAFE, "Exiting subroutine via %s", + op_name[PL_op->op_type]); break; case CXt_EVAL: - if (PL_dowarn) - warn("Exiting eval via %s", op_name[PL_op->op_type]); + if (ckWARN(WARN_UNSAFE)) + warner(WARN_UNSAFE, "Exiting eval via %s", + op_name[PL_op->op_type]); break; case CXt_NULL: - if (PL_dowarn) - warn("Exiting pseudo-block via %s", op_name[PL_op->op_type]); + if (ckWARN(WARN_UNSAFE)) + warner(WARN_UNSAFE, "Exiting pseudo-block via %s", + op_name[PL_op->op_type]); return -1; case CXt_LOOP: if (!cx->blk_loop.label || @@ -1011,20 +1099,24 @@ dopoptoloop(I32 startingblock) cx = &cxstack[i]; switch (cx->cx_type) { case CXt_SUBST: - if (PL_dowarn) - warn("Exiting substitution via %s", op_name[PL_op->op_type]); + if (ckWARN(WARN_UNSAFE)) + warner(WARN_UNSAFE, "Exiting substitution via %s", + op_name[PL_op->op_type]); break; case CXt_SUB: - if (PL_dowarn) - warn("Exiting subroutine via %s", op_name[PL_op->op_type]); + if (ckWARN(WARN_UNSAFE)) + warner(WARN_UNSAFE, "Exiting subroutine via %s", + op_name[PL_op->op_type]); break; case CXt_EVAL: - if (PL_dowarn) - warn("Exiting eval via %s", op_name[PL_op->op_type]); + if (ckWARN(WARN_UNSAFE)) + warner(WARN_UNSAFE, "Exiting eval via %s", + op_name[PL_op->op_type]); break; case CXt_NULL: - if (PL_dowarn) - warn("Exiting pseudo-block via %s", op_name[PL_op->op_type]); + if (ckWARN(WARN_UNSAFE)) + warner(WARN_UNSAFE, "Exiting pseudo-block via %s", + op_name[PL_op->op_type]); return -1; case CXt_LOOP: DEBUG_l( deb("(Found loop #%ld)\n", (long)i)); @@ -1882,7 +1974,7 @@ PP(pp_goto) if (CvDEPTH(cv) < 2) (void)SvREFCNT_inc(cv); else { /* save temporaries on recursion? */ - if (CvDEPTH(cv) == 100 && PL_dowarn) + if (CvDEPTH(cv) == 100 && ckWARN(WARN_RECURSION)) sub_crush_depth(cv); if (CvDEPTH(cv) > AvFILLp(padlist)) { AV *newpad = newAV(); @@ -2090,7 +2182,7 @@ PP(pp_goto) if (do_dump) { #ifdef VMS - if (!retop) retop = main_start; + if (!retop) retop = PL_main_start; #endif PL_restartop = retop; PL_do_undump = TRUE; @@ -2144,8 +2236,8 @@ PP(pp_nswitch) match = 0; else if (match > cCOP->uop.scop.scop_max) match = cCOP->uop.scop.scop_max; - op = cCOP->uop.scop.scop_next[match]; - RETURNOP(op); + PL_op = cCOP->uop.scop.scop_next[match]; + RETURNOP(PL_op); } PP(pp_cswitch) @@ -2153,18 +2245,18 @@ PP(pp_cswitch) djSP; register I32 match; - if (multiline) - op = op->op_next; /* can't assume anything */ + if (PL_multiline) + PL_op = PL_op->op_next; /* can't assume anything */ else { - match = *(SvPVx(GvSV(cCOP->cop_gv), na)) & 255; + match = *(SvPVx(GvSV(cCOP->cop_gv), PL_na)) & 255; match -= cCOP->uop.scop.scop_offset; if (match < 0) match = 0; else if (match > cCOP->uop.scop.scop_max) match = cCOP->uop.scop.scop_max; - op = cCOP->uop.scop.scop_next[match]; + PL_op = cCOP->uop.scop.scop_next[match]; } - RETURNOP(op); + RETURNOP(PL_op); } #endif @@ -2252,6 +2344,10 @@ sv_compile_2op(SV *sv, OP** startop, char *code, AV** avp) SAVETMPS; /* switch to eval mode */ + if (PL_curcop == &PL_compiling) { + SAVESPTR(PL_compiling.cop_stash); + PL_compiling.cop_stash = PL_curstash; + } SAVESPTR(PL_compiling.cop_filegv); SAVEI16(PL_compiling.cop_line); sprintf(tmpbuf, "_<(%.10s_eval %lu)", code, (unsigned long)++PL_evalseq); @@ -2266,7 +2362,7 @@ sv_compile_2op(SV *sv, OP** startop, char *code, AV** avp) SAVEDELETE(PL_defstash, safestr, strlen(safestr)); SAVEHINTS(); #ifdef OP_IN_REGISTER - opsave = op; + PL_opsave = op; #else SAVEPPTR(PL_op); #endif @@ -2276,7 +2372,7 @@ sv_compile_2op(SV *sv, OP** startop, char *code, AV** avp) PL_op->op_type = 0; /* Avoid uninit warning. */ PL_op->op_flags = 0; /* Avoid uninit warning. */ PUSHBLOCK(cx, CXt_EVAL, SP); - PUSHEVAL(cx, 0, compiling.cop_filegv); + PUSHEVAL(cx, 0, PL_compiling.cop_filegv); rop = doeval(G_SCALAR, startop); POPBLOCK(cx,PL_curpm); POPEVAL(cx); @@ -2286,8 +2382,10 @@ sv_compile_2op(SV *sv, OP** startop, char *code, AV** avp) lex_end(); *avp = (AV*)SvREFCNT_inc(PL_comppad); LEAVE; + if (curcop = &PL_compiling) + PL_compiling.op_private = PL_hints; #ifdef OP_IN_REGISTER - op = opsave; + op = PL_opsave; #endif return rop; } @@ -2318,7 +2416,7 @@ doeval(int gimme, OP** startop) SAVEI32(PL_max_intro_pending); caller = PL_compcv; - for (i = cxstack_ix - 1; i >= 0; i--) { + for (i = cxstack_ix; i >= 0; i--) { PERL_CONTEXT *cx = &cxstack[i]; if (cx->cx_type == CXt_EVAL) break; @@ -2594,13 +2692,17 @@ PP(pp_require) SAVEFREEPV(name); SAVEHINTS(); PL_hints = 0; + SAVEPPTR(PL_compiling.cop_warnings); + PL_compiling.cop_warnings = ((PL_dowarn & G_WARN_ALL_ON) ? WARN_ALL + : WARN_NONE); /* switch to eval mode */ push_return(PL_op->op_next); PUSHBLOCK(cx, CXt_EVAL, SP); - PUSHEVAL(cx, name, compiling.cop_filegv); + PUSHEVAL(cx, name, PL_compiling.cop_filegv); + SAVEI16(PL_compiling.cop_line); PL_compiling.cop_line = 0; PUTBACK; @@ -2654,10 +2756,16 @@ PP(pp_entereval) SAVEDELETE(PL_defstash, safestr, strlen(safestr)); SAVEHINTS(); PL_hints = PL_op->op_targ; + SAVEPPTR(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) ; + SAVEFREESV(PL_compiling.cop_warnings) ; + } push_return(PL_op->op_next); PUSHBLOCK(cx, CXt_EVAL, SP); - PUSHEVAL(cx, 0, compiling.cop_filegv); + PUSHEVAL(cx, 0, PL_compiling.cop_filegv); /* prepare to compile string */