blead 25801: Symbian batch of today

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

diff --git a/doio.c b/doio.c
index 61a5371..aa664a2 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -59,7 +59,7 @@
 #include <signal.h>
 
 bool
-Perl_do_open(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
+Perl_do_open(pTHX_ GV *gv, register const char *name, I32 len, int as_raw,
             int rawmode, int rawperm, PerlIO *supplied_fp)
 {
     return do_openn(gv, name, len, as_raw, rawmode, rawperm,
@@ -67,7 +67,7 @@ Perl_do_open(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 }
 
 bool
-Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
+Perl_do_open9(pTHX_ GV *gv, register const char *name, I32 len, int as_raw,
              int rawmode, int rawperm, PerlIO *supplied_fp, SV *svs,
              I32 num_svs)
 {
@@ -77,7 +77,7 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 }
 
 bool
-Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
+Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
              int rawmode, int rawperm, PerlIO *supplied_fp, SV **svp,
              I32 num_svs)
 {
@@ -194,7 +194,7 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 
         IoTYPE(io) = PerlIO_intmode2str(rawmode, &mode[ix], &writing);
 
-       namesv = sv_2mortal(newSVpvn(name,strlen(name)));
+       namesv = sv_2mortal(newSVpvn(oname,strlen(oname)));
        num_svs = 1;
        svp = &namesv;
         type = Nullch;
@@ -202,13 +202,13 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
     }
     else {
        /* Regular (non-sys) open */
-       char *oname = name;
+       char *name;
        STRLEN olen = len;
        char *tend;
        int dodup = 0;
        PerlIO *that_fp = NULL;
 
-       type = savepvn(name, len);
+       type = savepvn(oname, len);
        tend = type+len;
        SAVEFREEPV(type);
 
@@ -220,7 +220,7 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
        if (num_svs) {
            /* New style explicit name, type is just mode and layer info */
 #ifdef USE_STDIO
-           if (SvROK(*svp) && !strchr(name,'&')) {
+           if (SvROK(*svp) && !strchr(oname,'&')) {
                if (ckWARN(WARN_IO))
                    Perl_warner(aTHX_ packWARN(WARN_IO),
                            "Can't open a reference");
@@ -408,7 +408,7 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
                        else
                            was_fdopen = TRUE;
                        if (!(fp = PerlIO_openn(aTHX_ type,mode,fd,0,0,NULL,num_svs,svp))) {
-                           if (dodup)
+                           if (dodup && fd >= 0)
                                PerlLIO_close(fd);
                        }
                    }
@@ -566,8 +566,9 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
        }
     }
     if (!fp) {
-       if (IoTYPE(io) == IoTYPE_RDONLY && strchr(name, '\n')
-           && ckWARN(WARN_NEWLINE)
+       if (IoTYPE(io) == IoTYPE_RDONLY && ckWARN(WARN_NEWLINE)
+           && strchr(oname, '\n')
+           
        )
            Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "open");
        goto say_false;
@@ -746,7 +747,7 @@ Perl_nextargv(pTHX_ register GV *gv)
 #endif
     Uid_t fileuid;
     Gid_t filegid;
-    IO *io = GvIOp(gv);
+    IO * const io = GvIOp(gv);
 
     if (!PL_argvoutgv)
        PL_argvoutgv = gv_fetchpv("ARGVOUT",TRUE,SVt_PVIO);
@@ -801,9 +802,9 @@ Perl_nextargv(pTHX_ register GV *gv)
                    continue;
                }
                if (*PL_inplace) {
-                   char *star = strchr(PL_inplace, '*');
+                   const char *star = strchr(PL_inplace, '*');
                    if (star) {
-                       char *begin = PL_inplace;
+                       const char *begin = PL_inplace;
                        sv_setpvn(sv, "", 0);
                        do {
                            sv_catpvn(sv, begin, star - begin);
@@ -1042,7 +1043,7 @@ Perl_io_close(pTHX_ IO *io, bool not_implicit)
        if (IoTYPE(io) == IoTYPE_PIPE) {
            const int status = PerlProc_pclose(IoIFP(io));
            if (not_implicit) {
-               STATUS_NATIVE_SET(status);
+               STATUS_NATIVE_CHILD_SET(status);
                retval = (STATUS_UNIX == 0);
            }
            else {
@@ -1307,8 +1308,7 @@ Perl_do_print(pTHX_ register SV *sv, PerlIO *fp)
        return TRUE;
     case SVt_IV:
        if (SvIOK(sv)) {
-           if (SvGMAGICAL(sv))
-               mg_get(sv);
+           SvGETMAGIC(sv);
            if (SvIsUV(sv))
                PerlIO_printf(fp, "%"UVuf, (UV)SvUVX(sv));
            else
@@ -1394,7 +1394,7 @@ Perl_my_stat(pTHX)
        s = SvPVX_const(PL_statname);           /* s now NUL-terminated */
        PL_laststype = OP_STAT;
        PL_laststatval = PerlLIO_stat(s, &PL_statcache);
-       if (PL_laststatval < 0 && strchr(s, '\n') && ckWARN(WARN_NEWLINE))
+       if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && strchr(s, '\n'))
            Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "stat");
        return PL_laststatval;
     }
@@ -1454,7 +1454,7 @@ Perl_do_aexec5(pTHX_ SV *really, register SV **mark, register SV **sp,
               int fd, int do_report)
 {
     dVAR;
-#if defined(MACOS_TRADITIONAL) || defined(SYMBIAN)
+#if defined(MACOS_TRADITIONAL) || defined(__SYMBIAN32__)
     Perl_croak(aTHX_ "exec? I'm not *that* kind of operating system");
 #else
     if (sp > mark) {
@@ -1505,20 +1505,28 @@ Perl_do_execfree(pTHX)
     PL_Cmd = Nullch;
 }
 
-#if !defined(OS2) && !defined(WIN32) && !defined(DJGPP) && !defined(EPOC) && !defined(SYMBIAN) && !defined(MACOS_TRADITIONAL)
+#if !defined(OS2) && !defined(WIN32) && !defined(DJGPP) && !defined(EPOC) && !defined(__SYMBIAN32__) && !defined(MACOS_TRADITIONAL)
 
 bool
-Perl_do_exec(pTHX_ char *cmd)
+Perl_do_exec(pTHX_ const char *cmd)
 {
     return do_exec3(cmd,0,0);
 }
 
 bool
-Perl_do_exec3(pTHX_ char *cmd, int fd, int do_report)
+Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report)
 {
     dVAR;
     register char **a;
     register char *s;
+    char *cmd;
+    int cmdlen;
+
+    /* Make a copy so we can change it */
+    cmdlen = strlen(incmd);
+    Newx(cmd, cmdlen+1, char);
+    strncpy(cmd, incmd, cmdlen);
+    cmd[cmdlen] = 0;
 
     while (*cmd && isSPACE(*cmd))
        cmd++;
@@ -1559,6 +1567,7 @@ Perl_do_exec3(pTHX_ char *cmd, int fd, int do_report)
                  PerlProc_execl(PL_cshname,"csh", flags, ncmd, (char*)0);
                  PERL_FPU_POST_EXEC
                  *s = '\'';
+                 Safefree(cmd);
                  return FALSE;
              }
          }
@@ -1603,6 +1612,7 @@ Perl_do_exec3(pTHX_ char *cmd, int fd, int do_report)
            PERL_FPU_PRE_EXEC
            PerlProc_execl(PL_sh_path, "sh", "-c", cmd, (char*)0);
            PERL_FPU_POST_EXEC
+           Safefree(cmd);
            return FALSE;
        }
     }
@@ -1639,6 +1649,7 @@ Perl_do_exec3(pTHX_ char *cmd, int fd, int do_report)
        }
     }
     do_execfree();
+    Safefree(cmd);
     return FALSE;
 }
 
@@ -1687,7 +1698,7 @@ Perl_apply(pTHX_ I32 type, register SV **mark, register SV **sp)
                        if (fchmod(PerlIO_fileno(IoIFP(GvIOn(gv))), val))
                            tot--;
 #else
-                       DIE(aTHX_ PL_no_func, "fchmod");
+                       Perl_die(aTHX_ PL_no_func, "fchmod");
 #endif
                    }
                    else {
@@ -1728,7 +1739,7 @@ Perl_apply(pTHX_ I32 type, register SV **mark, register SV **sp)
                        if (fchown(PerlIO_fileno(IoIFP(GvIOn(gv))), val, val2))
                            tot--;
 #else
-                       DIE(aTHX_ PL_no_func, "fchown");
+                       Perl_die(aTHX_ PL_no_func, "fchown");
 #endif
                    }
                    else {
@@ -2332,7 +2343,7 @@ PerlIO *
 Perl_start_glob (pTHX_ SV *tmpglob, IO *io)
 {
     dVAR;
-    SV *tmpcmd = NEWSV(55, 0);
+    SV * const tmpcmd = NEWSV(55, 0);
     PerlIO *fp;
     ENTER;
     SAVEFREESV(tmpcmd);