: fix: [perl #39583] Pattern Match fails for specific length string

[p5sagit/p5-mst-13.2.git] / doio.c

diff --git a/doio.c b/doio.c
index 507a855..41f026f 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -76,7 +76,7 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
     bool was_fdopen = FALSE;
     bool in_raw = 0, in_crlf = 0, out_raw = 0, out_crlf = 0;
     char *type  = NULL;
-    char mode[PERL_MODE_MAX];  /* stdio file mode ("r\0", "rb\0", "r+b\0" etc.) */
+    char mode[PERL_MODE_MAX];  /* file mode ("r\0", "rb\0", "ab\0" etc.) */
     SV *namesv;
 
     Zero(mode,sizeof(mode),char);
@@ -188,14 +188,14 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
        STRLEN olen = len;
        char *tend;
        int dodup = 0;
-       PerlIO *that_fp = NULL;
 
        type = savepvn(oname, len);
        tend = type+len;
        SAVEFREEPV(type);
 
         /* Lose leading and trailing white space */
-        for (; isSPACE(*type); type++) ;
+       while (isSPACE(*type))
+           type++;
         while (tend > type && isSPACE(tend[-1]))
            *--tend = '\0';
 
@@ -234,7 +234,9 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
                }
                type++;
            }
-           for (type++; isSPACE(*type); type++) ;
+           do {
+               type++;
+           } while (isSPACE(*type));
            if (!num_svs) {
                name = type;
                len = tend-type;
@@ -258,9 +260,9 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
            writing = 1;
 #ifdef HAS_STRLCAT
             if (out_raw)
-                strlcat(mode, "b", PERL_MODE_MAX);
+                strlcat(mode, "b", PERL_MODE_MAX - 1);
             else if (out_crlf)
-                strlcat(mode, "t", PERL_MODE_MAX); 
+                strlcat(mode, "t", PERL_MODE_MAX - 1); 
 #else
            if (out_raw)
                strcat(mode, "b");
@@ -296,9 +298,9 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
 
 #ifdef HAS_STRLCAT
             if (out_raw)
-                strlcat(mode, "b", PERL_MODE_MAX);
+                strlcat(mode, "b", PERL_MODE_MAX - 1);
             else if (out_crlf)
-                strlcat(mode, "t", PERL_MODE_MAX);
+                strlcat(mode, "t", PERL_MODE_MAX - 1);
 #else
            if (out_raw)
                strcat(mode, "b");
@@ -318,10 +320,12 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
                    fp = supplied_fp;
                }
                else {
+                   PerlIO *that_fp = NULL;
                    if (num_svs > 1) {
                        Perl_croak(aTHX_ "More than one argument to '%c&' open",IoTYPE(io));
                    }
-                   for (; isSPACE(*type); type++) ;
+                   while (isSPACE(*type))
+                       type++;
                    if (num_svs && (SvIOK(*svp) || (SvPOK(*svp) && looks_like_number(*svp)))) {
                        fd = SvUV(*svp);
                        num_svs = 0;
@@ -335,8 +339,7 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
                            thatio = sv_2io(*svp);
                        }
                        else {
-                           GV *thatgv;
-                           thatgv = gv_fetchpvn_flags(type, tend - type,
+                           GV * const thatgv = gv_fetchpvn_flags(type, tend - type,
                                                       0, SVt_PVIO);
                            thatio = GvIO(thatgv);
                        }
@@ -398,7 +401,8 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
                }
            } /* & */
            else {
-               for (; isSPACE(*type); type++) ;
+               while (isSPACE(*type))
+                   type++;
                if (*type == IoTYPE_STD && (!type[1] || isSPACE(type[1]) || type[1] == ':')) {
                    type++;
                    fp = PerlIO_stdout();
@@ -421,13 +425,15 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
               goto unknown_open_mode;
        } /* IoTYPE_WRONLY */
        else if (*type == IoTYPE_RDONLY) {
-           for (type++; isSPACE(*type); type++) ;
+           do {
+               type++;
+           } while (isSPACE(*type));
            mode[0] = 'r';
 #ifdef HAS_STRLCAT
             if (in_raw)
-                strlcat(mode, "b", PERL_MODE_MAX);
+                strlcat(mode, "b", PERL_MODE_MAX - 1);
             else if (in_crlf)
-                strlcat(mode, "t", PERL_MODE_MAX);
+                strlcat(mode, "t", PERL_MODE_MAX - 1);
 #else
            if (in_raw)
                strcat(mode, "b");
@@ -486,9 +492,9 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
 
 #ifdef HAS_STRLCAT
             if (in_raw)
-                strlcat(mode, "b", PERL_MODE_MAX);
+                strlcat(mode, "b", PERL_MODE_MAX - 1);
             else if (in_crlf)
-                strlcat(mode, "t", PERL_MODE_MAX);
+                strlcat(mode, "t", PERL_MODE_MAX - 1);
 #else
            if (in_raw)
                strcat(mode, "b");
@@ -504,7 +510,8 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
            }
            IoTYPE(io) = IoTYPE_PIPE;
            if (num_svs) {
-               for (; isSPACE(*type); type++) ;
+               while (isSPACE(*type))
+                   type++;
                if (*type) {
                    if (PerlIO_apply_layers(aTHX_ fp, mode, type) != 0) {
                        goto say_false;
@@ -523,9 +530,9 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
 
 #ifdef HAS_STRLCAT
             if (in_raw)
-                strlcat(mode, "b", PERL_MODE_MAX);
+                strlcat(mode, "b", PERL_MODE_MAX - 1);
             else if (in_crlf)
-                strlcat(mode, "t", PERL_MODE_MAX);
+                strlcat(mode, "t", PERL_MODE_MAX - 1);
 #else
            if (in_raw)
                strcat(mode, "b");
@@ -740,7 +747,8 @@ Perl_nextargv(pTHX_ register GV *gv)
        if (PL_inplace) {
            if (!PL_argvout_stack)
                PL_argvout_stack = newAV();
-           av_push(PL_argvout_stack, SvREFCNT_inc_simple(PL_defoutgv));
+           assert(PL_defoutgv);
+           av_push(PL_argvout_stack, SvREFCNT_inc_simple_NN(PL_defoutgv));
        }
     }
     if (PL_filemode & (S_ISUID|S_ISGID)) {
@@ -930,7 +938,7 @@ Perl_nextargv(pTHX_ register GV *gv)
        if (io && (IoFLAGS(io) & IOf_ARGV)
            && PL_argvout_stack && AvFILLp(PL_argvout_stack) >= 0)
        {
-           GV *oldout = (GV*)av_pop(PL_argvout_stack);
+           GV * const oldout = (GV*)av_pop(PL_argvout_stack);
            setdefout(oldout);
            SvREFCNT_dec(oldout);
            return NULL;
@@ -1175,7 +1183,6 @@ my_chsize(int fd, Off_t length)
        /* code courtesy of William Kucharski */
 #define HAS_CHSIZE
 
-    struct flock fl;
     Stat_t filebuf;
 
     if (PerlLIO_fstat(fd, &filebuf) < 0)
@@ -1195,7 +1202,7 @@ my_chsize(int fd, Off_t length)
     }
     else {
        /* truncate length */
-
+       struct flock fl;
        fl.l_whence = 0;
        fl.l_len = 0;
        fl.l_start = length;
@@ -1240,7 +1247,7 @@ Perl_do_print(pTHX_ register SV *sv, PerlIO *fp)
        return TRUE;
     case SVt_IV:
        if (SvIOK(sv)) {
-           SvGETMAGIC(sv);
+           assert(!SvGMAGICAL(sv));
            if (SvIsUV(sv))
                PerlIO_printf(fp, "%"UVuf, (UV)SvUVX(sv));
            else
@@ -1261,7 +1268,7 @@ Perl_do_print(pTHX_ register SV *sv, PerlIO *fp)
        else if (DO_UTF8(sv)) {
            STRLEN tmplen = len;
            bool utf8 = TRUE;
-           U8 *result = bytes_from_utf8((const U8*) tmps, &tmplen, &utf8);
+           U8 * const result = bytes_from_utf8((const U8*) tmps, &tmplen, &utf8);
            if (!utf8) {
                tmpbuf = result;
                tmps = (char *) tmpbuf;
@@ -1285,8 +1292,7 @@ Perl_do_print(pTHX_ register SV *sv, PerlIO *fp)
      * io the write failure can be delayed until the flush/close. --jhi */
     if (len && (PerlIO_write(fp,tmps,len) == 0))
        happy = FALSE;
-    if (tmpbuf)
-       Safefree(tmpbuf);
+    Safefree(tmpbuf);
     return happy ? !PerlIO_error(fp) : FALSE;
 }
 
@@ -1390,6 +1396,19 @@ Perl_my_lstat(pTHX)
     return PL_laststatval;
 }
 
+static void
+S_exec_failed(pTHX_ const char *cmd, int fd, int do_report)
+{
+    const int e = errno;
+    if (ckWARN(WARN_EXEC))
+       Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't exec \"%s\": %s",
+                   cmd, Strerror(e));
+    if (do_report) {
+       PerlLIO_write(fd, (void*)&e, sizeof(int));
+       PerlLIO_close(fd);
+    }
+}
+
 bool
 Perl_do_aexec5(pTHX_ SV *really, register SV **mark, register SV **sp,
               int fd, int do_report)
@@ -1422,15 +1441,7 @@ Perl_do_aexec5(pTHX_ SV *really, register SV **mark, register SV **sp,
        else
            PerlProc_execvp(PL_Argv[0],EXEC_ARGV_CAST(PL_Argv));
        PERL_FPU_POST_EXEC
-       if (ckWARN(WARN_EXEC))
-           Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't exec \"%s\": %s",
-               (really ? tmps : PL_Argv[0]), Strerror(errno));
-       if (do_report) {
-           const int e = errno;
-
-           PerlLIO_write(fd, (void*)&e, sizeof(int));
-           PerlLIO_close(fd);
-       }
+       S_exec_failed(aTHX_ (really ? tmps : PL_Argv[0]), fd, do_report);
     }
     do_execfree();
 #endif
@@ -1482,7 +1493,7 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report)
          if (*s == 'f') {
              s++;
 #ifdef HAS_STRLCPY
-              strlcat(flags, "f", PERL_FLAGS_MAX);
+              strlcat(flags, "f", PERL_FLAGS_MAX - 2);
 #else
              strcat(flags,"f");
 #endif
@@ -1499,9 +1510,10 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report)
              if (s[-1] == '\'') {
                  *--s = '\0';
                  PERL_FPU_PRE_EXEC
-                 PerlProc_execl(PL_cshname,"csh", flags, ncmd, (char*)0);
+                 PerlProc_execl(PL_cshname, "csh", flags, ncmd, NULL);
                  PERL_FPU_POST_EXEC
                  *s = '\'';
+                 S_exec_failed(aTHX_ PL_cshname, fd, do_report);
                  Safefree(cmd);
                  return FALSE;
              }
@@ -1518,7 +1530,9 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report)
     if (strnEQ(cmd,"exec",4) && isSPACE(cmd[4]))
        goto doshell;
 
-    for (s = cmd; *s && isALNUM(*s); s++) ;    /* catch VAR=val gizmo */
+    s = cmd;
+    while (isALNUM(*s))
+       s++;    /* catch VAR=val gizmo */
     if (*s == '=')
        goto doshell;
 
@@ -1545,8 +1559,9 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report)
            }
          doshell:
            PERL_FPU_PRE_EXEC
