This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade to Math::Complex 1.48 and Math::Trig 1.13
[perl5.git] / doio.c
diff --git a/doio.c b/doio.c
index e1cc258..ba096ef 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -1,7 +1,7 @@
 /*    doio.c
  *
  *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- *    2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
+ *    2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -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);
@@ -176,7 +176,7 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
 
         IoTYPE(io) = PerlIO_intmode2str(rawmode, &mode[ix], &writing);
 
-       namesv = sv_2mortal(newSVpv(oname,0));
+       namesv = newSVpvn_flags(oname, len, SVs_TEMP);
        num_svs = 1;
        svp = &namesv;
        type = NULL;
@@ -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;
@@ -256,17 +258,10 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
            }
            mode[0] = 'w';
            writing = 1;
-#ifdef HAS_STRLCAT
             if (out_raw)
-                strlcat(mode, "b", PERL_MODE_MAX);
+               mode[1] = 'b';
             else if (out_crlf)
-                strlcat(mode, "t", PERL_MODE_MAX); 
-#else
-           if (out_raw)
-               strcat(mode, "b");
-           else if (out_crlf)
-               strcat(mode, "t");
-#endif
+               mode[1] = 't';
            if (num_svs > 1) {
                fp = PerlProc_popen_list(mode, num_svs, svp);
            }
@@ -294,17 +289,10 @@ 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);
+               mode[1] = 'b';
             else if (out_crlf)
-                strlcat(mode, "t", PERL_MODE_MAX);
-#else
-           if (out_raw)
-               strcat(mode, "b");
-           else if (out_crlf)
-               strcat(mode, "t");
-#endif
+               mode[1] = 't';
            if (*type == '&') {
              duplicity:
                dodup = PERLIO_DUP_FD;
@@ -318,10 +306,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 +325,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 +387,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();
@@ -409,7 +399,7 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
                }
                else  {
                    if (!num_svs) {
-                       namesv = sv_2mortal(newSVpvn(type,tend - type));
+                       namesv = newSVpvn_flags(type, tend - type, SVs_TEMP);
                        num_svs = 1;
                        svp = &namesv;
                        type = NULL;
@@ -421,19 +411,14 @@ 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);
+               mode[1] = 'b';
             else if (in_crlf)
-                strlcat(mode, "t", PERL_MODE_MAX);
-#else
-           if (in_raw)
-               strcat(mode, "b");
-           else if (in_crlf)
-               strcat(mode, "t");
-#endif
+               mode[1] = 't';
            if (*type == '&') {
                goto duplicity;
            }
@@ -447,7 +432,7 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
            }
            else {
                if (!num_svs) {
-                   namesv = sv_2mortal(newSVpvn(type,tend - type));
+                   namesv = newSVpvn_flags(type, tend - type, SVs_TEMP);
                    num_svs = 1;
                    svp = &namesv;
                    type = NULL;
@@ -484,17 +469,10 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
            TAINT_PROPER("piped open");
            mode[0] = 'r';
 
-#ifdef HAS_STRLCAT
             if (in_raw)
-                strlcat(mode, "b", PERL_MODE_MAX);
+               mode[1] = 'b';
             else if (in_crlf)
-                strlcat(mode, "t", PERL_MODE_MAX);
-#else
-           if (in_raw)
-               strcat(mode, "b");
-           else if (in_crlf)
-               strcat(mode, "t");
-#endif
+               mode[1] = 't';
 
            if (num_svs > 1) {
                fp = PerlProc_popen_list(mode,num_svs,svp);
@@ -504,7 +482,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;
@@ -521,17 +500,10 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
                ;
            mode[0] = 'r';
 
-#ifdef HAS_STRLCAT
             if (in_raw)
-                strlcat(mode, "b", PERL_MODE_MAX);
+               mode[1] = 'b';
             else if (in_crlf)
-                strlcat(mode, "t", PERL_MODE_MAX);
-#else
-           if (in_raw)
-               strcat(mode, "b");
-           else if (in_crlf)
-               strcat(mode, "t");
-#endif
+               mode[1] = 't';
 
            if (*name == '-' && name[1] == '\0') {
                fp = PerlIO_stdin();
@@ -539,7 +511,7 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
            }
            else {
                if (!num_svs) {
-                   namesv = sv_2mortal(newSVpvn(type,tend - type));
+                   namesv = newSVpvn_flags(type, tend - type, SVs_TEMP);
                    num_svs = 1;
                    svp = &namesv;
                    type = NULL;
@@ -738,9 +710,9 @@ Perl_nextargv(pTHX_ register GV *gv)
     if (io && (IoFLAGS(io) & IOf_ARGV) && (IoFLAGS(io) & IOf_START)) {
        IoFLAGS(io) &= ~IOf_START;
        if (PL_inplace) {
-           if (!PL_argvout_stack)
-               PL_argvout_stack = newAV();
-           av_push(PL_argvout_stack, SvREFCNT_inc_simple(PL_defoutgv));
+           assert(PL_defoutgv);
+           Perl_av_create_and_push(aTHX_ &PL_argvout_stack,
+                                   SvREFCNT_inc_simple_NN(PL_defoutgv));
        }
     }
     if (PL_filemode & (S_ISUID|S_ISGID)) {
@@ -814,7 +786,7 @@ Perl_nextargv(pTHX_ register GV *gv)
                        if (ckWARN_d(WARN_INPLACE))     
                            Perl_warner(aTHX_ packWARN(WARN_INPLACE),
                              "Can't do inplace edit: %"SVf" would not be unique",
-                             sv);
+                             SVfARG(sv));
                        do_close(gv,FALSE);
                        continue;
                    }
@@ -825,7 +797,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, (void*)sv, Strerror(errno));
+                             PL_oldname, SVfARG(sv), Strerror(errno));
                        do_close(gv,FALSE);
                        continue;
                    }
@@ -842,7 +814,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, SVfARG(sv), Strerror(errno) );
                        do_close(gv,FALSE);
                        continue;
                    }
@@ -930,7 +902,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 +1147,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 +1166,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;
@@ -1225,32 +1196,24 @@ bool
 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)
        return TRUE;
-    switch (SvTYPE(sv)) {
-    case SVt_NULL:
-       if (ckWARN(WARN_UNINITIALIZED))
-           report_uninit(sv);
-       return TRUE;
-    case SVt_IV:
-       if (SvIOK(sv)) {
-           assert(!SvGMAGICAL(sv));
-           if (SvIsUV(sv))
-               PerlIO_printf(fp, "%"UVuf, (UV)SvUVX(sv));
-           else
-               PerlIO_printf(fp, "%"IVdf, (IV)SvIVX(sv));
-           return !PerlIO_error(fp);
-       }
-       /* FALL THROUGH */
-    default:
+    if (SvTYPE(sv) == SVt_IV && SvIOK(sv)) {
+       assert(!SvGMAGICAL(sv));
+       if (SvIsUV(sv))
+           PerlIO_printf(fp, "%"UVuf, (UV)SvUVX(sv));
+       else
+           PerlIO_printf(fp, "%"IVdf, (IV)SvIVX(sv));
+       return !PerlIO_error(fp);
+    }
+    else {
+       STRLEN len;
        /* Do this first to trigger any overloading.  */
-       tmps = SvPV_const(sv, len);
+       const char *tmps = SvPV_const(sv, len);
+       U8 *tmpbuf = NULL;
+       bool happy = TRUE;
+
        if (PerlIO_isutf8(fp)) {
            if (!SvUTF8(sv)) {
                /* We don't modify the original scalar.  */
@@ -1261,7 +1224,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;
@@ -1275,19 +1238,17 @@ Perl_do_print(pTHX_ register SV *sv, PerlIO *fp)
                }
            }
        }
