[perl #36199] [PATCH] 5.8.7 fails to build with parallel make
[p5sagit/p5-mst-13.2.git] / doio.c
diff --git a/doio.c b/doio.c
index f5f149b..3a0bad0 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -103,7 +103,7 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
     /* Collect default raw/crlf info from the op */
     if (PL_op && PL_op->op_type == OP_OPEN) {
        /* set up IO layers */
-       U8 flags = PL_op->op_private;
+       const U8 flags = PL_op->op_private;
        in_raw = (flags & OPpOPEN_IN_RAW);
        in_crlf = (flags & OPpOPEN_IN_CRLF);
        out_raw = (flags & OPpOPEN_OUT_RAW);
@@ -213,7 +213,6 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
        SAVEFREEPV(type);
 
         /* Lose leading and trailing white space */
-        /*SUPPRESS 530*/
         for (; isSPACE(*type); type++) ;
         while (tend > type && isSPACE(tend[-1]))
            *--tend = '\0';
@@ -253,7 +252,6 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
                }
                type++;
            }
-           /*SUPPRESS 530*/
            for (type++; isSPACE(*type); type++) ;
            if (!num_svs) {
                name = type;
@@ -341,7 +339,6 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
                    if (num_svs > 1) {
                        Perl_croak(aTHX_ "More than one argument to '%c&' open",IoTYPE(io));
                    }
-                   /*SUPPRESS 530*/
                    for (; isSPACE(*type); type++) ;
                    if (num_svs && (SvIOK(*svp) || (SvPOK(*svp) && looks_like_number(*svp)))) {
                        fd = SvUV(*svp);
@@ -418,10 +415,8 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
                }
            } /* & */
            else {
-               /*SUPPRESS 530*/
                for (; isSPACE(*type); type++) ;
                if (*type == IoTYPE_STD && (!type[1] || isSPACE(type[1]) || type[1] == ':')) {
-                   /*SUPPRESS 530*/
                    type++;
                    fp = PerlIO_stdout();
                    IoTYPE(io) = IoTYPE_STD;
@@ -443,7 +438,6 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
               goto unknown_open_mode;
        } /* IoTYPE_WRONLY */
        else if (*type == IoTYPE_RDONLY) {
-           /*SUPPRESS 530*/
            for (type++; isSPACE(*type); type++) ;
            mode[0] = 'r';
 #ifdef HAS_STRLCAT
@@ -461,7 +455,6 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
                goto duplicity;
            }
            if (*type == IoTYPE_STD && (!type[1] || isSPACE(type[1]) || type[1] == ':')) {
-               /*SUPPRESS 530*/
                type++;
                fp = PerlIO_stdin();
                IoTYPE(io) = IoTYPE_STD;
@@ -491,8 +484,8 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
                *--tend = '\0';
                while (tend > type && isSPACE(tend[-1]))
                    *--tend = '\0';
-               /*SUPPRESS 530*/
-               for (; isSPACE(*type); type++) ;
+               for (; isSPACE(*type); type++)
+                   ;
                name = type;
                len  = tend-type;
            }
@@ -541,8 +534,8 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
                goto unknown_open_mode;
            name = type;
            IoTYPE(io) = IoTYPE_RDONLY;
-           /*SUPPRESS 530*/
-           for (; isSPACE(*name); name++) ;
+           for (; isSPACE(*name); name++)
+               ;
            mode[0] = 'r';
 
 #ifdef HAS_STRLCAT
@@ -673,11 +666,11 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 
                 LOCK_FDPID_MUTEX;
                 sv = *av_fetch(PL_fdpid,fd,TRUE);
-                (void)SvUPGRADE(sv, SVt_IV);
+                SvUPGRADE(sv, SVt_IV);
                 pid = SvIVX(sv);
                 SvIV_set(sv, 0);
                 sv = *av_fetch(PL_fdpid,savefd,TRUE);
-                (void)SvUPGRADE(sv, SVt_IV);
+                SvUPGRADE(sv, SVt_IV);
                 SvIV_set(sv, pid);
                 UNLOCK_FDPID_MUTEX;
             }
@@ -852,7 +845,8 @@ Perl_nextargv(pTHX_ register GV *gv)
                    do_close(gv,FALSE);
                    (void)PerlLIO_unlink(SvPVX_const(sv));
                    (void)PerlLIO_rename(PL_oldname,SvPVX_const(sv));
