projects / p5sagit/p5-mst-13.2.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw
plug strictly private function leaks in API listing
[p5sagit/p5-mst-13.2.git] / pp_ctl.c
diff --git a/pp_ctl.c b/pp_ctl.c
index 68c50a5..da0f7a0 100644 (file)
--- 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;
@@ -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();
@@ -2290,6 +2382,8 @@ 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 = PL_opsave;
 #endif
@@ -2322,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;
@@ -2598,6 +2692,9 @@ 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 */
 
@@ -2605,6 +2702,7 @@ PP(pp_require)
     PUSHBLOCK(cx, CXt_EVAL, SP);
     PUSHEVAL(cx, name, PL_compiling.cop_filegv);
 
+    SAVEI16(PL_compiling.cop_line);
     PL_compiling.cop_line = 0;
 
     PUTBACK;
@@ -2658,6 +2756,12 @@ 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);
Unnamed repository; edit this file to name it for gitweb.