-       break;
-    }
-    /* To detect whether the process is about to overstep its
-     * filesize limit we would need getrlimit().  We could then
-     * also transparently raise the limit with setrlimit() --
-     * but only until the system hard limit/the filesystem limit,
-     * 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))
-       happy = FALSE;
-    if (tmpbuf)
+       /* To detect whether the process is about to overstep its
+        * filesize limit we would need getrlimit().  We could then
+        * also transparently raise the limit with setrlimit() --
+        * but only until the system hard limit/the filesystem limit,
+        * 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))
+           happy = FALSE;
        Safefree(tmpbuf);
-    return happy ? !PerlIO_error(fp) : FALSE;
+       return happy ? !PerlIO_error(fp) : FALSE;
+    }
 }
 
 I32
@@ -1302,22 +1263,28 @@ Perl_my_stat(pTHX)
        EXTEND(SP,1);
        gv = cGVOP_gv;
       do_fstat:
+        if (gv == PL_defgv)
+            return PL_laststatval;
        io = GvIO(gv);
-       if (io && IoIFP(io)) {
-           PL_statgv = gv;
-           sv_setpvn(PL_statname,"", 0);
-           PL_laststype = OP_STAT;
-           return (PL_laststatval = PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &PL_statcache));
-       }
-       else {
-           if (gv == PL_defgv)
-               return PL_laststatval;
-           if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
-               report_evil_fh(gv, io, PL_op->op_type);
-           PL_statgv = NULL;
-           sv_setpvn(PL_statname,"", 0);
-           return (PL_laststatval = -1);
-       }
+        do_fstat_have_io:
+        PL_laststype = OP_STAT;
+        PL_statgv = gv;
+        sv_setpvn(PL_statname, "", 0);
+        if(io) {
+           if (IoIFP(io)) {
+               return (PL_laststatval = PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &PL_statcache));
+            } else if (IoDIRP(io)) {
+                return (PL_laststatval = PerlLIO_fstat(my_dirfd(IoDIRP(io)), &PL_statcache));
+            } else {
+                if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
+                    report_evil_fh(gv, io, PL_op->op_type);
+                return (PL_laststatval = -1);
+            }
+       } else {
+            if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
+                report_evil_fh(gv, io, PL_op->op_type);
+            return (PL_laststatval = -1);
+        }
     }
     else if (PL_op->op_private & OPpFT_STACKED) {
        return PL_laststatval;
@@ -1335,6 +1302,11 @@ Perl_my_stat(pTHX)
            gv = (GV*)SvRV(sv);
            goto do_fstat;
        }
+        else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVIO) {
+            io = (IO*)SvRV(sv);
+           gv = NULL;
+            goto do_fstat_have_io;
+        }
 
        s = SvPV_const(sv, len);
        PL_statgv = NULL;
@@ -1390,23 +1362,36 @@ 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)
 {
     dVAR;
-#if defined(MACOS_TRADITIONAL) || defined(__SYMBIAN32__)
+#if defined(MACOS_TRADITIONAL) || defined(__SYMBIAN32__) || defined(__LIBCATAMOUNT__)
     Perl_croak(aTHX_ "exec? I'm not *that* kind of operating system");
 #else
     if (sp > mark) {
-       char **a;
+       const char **a;
        const char *tmps = NULL;
-       Newx(PL_Argv, sp - mark + 1, char*);
+       Newx(PL_Argv, sp - mark + 1, const char*);
        a = PL_Argv;
 
        while (++mark <= sp) {
            if (*mark)
-               *a++ = (char*)SvPV_nolen_const(*mark);
+               *a++ = SvPV_nolen_const(*mark);
            else
                *a++ = "";
        }
@@ -1422,15 +1407,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
@@ -1453,15 +1430,16 @@ bool
 Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report)
 {
     dVAR;
-    register char **a;
+    register const char **a;
     register char *s;
+    char *buf;
     char *cmd;
 
     /* Make a copy so we can change it */
