change #25129 was overzealous in delaying the call to ckWARN

[perl5.git] / doio.c

diff --git a/doio.c b/doio.c
index 3a0bad0..e9c40a7 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -71,7 +71,7 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
              int rawmode, int rawperm, PerlIO *supplied_fp, SV *svs,
              I32 num_svs)
 {
-    (void)num_svs;
+    PERL_UNUSED_ARG(num_svs);
     return do_openn(gv, name, len, as_raw, rawmode, rawperm,
                    supplied_fp, &svs, 1);
 }
@@ -82,7 +82,7 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
              I32 num_svs)
 {
     dVAR;
-    register IO *io = GvIOn(gv);
+    register IO * const io = GvIOn(gv);
     PerlIO *saveifp = Nullfp;
     PerlIO *saveofp = Nullfp;
     int savefd = -1;
@@ -566,7 +566,10 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
        }
     }
     if (!fp) {
-       if (ckWARN(WARN_NEWLINE) && IoTYPE(io) == IoTYPE_RDONLY && strchr(name, '\n'))
+       if (IoTYPE(io) == IoTYPE_RDONLY && ckWARN(WARN_NEWLINE)
+           && strchr(name, '\n')
+           
+       )
            Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "open");
        goto say_false;
     }
@@ -773,7 +776,7 @@ Perl_nextargv(pTHX_ register GV *gv)
        STRLEN oldlen;
        sv = av_shift(GvAV(gv));
        SAVEFREESV(sv);
