#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));
double value;
bool gotsome;
STRLEN len;
+ STRLEN fudge = SvCUR(tmpForm) * (IN_UTF8 ? 3 : 1) + 1;
if (!SvMAGICAL(tmpForm) || !SvCOMPILED(tmpForm)) {
SvREADONLY_off(tmpForm);
}
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 */
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;
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) {
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;
}
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;
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))
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 ||
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));
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();
if (do_dump) {
#ifdef VMS
- if (!retop) retop = main_start;
+ if (!retop) retop = PL_main_start;
#endif
PL_restartop = retop;
PL_do_undump = TRUE;
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)
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
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);
SAVEDELETE(PL_defstash, safestr, strlen(safestr));
SAVEHINTS();
#ifdef OP_IN_REGISTER
- opsave = op;
+ PL_opsave = op;
#else
SAVEPPTR(PL_op);
#endif
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);
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;
}
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;
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;
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 */
projects / p5sagit/p5-mst-13.2.git / blobdiff