-                   do_open(gv,SvPVX(sv),SvCUR(sv),PL_inplace!=0,O_RDONLY,0,Nullfp);
+                   do_open(gv,(char*)SvPVX_const(sv),SvCUR(sv),PL_inplace!=0,
+                           O_RDONLY,0,Nullfp);
 #endif /* DOSISH */
 #else
                    (void)UNLINK(SvPVX_const(sv));
@@ -888,11 +882,12 @@ Perl_nextargv(pTHX_ register GV *gv)
                sv_catpvn(sv,PL_oldname,oldlen);
                SETERRNO(0,0);          /* in case sprintf set errno */
 #ifdef VMS
-               if (!do_open(PL_argvoutgv,SvPVX(sv),SvCUR(sv),PL_inplace!=0,
-                 O_WRONLY|O_CREAT|O_TRUNC,0,Nullfp))
+               if (!do_open(PL_argvoutgv,(char*)SvPVX_const(sv),SvCUR(sv),
+                            PL_inplace!=0,O_WRONLY|O_CREAT|O_TRUNC,0,Nullfp))
 #else
-               if (!do_open(PL_argvoutgv,SvPVX(sv),SvCUR(sv),PL_inplace!=0,
-                            O_WRONLY|O_CREAT|OPEN_EXCL,0666,Nullfp))
+                   if (!do_open(PL_argvoutgv,(char*)SvPVX_const(sv),SvCUR(sv),
+                            PL_inplace!=0,O_WRONLY|O_CREAT|OPEN_EXCL,0666,
+                            Nullfp))
 #endif
                {
                    if (ckWARN_d(WARN_INPLACE)) 
@@ -1176,7 +1171,7 @@ Perl_mode_from_discipline(pTHX_ SV *discp)
     int mode = O_BINARY;
     if (discp) {
        STRLEN len;
-       const char *s = SvPV(discp,len);
+       const char *s = SvPV_const(discp,len);
        while (*s) {
            if (*s == ':') {
                switch (s[1]) {
@@ -1345,7 +1340,7 @@ Perl_do_print(pTHX_ register SV *sv, PerlIO *fp)
                Perl_warner(aTHX_ packWARN(WARN_UTF8), "Wide character in print");
            }
        }
-       tmps = SvPV(sv, len);
+       tmps = SvPV_const(sv, len);
        break;
     }
     /* To detect whether the process is about to overstep its
@@ -1404,7 +1399,7 @@ Perl_my_stat(pTHX)
            goto do_fstat;
        }
 
-       s = SvPV(sv, len);
+       s = SvPV_const(sv, len);
        PL_statgv = Nullgv;
        sv_setpvn(PL_statname, s, len);
        s = SvPVX_const(PL_statname);           /* s now NUL-terminated */
@@ -1423,7 +1418,6 @@ Perl_my_lstat(pTHX)
 {
     dSP;
     SV *sv;
-    STRLEN n_a;
     if (PL_op->op_flags & OPf_REF) {
        EXTEND(SP,1);
        if (cGVOP_gv == PL_defgv) {
@@ -1451,9 +1445,9 @@ Perl_my_lstat(pTHX)
        return (PL_laststatval = -1);
     }
     /* XXX Do really need to be calling SvPV() all these times? */
-    sv_setpv(PL_statname,SvPV(sv, n_a));
-    PL_laststatval = PerlLIO_lstat(SvPV(sv, n_a),&PL_statcache);
-    if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && strchr(SvPV(sv, n_a), '\n'))
+    sv_setpv(PL_statname,SvPV_nolen_const(sv));
+    PL_laststatval = PerlLIO_lstat(SvPV_nolen_const(sv),&PL_statcache);
+    if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && strchr(SvPV_nolen_const(sv), '\n'))
        Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "lstat");
     return PL_laststatval;
 }
