Ressurect change 27824, which plugs a resource leak in uncalled code.

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

diff --git a/doio.c b/doio.c
index 0e9987d..a7dc9d9 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -195,7 +195,8 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
        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 +235,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;
@@ -246,7 +249,7 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
                errno = EPIPE;
                goto say_false;
            }
-           if ((*name == '-' && name[1] == '\0') || num_svs)
+           if (!(*name == '-' && name[1] == '\0') || num_svs)
                TAINT_ENV();
            TAINT_PROPER("piped open");
            if (!num_svs && name[len-1] == '|') {
@@ -321,7 +324,8 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
                    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;
@@ -398,7 +402,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,7 +426,9 @@ 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)
@@ -504,7 +511,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;
@@ -740,7 +748,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)) {
@@ -825,7 +834,7 @@ Perl_nextargv(pTHX_ register GV *gv)
                        if (ckWARN_d(WARN_INPLACE))     
                            Perl_warner(aTHX_ packWARN(WARN_INPLACE),
                              "Can't rename %s to %"SVf": %s, skipping file",
-                             PL_oldname, sv, Strerror(errno) );
+                             PL_oldname, (void*)sv, Strerror(errno));
                        do_close(gv,FALSE);
                        continue;
                    }
@@ -1227,6 +1236,8 @@ Perl_do_print(pTHX_ register SV *sv, PerlIO *fp)
     dVAR;
     register const char *tmps;
     STRLEN len;
+    U8 *tmpbuf = NULL;
+    bool happy = TRUE;
 
     /* assuming fp is checked earlier */
     if (!sv)
@@ -1238,7 +1249,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
@@ -1247,19 +1258,32 @@ Perl_do_print(pTHX_ register SV *sv, PerlIO *fp)
        }
        /* FALL THROUGH */
     default:
+       /* Do this first to trigger any overloading.  */
+       tmps = SvPV_const(sv, len);
        if (PerlIO_isutf8(fp)) {
-           if (!SvUTF8(sv))
-               sv_utf8_upgrade_flags(sv = sv_mortalcopy(sv),
-                                     SV_GMAGIC|SV_UTF8_NO_ENCODING);
+           if (!SvUTF8(sv)) {
+               /* We don't modify the original scalar.  */
+               tmpbuf = bytes_to_utf8((const U8*) tmps, &len);
+               tmps = (char *) tmpbuf;
+           }
        }
        else if (DO_UTF8(sv)) {
-           if (!sv_utf8_downgrade((sv = sv_mortalcopy(sv)), TRUE)
-               && ckWARN_d(WARN_UTF8))
-           {
-               Perl_warner(aTHX_ packWARN(WARN_UTF8), "Wide character in print");
+           STRLEN tmplen = len;
+           bool utf8 = TRUE;
+           U8 *result = bytes_from_utf8((const U8*) tmps, &tmplen, &utf8);
+           if (!utf8) {
+               tmpbuf = result;
+               tmps = (char *) tmpbuf;
+               len = tmplen;
+           }
+           else {
+               assert((char *)result == tmps);
+               if (ckWARN_d(WARN_UTF8)) {
+                   Perl_warner(aTHX_ packWARN(WARN_UTF8),
+                               "Wide character in print");
+               }
            }
        }
-       tmps = SvPV_const(sv, len);
        break;
     }
     /* To detect whether the process is about to overstep its
@@ -1269,8 +1293,10 @@ Perl_do_print(pTHX_ register SV *sv, PerlIO *fp)
      * at which we would get EPERM.  Note that when using buffered
      * io the write failure can be delayed until the flush/close. --jhi */
     if (len && (PerlIO_write(fp,tmps,len) == 0))
-       return FALSE;
-    return !PerlIO_error(fp);
+       happy = FALSE;
+    if (tmpbuf)
+       Safefree(tmpbuf);
+    return happy ? !PerlIO_error(fp) : FALSE;
 }
 
 I32
@@ -1501,7 +1527,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;
 
@@ -1539,10 +1567,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';
     }
@@ -2007,7 +2037,9 @@ Perl_do_ipcctl(pTHX_ I32 optype, SV **mark, SV **sp)
     char *a;
     I32 ret = -1;
     const I32 id  = SvIVx(*++mark);
+#ifdef Semctl
     const I32 n   = (optype == OP_SEMCTL) ? SvIVx(*++mark) : 0;
+#endif
     const I32 cmd = SvIVx(*++mark);
     SV * const astr = *++mark;
     STRLEN infosize = 0;
@@ -2251,11 +2283,11 @@ Perl_do_shmio(pTHX_ I32 optype, SV **mark, SV **sp)
     SETERRNO(0,0);
     if (shmctl(id, IPC_STAT, &shmds) == -1)
        return -1;
-    if (mpos < 0 || msize < 0 || mpos + msize > shmds.shm_segsz) {
+    if (mpos < 0 || msize < 0 || (size_t)mpos + msize > shmds.shm_segsz) {
        SETERRNO(EFAULT,SS_ACCVIO);             /* can't do as caller requested */
        return -1;
     }
-    shm = (char *)shmat(id, (char*)NULL, (optype == OP_SHMREAD) ? SHM_RDONLY : 0);
+    shm = (char *)shmat(id, NULL, (optype == OP_SHMREAD) ? SHM_RDONLY : 0);
     if (shm == (char *)-1)     /* I hate System V IPC, I really do */
        return -1;
     if (optype == OP_SHMREAD) {
@@ -2264,7 +2296,7 @@ Perl_do_shmio(pTHX_ I32 optype, SV **mark, SV **sp)
        if (! SvOK(mstr))
            sv_setpvn(mstr, "", 0);
        SvPV_force_nolen(mstr);
-       mbuf = SvGROW(mstr, msize+1);
+       mbuf = SvGROW(mstr, (STRLEN)msize+1);
 
        Copy(shm + mpos, mbuf, msize, char);
        SvCUR_set(mstr, msize);
@@ -2323,7 +2355,7 @@ Perl_vms_start_glob
    (pTHX_ SV *tmpglob,
     IO *io);
 
-    fp = Perl_vms_start_glob(tmpglob, io);
+    fp = Perl_vms_start_glob(aTHX_ tmpglob, io);
 
 #else /* !VMS */
 #ifdef MACOS_TRADITIONAL