-    const int cmdlen = strlen(incmd);
-    Newx(cmd, cmdlen+1, char);
-    strncpy(cmd, incmd, cmdlen);
-    cmd[cmdlen] = 0;
+    const Size_t cmdlen = strlen(incmd) + 1;
+    Newx(buf, cmdlen, char);
+    cmd = buf;
+    memcpy(cmd, incmd, cmdlen);
 
     while (*cmd && isSPACE(*cmd))
        cmd++;
@@ -1473,19 +1451,11 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report)
         char flags[PERL_FLAGS_MAX];
        if (strnEQ(cmd,PL_cshname,PL_cshlen) &&
            strnEQ(cmd+PL_cshlen," -c",3)) {
-#ifdef HAS_STRLCPY
-          strlcpy(flags, "-c", PERL_FLAGS_MAX);
-#else
-         strcpy(flags,"-c");
-#endif
+          my_strlcpy(flags, "-c", PERL_FLAGS_MAX);
          s = cmd+PL_cshlen+3;
          if (*s == 'f') {
              s++;
-#ifdef HAS_STRLCPY
-              strlcat(flags, "f", PERL_FLAGS_MAX);
-#else
-             strcat(flags,"f");
-#endif
+              my_strlcat(flags, "f", PERL_FLAGS_MAX - 2);
          }
          if (*s == ' ')
              s++;
@@ -1499,10 +1469,11 @@ 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, (char*)NULL);
                  PERL_FPU_POST_EXEC
                  *s = '\'';
