X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_ctl.c;h=87e399afa9090ce5237feef22efdc37f12b80c5d;hb=9f6ab4074f86da83f9650997df3135d1f2daf062;hp=c586a723f385f29ae59348224fb5fccd1e62f828;hpb=533c011aecf9bca2c9ad025efccd7b74ad222cda;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pp_ctl.c b/pp_ctl.c index c586a72..87e399a 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,6 +940,7 @@ PP(pp_flop) char *tmps = SvPV(final, len); sv = sv_mortalcopy(left); + SvPV_force(sv,PL_na); while (!SvNIOKp(sv) && SvCUR(sv) <= len) { XPUSHs(sv); if (strEQ(SvPVX(sv),tmps)) @@ -894,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 || @@ -1010,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)); @@ -1781,10 +1874,21 @@ PP(pp_goto) I32 items = 0; I32 oldsave; + retry: if (!CvROOT(cv) && !CvXSUB(cv)) { - if (CvGV(cv)) { - SV *tmpstr = sv_newmortal(); - gv_efullname3(tmpstr, CvGV(cv), Nullch); + GV *gv = CvGV(cv); + GV *autogv; + if (gv) { + SV *tmpstr; + /* autoloaded stub? */ + if (cv != GvCV(gv) && (cv = GvCV(gv))) + goto retry; + autogv = gv_autoload4(GvSTASH(gv), GvNAME(gv), + GvNAMELEN(gv), FALSE); + if (autogv && (cv = GvCV(autogv))) + goto retry; + tmpstr = sv_newmortal(); + gv_efullname3(tmpstr, gv, Nullch); DIE("Goto undefined subroutine &%s",SvPVX(tmpstr)); } DIE("Goto undefined subroutine"); @@ -1881,7 +1985,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(); @@ -2089,7 +2193,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; @@ -2143,8 +2247,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) @@ -2152,18 +2256,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 @@ -2251,6 +2355,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); @@ -2265,28 +2373,30 @@ 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 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, compiling.cop_filegv); + PUSHEVAL(cx, 0, PL_compiling.cop_filegv); rop = doeval(G_SCALAR, startop); - POPBLOCK(cx,PL_curpm); POPEVAL(cx); + POPBLOCK(cx,PL_curpm); (*startop)->op_type = OP_NULL; (*startop)->op_ppaddr = ppaddr[OP_NULL]; lex_end(); *avp = (AV*)SvREFCNT_inc(PL_comppad); LEAVE; + if (PL_curcop == &PL_compiling) + PL_compiling.op_private = PL_hints; #ifdef OP_IN_REGISTER - op = opsave; + op = PL_opsave; #endif return rop; } @@ -2317,7 +2427,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; @@ -2575,6 +2685,8 @@ PP(pp_require) RETPUSHUNDEF; } + else + SETERRNO(0, SS$_NORMAL); /* Assume success here to prevent recursive requirement. */ (void)hv_store(GvHVn(PL_incgv), name, strlen(name), @@ -2593,13 +2705,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; @@ -2653,10 +2769,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 */