Update version to 0.9916

[perl5.git] / doio.c

diff --git a/doio.c b/doio.c
index 6bceb29..856b19a 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -772,7 +772,7 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname,
        fd = PerlIO_fileno(fp);
     }
 #if defined(HAS_FCNTL) && defined(F_SETFD) && defined(FD_CLOEXEC)
-    if (fd > PL_maxsysfd && fcntl(fd, F_SETFD, FD_CLOEXEC) < 0) {
+    if (fd >= 0 && fd > PL_maxsysfd && fcntl(fd, F_SETFD, FD_CLOEXEC) < 0) {
         PerlLIO_close(fd);
         goto say_false;
     }
@@ -808,9 +808,13 @@ PerlIO *
 Perl_nextargv(pTHX_ GV *gv, bool nomagicopen)
 {
     IO * const io = GvIOp(gv);
+    SV *const old_out_name = PL_inplace ? newSVsv(GvSV(gv)) : NULL;
 
     PERL_ARGS_ASSERT_NEXTARGV;
 
+    if (old_out_name)
+        SAVEFREESV(old_out_name);
+
     if (!PL_argvoutgv)
        PL_argvoutgv = gv_fetchpvs("ARGVOUT", GV_ADD|GV_NOTQUAL, SVt_PVIO);
     if (io && (IoFLAGS(io) & (IOf_ARGV|IOf_START)) == (IOf_ARGV|IOf_START)) {
@@ -835,6 +839,7 @@ Perl_nextargv(pTHX_ GV *gv, bool nomagicopen)
     if (!GvAV(gv))
        return NULL;
     while (av_tindex(GvAV(gv)) >= 0) {
+       Stat_t statbuf;
        STRLEN oldlen;
         SV *const sv = av_shift(GvAV(gv));
        SAVEFREESV(sv);
@@ -851,6 +856,13 @@ Perl_nextargv(pTHX_ GV *gv, bool nomagicopen)
             }
         }
         else {
+            {
+                IO * const io = GvIOp(PL_argvoutgv);
+                if (io && IoIFP(io) && old_out_name && !io_close(io, PL_argvoutgv, FALSE, FALSE)) {
+                    Perl_croak(aTHX_ "Failed to close in-place edit file %"SVf": %s\n",
+                               old_out_name, Strerror(errno));
+                }
+            }
             /* This very long block ends with return IoIFP(GvIOp(gv));
                Both this block and the block above fall through on open
                failure to the warning code, and then the while loop above tries
@@ -976,13 +988,13 @@ Perl_nextargv(pTHX_ GV *gv, bool nomagicopen)
                setdefout(PL_argvoutgv);
                PL_lastfd = PerlIO_fileno(IoIFP(GvIOp(PL_argvoutgv)));
                 if (PL_lastfd >= 0) {
-                    (void)PerlLIO_fstat(PL_lastfd,&PL_statbuf);
+                    (void)PerlLIO_fstat(PL_lastfd,&statbuf);
 #ifdef HAS_FCHMOD
                     (void)fchmod(PL_lastfd,PL_filemode);
 #else
                     (void)PerlLIO_chmod(PL_oldname,PL_filemode);
 #endif
-                    if (fileuid != PL_statbuf.st_uid || filegid != PL_statbuf.st_gid) {
+                    if (fileuid != statbuf.st_uid || filegid != statbuf.st_gid) {
                         /* XXX silently ignore failures */
 #ifdef HAS_FCHOWN
                         PERL_UNUSED_RESULT(fchown(PL_lastfd,fileuid,filegid));
@@ -999,8 +1011,8 @@ Perl_nextargv(pTHX_ GV *gv, bool nomagicopen)
 
         if (ckWARN_d(WARN_INPLACE)) {
             const int eno = errno;
-            if (PerlLIO_stat(PL_oldname, &PL_statbuf) >= 0
-                && !S_ISREG(PL_statbuf.st_mode)) {
+            if (PerlLIO_stat(PL_oldname, &statbuf) >= 0
+                && !S_ISREG(statbuf.st_mode)) {
                 Perl_warner(aTHX_ packWARN(WARN_INPLACE),
                             "Can't do inplace edit: %s is not a regular file",
                             PL_oldname);
@@ -1014,7 +1026,17 @@ Perl_nextargv(pTHX_ GV *gv, bool nomagicopen)
     if (io && (IoFLAGS(io) & IOf_ARGV))
        IoFLAGS(io) |= IOf_START;
     if (PL_inplace) {
-       (void)do_close(PL_argvoutgv,FALSE);
+        if (old_out_name) {
+            IO * const io = GvIOp(PL_argvoutgv);
+            if (io && IoIFP(io) && !io_close(io, PL_argvoutgv, FALSE, FALSE)) {
+                Perl_croak(aTHX_ "Failed to close in-place edit file %"SVf": %s\n",
+                           old_out_name, Strerror(errno));
+            }
+        }
+        else {
+            /* maybe this is no longer wanted */
+            (void)do_close(PL_argvoutgv,FALSE);
+        }
        if (io && (IoFLAGS(io) & IOf_ARGV)
            && PL_argvout_stack && AvFILLp(PL_argvout_stack) >= 0)
        {
@@ -1823,8 +1845,18 @@ Perl_apply(pTHX_ I32 type, SV **mark, SV **sp)
                         int fd = PerlIO_fileno(IoIFP(GvIOn(gv)));
                        APPLY_TAINT_PROPER();
                         if (fd < 0) {
-                            SETERRNO(EBADF,RMS_IFI);
+                           SETERRNO(EBADF,RMS_IFI);
+                           tot--;
+#if Uid_t_sign == 1
+                       } else if (val < 0) {
+                           SETERRNO(EINVAL,LIB_INVARG);
+                           tot--;
+#endif
+#if Gid_t_sign == 1
+                       } else if (val2 < 0) {
+                           SETERRNO(EINVAL,LIB_INVARG);
                            tot--;
+#endif
                         } else if (fchown(fd, val, val2))
                            tot--;
 #else
@@ -1934,11 +1966,12 @@ nothing in the core.
 #endif
            }
            else {      /* don't let root wipe out directories without -U */
-               if (PerlLIO_lstat(s,&PL_statbuf) < 0)
-                   tot--;
-               else if (S_ISDIR(PL_statbuf.st_mode)) {
+               Stat_t statbuf;
+               if (PerlLIO_lstat(s, &statbuf) < 0)
                    tot--;
+               else if (S_ISDIR(statbuf.st_mode)) {
                    SETERRNO(EISDIR, SS_NOPRIV);
+                   tot--;
                }
                else {
                    if (UNLINK(s))
@@ -2514,7 +2547,8 @@ Perl_do_shmio(pTHX_ I32 optype, SV **mark, SV **sp)
 
 Function called by C<do_readline> to spawn a glob (or do the glob inside
 perl on VMS).  This code used to be inline, but now perl uses C<File::Glob>
-this glob starter is only used by miniperl during the build process.
+this glob starter is only used by miniperl during the build process,
+or when PERL_EXTERNAL_GLOB is defined.
 Moving it away shrinks F<pp_hot.c>; shrinking F<pp_hot.c> helps speed perl up.
 
 =cut