-                 Safefree(cmd);
+                 S_exec_failed(aTHX_ PL_cshname, fd, do_report);
+                 Safefree(buf);
                  return FALSE;
              }
          }
@@ -1518,7 +1489,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,44 +1518,40 @@ 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, (char *)NULL);
            PERL_FPU_POST_EXEC
-           Safefree(cmd);
+           S_exec_failed(aTHX_ PL_sh_path, fd, do_report);
+           Safefree(buf);
            return FALSE;
        }
     }
 
-    Newx(PL_Argv, (s - cmd) / 2 + 2, char*);
+    Newx(PL_Argv, (s - cmd) / 2 + 2, const char*);
     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';
     }
     *a = NULL;
     if (PL_Argv[0]) {
        PERL_FPU_PRE_EXEC
-       PerlProc_execvp(PL_Argv[0],PL_Argv);
+       PerlProc_execvp(PL_Argv[0],EXEC_ARGV_CAST(PL_Argv));
        PERL_FPU_POST_EXEC
        if (errno == ENOEXEC) {         /* for system V NIH syndrome */
            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);
+    Safefree(buf);
     return FALSE;
 }
 
@@ -1630,7 +1599,7 @@ Perl_apply(pTHX_ I32 type, register SV **mark, register SV **sp)
     case OP_CHMOD:
        APPLY_TAINT_PROPER();
        if (++mark <= sp) {
-           val = SvIVx(*mark);
+           val = SvIV(*mark);
            APPLY_TAINT_PROPER();
            tot = sp - mark;
            while (++mark <= sp) {
@@ -1724,7 +1693,7 @@ nothing in the core.
                Perl_croak(aTHX_ "Unrecognized signal name \"%s\"",s);
        }
        else
-           val = SvIVx(*mark);
+           val = SvIV(*mark);
        APPLY_TAINT_PROPER();
        tot = sp - mark;
 #ifdef VMS
@@ -1737,7 +1706,7 @@ nothing in the core.
             * CRTL's emulation of Unix-style signals and kill()
             */
            while (++mark <= sp) {
-               I32 proc = SvIVx(*mark);
+               I32 proc = SvIV(*mark);
                register unsigned long int __vmssts;
                APPLY_TAINT_PROPER();
                if (!((__vmssts = sys$delprc(&proc,0)) & 1)) {
@@ -1761,7 +1730,7 @@ nothing in the core.
        if (val < 0) {
            val = -val;
            while (++mark <= sp) {
-               const I32 proc = SvIVx(*mark);
+               const I32 proc = SvIV(*mark);
                APPLY_TAINT_PROPER();
 #ifdef HAS_KILLPG
                if (PerlProc_killpg(proc,val))  /* BSD */
@@ -1773,7 +1742,7 @@ nothing in the core.
        }
        else {
            while (++mark <= sp) {
-               const I32 proc = SvIVx(*mark);
+               const I32 proc = SvIV(*mark);
                APPLY_TAINT_PROPER();
                if (PerlProc_kill(proc, val))
                    tot--;
@@ -1831,16 +1800,16 @@ nothing in the core.
            else {
                 Zero(&utbuf, sizeof utbuf, char);
 #ifdef HAS_FUTIMES
-               utbuf[0].tv_sec = (long)SvIVx(accessed);  /* time accessed */
+               utbuf[0].tv_sec = (long)SvIV(accessed);  /* time accessed */
                utbuf[0].tv_usec = 0;
-               utbuf[1].tv_sec = (long)SvIVx(modified);  /* time modified */
+               utbuf[1].tv_sec = (long)SvIV(modified);  /* time modified */
                utbuf[1].tv_usec = 0;
 #elif defined(BIG_TIME)
-                utbuf.actime = (Time_t)SvNVx(accessed);  /* time accessed */
-                utbuf.modtime = (Time_t)SvNVx(modified); /* time modified */
+                utbuf.actime = (Time_t)SvNV(accessed);  /* time accessed */
+                utbuf.modtime = (Time_t)SvNV(modified); /* time modified */
 #else
-                utbuf.actime = (Time_t)SvIVx(accessed);  /* time accessed */
-                utbuf.modtime = (Time_t)SvIVx(modified); /* time modified */
+                utbuf.actime = (Time_t)SvIV(accessed);  /* time accessed */
+                utbuf.modtime = (Time_t)SvIV(modified); /* time modified */
 #endif
             }
            APPLY_TAINT_PROPER();
@@ -1853,7 +1822,8 @@ nothing in the core.
                    if (GvIO(gv) && IoIFP(GvIOp(gv))) {
 #ifdef HAS_FUTIMES
                        APPLY_TAINT_PROPER();
-                       if (futimes(PerlIO_fileno(IoIFP(GvIOn(gv))), utbufp))
+                       if (futimes(PerlIO_fileno(IoIFP(GvIOn(gv))),
+                            (struct timeval *) utbufp))
                            tot--;
 #else
                        Perl_die(aTHX_ PL_no_func, "futimes");
@@ -1871,7 +1841,7 @@ nothing in the core.
                    const char * const name = SvPV_nolen_const(*mark);
                    APPLY_TAINT_PROPER();
 #ifdef HAS_FUTIMES
-                   if (utimes(name, utbufp))
+                   if (utimes(name, (struct timeval *)utbufp))
 #else
                    if (PerlLIO_utime(name, utbufp))
 #endif
@@ -2161,6 +2131,8 @@ Perl_do_msgsnd(pTHX_ SV **mark, SV **sp)
     SETERRNO(0,0);
     return msgsnd(id, (struct msgbuf *)mbuf, msize, flags);
 #else
+    PERL_UNUSED_ARG(sp);
+    PERL_UNUSED_ARG(mark);
     Perl_croak(aTHX_ "msgsnd not implemented");
 #endif
 }
@@ -2198,6 +2170,8 @@ Perl_do_msgrcv(pTHX_ SV **mark, SV **sp)
     }
     return ret;
 #else
+    PERL_UNUSED_ARG(sp);
+    PERL_UNUSED_ARG(mark);
     Perl_croak(aTHX_ "msgrcv not implemented");
 #endif
 }
@@ -2270,7 +2244,8 @@ 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 || (size_t)mpos + msize > shmds.shm_segsz) {
+    if (mpos < 0 || msize < 0
+       || (size_t)mpos + msize > (size_t)shmds.shm_segsz) {
        SETERRNO(EFAULT,SS_ACCVIO);             /* can't do as caller requested */
        return -1;
     }
@@ -2278,7 +2253,7 @@ Perl_do_shmio(pTHX_ I32 optype, SV **mark, SV **sp)
     if (shm == (char *)-1)     /* I hate System V IPC, I really do */
        return -1;
     if (optype == OP_SHMREAD) {
-       const char *mbuf;
+       char *mbuf;
        /* suppress warning when reading into undef var (tchrist 3/Mar/00) */
        if (! SvOK(mstr))
            sv_setpvn(mstr, "", 0);
@@ -2295,12 +2270,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 = ((I32)len > msize) ? msize : (I32)len;
        Copy(mbuf, shm + mpos, n, char);
        if (n < msize)
            memzero(shm + mpos + n, msize - n);