@@ -1476,20 +1470,19 @@ Perl_do_aexec5(pTHX_ SV *really, register SV **mark, register SV **sp,
 #else
     register char **a;
     const char *tmps = Nullch;
-    STRLEN n_a;
 
     if (sp > mark) {
        New(401,PL_Argv, sp - mark + 1, char*);
        a = PL_Argv;
        while (++mark <= sp) {
            if (*mark)
-               *a++ = SvPVx(*mark, n_a);
+               *a++ = (char*)SvPV_nolen_const(*mark);
            else
                *a++ = "";
        }
        *a = Nullch;
        if (really)
-           tmps = SvPV(really, n_a);
+           tmps = SvPV_nolen_const(really);
        if ((!really && *PL_Argv[0] != '/') ||
            (really && *tmps != '/'))           /* will execvp use PATH? */
            TAINT_ENV();                /* testing IFS here is overkill, probably */
@@ -1672,9 +1665,8 @@ Perl_apply(pTHX_ I32 type, register SV **mark, register SV **sp)
     register I32 val;
     register I32 tot = 0;
     const char *what;
-    char *s;
+    const char *s;
     SV **oldmark = mark;
-    STRLEN n_a;
 
 #define APPLY_TAINT_PROPER() \
     STMT_START {                                                       \
@@ -1700,7 +1692,7 @@ Perl_apply(pTHX_ I32 type, register SV **mark, register SV **sp)
            APPLY_TAINT_PROPER();
            tot = sp - mark;
            while (++mark <= sp) {
-               const char *name = SvPVx(*mark, n_a);
+               const char *name = SvPV_nolen_const(*mark);
                APPLY_TAINT_PROPER();
                if (PerlLIO_chmod(name, val))
                    tot--;
@@ -1718,7 +1710,7 @@ Perl_apply(pTHX_ I32 type, register SV **mark, register SV **sp)
            APPLY_TAINT_PROPER();
            tot = sp - mark;
            while (++mark <= sp) {
-               const char *name = SvPVx(*mark, n_a);
+               const char *name = SvPV_nolen_const(*mark);
                APPLY_TAINT_PROPER();
                if (PerlLIO_chown(name, val, val2))
                    tot--;
@@ -1738,7 +1730,7 @@ nothing in the core.
        APPLY_TAINT_PROPER();
        if (mark == sp)
            break;
-       s = SvPVx(*++mark, n_a);
+       s = SvPVx_nolen_const(*++mark);
        if (isALPHA(*s)) {
            if (*s == 'S' && s[1] == 'I' && s[2] == 'G')
                s += 3;
@@ -1808,7 +1800,7 @@ nothing in the core.
        APPLY_TAINT_PROPER();
        tot = sp - mark;
        while (++mark <= sp) {
-           s = SvPVx(*mark, n_a);
+           s = SvPV_nolen_const(*mark);
            APPLY_TAINT_PROPER();
            if (PL_euid || PL_unsafe) {
                if (UNLINK(s))
@@ -1862,8 +1854,7 @@ nothing in the core.
            APPLY_TAINT_PROPER();
            tot = sp - mark;
            while (++mark <= sp) {
-               STRLEN n_a;
-               const char *name = SvPVx(*mark, n_a);
+               const char *name = SvPV_nolen_const(*mark);
                APPLY_TAINT_PROPER();
                if (PerlLIO_utime(name, utbufp))
                    tot--;
@@ -1883,7 +1874,7 @@ nothing in the core.
 #ifndef VMS /* VMS' cando is in vms.c */
 bool
 Perl_cando(pTHX_ Mode_t mode, Uid_t effective, register const Stat_t *statbufp)
-/* Note: we use `effective' both for uids and gids.
+/* Note: we use "effective" both for uids and gids.
  * Here we are betting on Uid_t being equal or wider than Gid_t.  */
 {
 #ifdef DOSISH
@@ -2000,7 +1991,8 @@ Perl_do_ipcctl(pTHX_ I32 optype, SV **mark, SV **sp)
 {
     SV *astr;
     char *a;
-    I32 infosize, getinfo;
+    STRLEN infosize;
+    I32 getinfo;
     I32 ret = -1;
     const I32 id  = SvIVx(*++mark);
     const I32 n   = (optype == OP_SEMCTL) ? SvIVx(*++mark) : 0;
@@ -2059,14 +2051,14 @@ Perl_do_ipcctl(pTHX_ I32 optype, SV **mark, SV **sp)
 
     if (infosize)
     {
-       STRLEN len;
        if (getinfo)
        {
-           SvPV_force(astr, len);
+           SvPV_force_nolen(astr);
            a = SvGROW(astr, infosize+1);
        }
        else
        {
+           STRLEN len;
            a = SvPV(astr, len);
            if (len != infosize)
                Perl_croak(aTHX_ "Bad arg length for %s, is %lu, should be %ld",
@@ -2124,7 +2116,7 @@ Perl_do_msgsnd(pTHX_ SV **mark, SV **sp)
 {
 #ifdef HAS_MSG
     SV *mstr;
-    char *mbuf;
+    const char *mbuf;
     I32 msize, flags;
     STRLEN len;
     const I32 id = SvIVx(*++mark);
@@ -2132,7 +2124,7 @@ Perl_do_msgsnd(pTHX_ SV **mark, SV **sp)
 
     mstr = *++mark;
     flags = SvIVx(*++mark);
-    mbuf = SvPV(mstr, len);
+    mbuf = SvPV_const(mstr, len);
     if ((msize = len - sizeof(long)) < 0)
        Perl_croak(aTHX_ "Arg too short for msgsnd");
     SETERRNO(0,0);
@@ -2150,7 +2142,6 @@ Perl_do_msgrcv(pTHX_ SV **mark, SV **sp)
     char *mbuf;
     long mtype;
     I32 msize, flags, ret;
-    STRLEN len;
     const I32 id = SvIVx(*++mark);
     (void)sp;
 
@@ -2161,7 +2152,7 @@ Perl_do_msgrcv(pTHX_ SV **mark, SV **sp)
     msize = SvIVx(*++mark);
     mtype = (long)SvIVx(*++mark);
     flags = SvIVx(*++mark);
-    SvPV_force(mstr, len);
+    SvPV_force_nolen(mstr);
     mbuf = SvGROW(mstr, sizeof(long)+msize+1);
 
     SETERRNO(0,0);
@@ -2185,13 +2176,13 @@ Perl_do_semop(pTHX_ SV **mark, SV **sp)
 {
 #ifdef HAS_SEM
     SV *opstr;
-    char *opbuf;
+    const char *opbuf;
     STRLEN opsize;
     const I32 id = SvIVx(*++mark);
     (void)sp;
 
     opstr = *++mark;
-    opbuf = SvPV(opstr, opsize);
+    opbuf = SvPV_const(opstr, opsize);
     if (opsize < 3 * SHORTSIZE
        || (opsize % (3 * SHORTSIZE))) {
        SETERRNO(EINVAL,LIB_INVARG);
@@ -2240,7 +2231,6 @@ Perl_do_shmio(pTHX_ I32 optype, SV **mark, SV **sp)
     SV *mstr;
     char *shm;
     I32 mpos, msize;
-    STRLEN len;
     struct shmid_ds shmds;
     const I32 id = SvIVx(*++mark);
     (void)sp;
@@ -2263,7 +2253,7 @@ Perl_do_shmio(pTHX_ I32 optype, SV **mark, SV **sp)
        /* suppress warning when reading into undef var (tchrist 3/Mar/00) */
        if (! SvOK(mstr))
            sv_setpvn(mstr, "", 0);
-       SvPV_force(mstr, len);
+       SvPV_force_nolen(mstr);
        mbuf = SvGROW(mstr, msize+1);
 
        Copy(shm + mpos, mbuf, msize, char);
@@ -2277,8 +2267,9 @@ Perl_do_shmio(pTHX_ I32 optype, SV **mark, SV **sp)
     }
     else {
        I32 n;
+       STRLEN len;
 
-       const char *mbuf = SvPV(mstr, len);
+       const char *mbuf = SvPV_const(mstr, len);
        if ((n = len) > msize)
            n = msize;
        Copy(mbuf, shm + mpos, n, char);
@@ -2357,8 +2348,8 @@ Perl_start_glob (pTHX_ SV *tmpglob, IO *io)
        if ((tmpfp = PerlIO_tmpfile()) != NULL) {
            Stat_t st;
            if (!PerlLIO_stat(SvPVX_const(tmpglob),&st) && S_ISDIR(st.st_mode))
-               ok = ((wilddsc.dsc$a_pointer = tovmspath(SvPVX_const(tmpglob),vmsspec)) != NULL);
-           else ok = ((wilddsc.dsc$a_pointer = tovmsspec(SvPVX_const(tmpglob),vmsspec)) != NULL);
+               ok = ((wilddsc.dsc$a_pointer = tovmspath(SvPVX(tmpglob),vmsspec)) != NULL);
+           else ok = ((wilddsc.dsc$a_pointer = tovmsspec(SvPVX(tmpglob),vmsspec)) != NULL);
            if (ok) wilddsc.dsc$w_length = (unsigned short int) strlen(wilddsc.dsc$a_pointer);
            for (cp=wilddsc.dsc$a_pointer; ok && cp && *cp; cp++)
                if (*cp == '?') *cp = '%';  /* VMS style single-char wildcard */
@@ -2436,7 +2427,7 @@ Perl_start_glob (pTHX_ SV *tmpglob, IO *io)
 #endif /* !CSH */
 #endif /* !DOSISH */
 #endif /* MACOS_TRADITIONAL */
-    (void)do_open(PL_last_in_gv, SvPVX(tmpcmd), SvCUR(tmpcmd),
+    (void)do_open(PL_last_in_gv, (char*)SvPVX_const(tmpcmd), SvCUR(tmpcmd),
                  FALSE, O_RDONLY, 0, Nullfp);
     fp = IoIFP(io);
 #endif /* !VMS */