-           PerlProc_execl(PL_sh_path, "sh", "-c", cmd, (char*)0);
+           PerlProc_execl(PL_sh_path, "sh", "-c", cmd, NULL);
            PERL_FPU_POST_EXEC
+           S_exec_failed(aTHX_ PL_sh_path, fd, do_report);
            Safefree(cmd);
            return FALSE;
        }
@@ -1556,10 +1571,12 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report)
     PL_Cmd = savepvn(cmd, s-cmd);
     a = PL_Argv;
     for (s = PL_Cmd; *s;) {
-       while (*s && isSPACE(*s)) s++;
+       while (isSPACE(*s))
+           s++;
        if (*s)
            *(a++) = s;
-       while (*s && !isSPACE(*s)) s++;
+       while (*s && !isSPACE(*s))
+           s++;
        if (*s)
            *s++ = '\0';
     }
@@ -1572,14 +1589,7 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report)
            do_execfree();
            goto doshell;
        }
-       if (ckWARN(WARN_EXEC))
-           Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't exec \"%s\": %s",
-               PL_Argv[0], Strerror(errno));
-       if (do_report) {
-           const int e = errno;
-           PerlLIO_write(fd, (const void*)&e, sizeof(int));
-           PerlLIO_close(fd);
-       }
+       S_exec_failed(aTHX_ PL_Argv[0], fd, do_report);
     }
     do_execfree();
     Safefree(cmd);
@@ -2295,12 +2305,10 @@ Perl_do_shmio(pTHX_ I32 optype, SV **mark, SV **sp)
 #endif
     }
     else {
-       I32 n;
        STRLEN len;
 
        const char *mbuf = SvPV_const(mstr, len);
-       if ((n = len) > msize)
-           n = msize;
+       const I32 n = (len > msize) ? msize : len;
        Copy(mbuf, shm + mpos, n, char);
        if (n < msize)
            memzero(shm + mpos + n, msize - n);