-       sv_setsv(GvSV(gv),sv);
+       sv_setsv(GvSVn(gv),sv);
        SvSETMAGIC(GvSV(gv));
        PL_oldname = SvPVx(GvSV(gv), oldlen);
        if (do_open(gv,PL_oldname,oldlen,PL_inplace!=0,O_RDONLY,0,Nullfp)) {
@@ -1079,7 +1082,7 @@ Perl_do_eof(pTHX_ GV *gv)
 
     if (!io)
        return TRUE;
-    else if (ckWARN(WARN_IO) && (IoTYPE(io) == IoTYPE_WRONLY))
+    else if ((IoTYPE(io) == IoTYPE_WRONLY) && ckWARN(WARN_IO))
        report_evil_fh(gv, io, OP_phoney_OUTPUT_ONLY);
 
     while (IoIFP(io)) {
@@ -1298,19 +1301,6 @@ Perl_do_print(pTHX_ register SV *sv, PerlIO *fp)
     /* assuming fp is checked earlier */
     if (!sv)
        return TRUE;
-    if (PL_ofmt) {
-       if (SvGMAGICAL(sv))
-           mg_get(sv);
-        if (SvIOK(sv) && SvIVX(sv) != 0) {
-           PerlIO_printf(fp, PL_ofmt, (NV)SvIVX(sv));
-           return !PerlIO_error(fp);
-       }
-       if (  (SvNOK(sv) && SvNVX(sv) != 0.0)
-          || (looks_like_number(sv) && sv_2nv(sv) != 0.0) ) {
-           PerlIO_printf(fp, PL_ofmt, SvNVX(sv));
-           return !PerlIO_error(fp);
-       }
-    }
     switch (SvTYPE(sv)) {
     case SVt_NULL:
        if (ckWARN(WARN_UNINITIALIZED))
@@ -1431,8 +1421,8 @@ Perl_my_lstat(pTHX)
            return (PL_laststatval = -1);
        }
     }
-    else if (ckWARN(WARN_IO) && PL_laststype != OP_LSTAT
-           && (PL_op->op_private & OPpFT_STACKED))
+    else if (PL_laststype != OP_LSTAT
+           && (PL_op->op_private & OPpFT_STACKED) && ckWARN(WARN_IO))
        Perl_croak(aTHX_ no_prev_lstat);
 
     PL_laststype = OP_LSTAT;
@@ -1468,12 +1458,12 @@ Perl_do_aexec5(pTHX_ SV *really, register SV **mark, register SV **sp,
 #if defined(MACOS_TRADITIONAL) || defined(SYMBIAN)
     Perl_croak(aTHX_ "exec? I'm not *that* kind of operating system");
 #else
-    register char **a;
-    const char *tmps = Nullch;
-
     if (sp > mark) {
-       New(401,PL_Argv, sp - mark + 1, char*);
+       char **a;
+       const char *tmps = Nullch;
+       Newx(PL_Argv, sp - mark + 1, char*);
        a = PL_Argv;
+
        while (++mark <= sp) {
            if (*mark)
                *a++ = (char*)SvPV_nolen_const(*mark);
@@ -1510,14 +1500,10 @@ Perl_do_aexec5(pTHX_ SV *really, register SV **mark, register SV **sp,
 void
 Perl_do_execfree(pTHX)
 {
-    if (PL_Argv) {
-       Safefree(PL_Argv);
-       PL_Argv = Null(char **);
-    }
-    if (PL_Cmd) {
-       Safefree(PL_Cmd);
-       PL_Cmd = Nullch;
-    }
+    Safefree(PL_Argv);
+    PL_Argv = Null(char **);
+    Safefree(PL_Cmd);
+    PL_Cmd = Nullch;
 }
 
 #if !defined(OS2) && !defined(WIN32) && !defined(DJGPP) && !defined(EPOC) && !defined(SYMBIAN) && !defined(MACOS_TRADITIONAL)
@@ -1622,7 +1608,7 @@ Perl_do_exec3(pTHX_ char *cmd, int fd, int do_report)
        }
     }
 
-    New(402,PL_Argv, (s - cmd) / 2 + 2, char*);
+    Newx(PL_Argv, (s - cmd) / 2 + 2, char*);
     PL_Cmd = savepvn(cmd, s-cmd);
     a = PL_Argv;
     for (s = PL_Cmd; *s;) {
@@ -1666,7 +1652,7 @@ Perl_apply(pTHX_ I32 type, register SV **mark, register SV **sp)
     register I32 tot = 0;
     const char *what;
     const char *s;
-    SV **oldmark = mark;
+    SV ** const oldmark = mark;
 
 #define APPLY_TAINT_PROPER() \
     STMT_START {                                                       \
@@ -1692,10 +1678,33 @@ Perl_apply(pTHX_ I32 type, register SV **mark, register SV **sp)
            APPLY_TAINT_PROPER();
            tot = sp - mark;
            while (++mark <= sp) {
-               const char *name = SvPV_nolen_const(*mark);
-               APPLY_TAINT_PROPER();
-               if (PerlLIO_chmod(name, val))
-                   tot--;
+                GV* gv;
+                if (SvTYPE(*mark) == SVt_PVGV) {
+                    gv = (GV*)*mark;
+               do_fchmod:
+                   if (GvIO(gv) && IoIFP(GvIOp(gv))) {
+#ifdef HAS_FCHMOD
+                       APPLY_TAINT_PROPER();
+                       if (fchmod(PerlIO_fileno(IoIFP(GvIOn(gv))), val))
+                           tot--;
+#else
+                       DIE(aTHX_ PL_no_func, "fchmod");
+#endif
+                   }
+                   else {
+                       tot--;
+                   }
+               }
+               else if (SvROK(*mark) && SvTYPE(SvRV(*mark)) == SVt_PVGV) {
+                   gv = (GV*)SvRV(*mark);
+                   goto do_fchmod;
+               }
+               else {
+                   const char *name = SvPV_nolen_const(*mark);
+                   APPLY_TAINT_PROPER();
+                   if (PerlLIO_chmod(name, val))
+                       tot--;
+               }
            }
        }
        break;
@@ -1710,10 +1719,33 @@ Perl_apply(pTHX_ I32 type, register SV **mark, register SV **sp)
            APPLY_TAINT_PROPER();
            tot = sp - mark;
            while (++mark <= sp) {
-               const char *name = SvPV_nolen_const(*mark);
-               APPLY_TAINT_PROPER();
-               if (PerlLIO_chown(name, val, val2))
-                   tot--;
+                GV* gv;
+                if (SvTYPE(*mark) == SVt_PVGV) {
+                    gv = (GV*)*mark;
+               do_fchown:
+                   if (GvIO(gv) && IoIFP(GvIOp(gv))) {
+#ifdef HAS_FCHOWN
+                       APPLY_TAINT_PROPER();
+                       if (fchown(PerlIO_fileno(IoIFP(GvIOn(gv))), val, val2))
+                           tot--;
+#else
+                       DIE(aTHX_ PL_no_func, "fchown");
+#endif
+                   }
+                   else {
+                       tot--;
+                   }
+               }
+               else if (SvROK(*mark) && SvTYPE(SvRV(*mark)) == SVt_PVGV) {
+                   gv = (GV*)SvRV(*mark);
+                   goto do_fchown;
+               }
+               else {
+                   const char *name = SvPV_nolen_const(*mark);
+                   APPLY_TAINT_PROPER();
+                   if (PerlLIO_chown(name, val, val2))
+                       tot--;
+               }
            }
        }
        break;
@@ -1854,7 +1886,7 @@ nothing in the core.
            APPLY_TAINT_PROPER();
            tot = sp - mark;
            while (++mark <= sp) {
-               const char *name = SvPV_nolen_const(*mark);
+               char *name = SvPV_nolen(*mark);
                APPLY_TAINT_PROPER();
                if (PerlLIO_utime(name, utbufp))
                    tot--;
@@ -1997,7 +2029,7 @@ Perl_do_ipcctl(pTHX_ I32 optype, SV **mark, SV **sp)
     const I32 id  = SvIVx(*++mark);
     const I32 n   = (optype == OP_SEMCTL) ? SvIVx(*++mark) : 0;
     const I32 cmd = SvIVx(*++mark);
-    (void)sp;
+    PERL_UNUSED_ARG(sp);
 
     astr = *++mark;
     infosize = 0;
@@ -2120,7 +2152,7 @@ Perl_do_msgsnd(pTHX_ SV **mark, SV **sp)
     I32 msize, flags;
     STRLEN len;
     const I32 id = SvIVx(*++mark);
-    (void)sp;
+    PERL_UNUSED_ARG(sp);
 
     mstr = *++mark;
     flags = SvIVx(*++mark);
@@ -2143,7 +2175,7 @@ Perl_do_msgrcv(pTHX_ SV **mark, SV **sp)
     long mtype;
     I32 msize, flags, ret;
     const I32 id = SvIVx(*++mark);
-    (void)sp;
+    PERL_UNUSED_ARG(sp);
 
     mstr = *++mark;
     /* suppress warning when reading into undef var --jhi */
@@ -2179,7 +2211,7 @@ Perl_do_semop(pTHX_ SV **mark, SV **sp)
     const char *opbuf;
     STRLEN opsize;
     const I32 id = SvIVx(*++mark);
-    (void)sp;
+    PERL_UNUSED_ARG(sp);
 
     opstr = *++mark;
     opbuf = SvPV_const(opstr, opsize);
@@ -2198,7 +2230,7 @@ Perl_do_semop(pTHX_ SV **mark, SV **sp)
         struct sembuf *temps, *t;
         I32 result;
 
-        New (0, temps, nsops, struct sembuf);
+        Newx (temps, nsops, struct sembuf);
         t = temps;
         while (i--) {
             t->sem_num = *o++;
@@ -2233,7 +2265,7 @@ Perl_do_shmio(pTHX_ I32 optype, SV **mark, SV **sp)
     I32 mpos, msize;
     struct shmid_ds shmds;
     const I32 id = SvIVx(*++mark);
-    (void)sp;
+    PERL_UNUSED_ARG(sp);
 
     mstr = *++mark;
     mpos = SvIVx(*++mark);
@@ -2314,7 +2346,8 @@ Perl_start_glob (pTHX_ SV *tmpglob, IO *io)
 #include <rmsdef.h>
        char rslt[NAM$C_MAXRSS+1+sizeof(unsigned short int)] = {'\0','\0'};
        char vmsspec[NAM$C_MAXRSS+1];
-       char *rstr = rslt + sizeof(unsigned short int), *begin, *end, *cp;
+       char * const rstr = rslt + sizeof(unsigned short int);
+       char *begin, *end, *cp;
        $DESCRIPTOR(dfltdsc,"SYS$DISK:[]*.*;");
        PerlIO *tmpfp;
        STRLEN i;