This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
fix type mismatch warning caused by return statement lurking in DIE macro
[perl5.git] / doio.c
diff --git a/doio.c b/doio.c
index a7dc9d9..8b9c6b2 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -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);
@@ -188,7 +188,6 @@ 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;
@@ -261,9 +260,9 @@ 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);
+                strlcat(mode, "b", PERL_MODE_MAX - 1);
             else if (out_crlf)
-                strlcat(mode, "t", PERL_MODE_MAX); 
+                strlcat(mode, "t", PERL_MODE_MAX - 1); 
 #else
            if (out_raw)
                strcat(mode, "b");
@@ -299,9 +298,9 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
 
 #ifdef HAS_STRLCAT
             if (out_raw)
-                strlcat(mode, "b", PERL_MODE_MAX);
+                strlcat(mode, "b", PERL_MODE_MAX - 1);
             else if (out_crlf)
-                strlcat(mode, "t", PERL_MODE_MAX);
+                strlcat(mode, "t", PERL_MODE_MAX - 1);
 #else
            if (out_raw)
                strcat(mode, "b");
@@ -321,6 +320,7 @@ 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));
                    }
@@ -339,8 +339,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);
                        }
@@ -432,9 +431,9 @@ 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);
+                strlcat(mode, "b", PERL_MODE_MAX - 1);
             else if (in_crlf)
-                strlcat(mode, "t", PERL_MODE_MAX);
+                strlcat(mode, "t", PERL_MODE_MAX - 1);
 #else
            if (in_raw)
                strcat(mode, "b");
@@ -493,9 +492,9 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
 
 #ifdef HAS_STRLCAT
             if (in_raw)
-                strlcat(mode, "b", PERL_MODE_MAX);
+                strlcat(mode, "b", PERL_MODE_MAX - 1);
             else if (in_crlf)
-                strlcat(mode, "t", PERL_MODE_MAX);
+                strlcat(mode, "t", PERL_MODE_MAX - 1);
 #else
            if (in_raw)
                strcat(mode, "b");
@@ -531,9 +530,9 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
 
 #ifdef HAS_STRLCAT
             if (in_raw)
-                strlcat(mode, "b", PERL_MODE_MAX);
+                strlcat(mode, "b", PERL_MODE_MAX - 1);
             else if (in_crlf)
-                strlcat(mode, "t", PERL_MODE_MAX);
+                strlcat(mode, "t", PERL_MODE_MAX - 1);
 #else
            if (in_raw)
                strcat(mode, "b");
@@ -939,7 +938,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;
@@ -1184,7 +1183,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)
@@ -1204,7 +1202,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;
@@ -1270,7 +1268,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;
@@ -1294,8 +1292,7 @@ Perl_do_print(pTHX_ register SV *sv, PerlIO *fp)
      * io the write failure can be delayed until the flush/close. --jhi */
     if (len && (PerlIO_write(fp,tmps,len) == 0))
        happy = FALSE;
-    if (tmpbuf)
-       Safefree(tmpbuf);
+    Safefree(tmpbuf);
     return happy ? !PerlIO_error(fp) : FALSE;
 }
 
@@ -1311,22 +1308,31 @@ 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);
-       }
+        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)) {
+#ifdef HAS_DIRFD
+                return (PL_laststatval = PerlLIO_fstat(dirfd(IoDIRP(io)), &PL_statcache));
+#else
+                Perl_die(aTHX_ PL_no_func, "dirfd");
+#endif
+            } 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;
@@ -1399,6 +1405,19 @@ 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)
@@ -1431,15 +1450,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
@@ -1491,7 +1502,7 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report)
          if (*s == 'f') {
              s++;
 #ifdef HAS_STRLCPY
-              strlcat(flags, "f", PERL_FLAGS_MAX);
+              strlcat(flags, "f", PERL_FLAGS_MAX - 2);
 #else
              strcat(flags,"f");
 #endif
@@ -1508,9 +1519,10 @@ 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, NULL);
                  PERL_FPU_POST_EXEC
                  *s = '\'';
+                 S_exec_failed(aTHX_ PL_cshname, fd, do_report);
                  Safefree(cmd);
                  return FALSE;
              }
@@ -1556,8 +1568,9 @@ 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, NULL);
            PERL_FPU_POST_EXEC
+           S_exec_failed(aTHX_ PL_sh_path, fd, do_report);
            Safefree(cmd);
            return FALSE;
        }
@@ -1585,14 +1598,7 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report)
            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);
@@ -2308,12 +2314,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 = (len > msize) ? msize : len;
        Copy(mbuf, shm + mpos, n, char);
        if (n < msize)
            memzero(shm + mpos + n, msize - n);
Unnamed repository; edit this file 'description' to name the repository.