Note the one mistake in perl.git's history, and the appropriate graft to remove it

[perl5.git] / perlio.c

diff --git a/perlio.c b/perlio.c
index 436bb85..50966e6 100644 (file)
--- a/perlio.c
+++ b/perlio.c
@@ -135,7 +135,7 @@ perlsio_binmode(FILE *fp, int iotype, int mode)
      * This used to be contents of do_binmode in doio.c
      */
 #ifdef DOSISH
-#  if defined(atarist) || defined(__MINT__)
+#  if defined(atarist)
     PERL_UNUSED_ARG(iotype);
     if (!fflush(fp)) {
         if (mode & O_BINARY)
@@ -807,7 +807,7 @@ PerlIO_find_layer(pTHX_ const char *name, STRLEN len, int load)
        } else {
            SV * const pkgsv = newSVpvs("PerlIO");
            SV * const layer = newSVpvn(name, len);
-           CV * const cv    = Perl_get_cvn_flags(aTHX_ STR_WITH_LEN("PerlIO::Layer::NoWarnings"), 0);
+           CV * const cv    = get_cvs("PerlIO::Layer::NoWarnings", 0);
            ENTER;
            SAVEINT(PL_in_load_module);
            if (cv) {
@@ -1773,10 +1773,7 @@ PerlIO_has_base(PerlIO *f)
 
          if (tab)
               return (tab->Get_base != NULL);
-         SETERRNO(EINVAL, LIB_INVARG);
      }
-     else
-         SETERRNO(EBADF, SS_IVCHAN);
 
      return 0;
 }
@@ -1784,15 +1781,14 @@ PerlIO_has_base(PerlIO *f)
 int
 PerlIO_fast_gets(PerlIO *f)
 {
-    if (PerlIOValid(f) && (PerlIOBase(f)->flags & PERLIO_F_FASTGETS)) {
-        const PerlIO_funcs * const tab = PerlIOBase(f)->tab;
+    if (PerlIOValid(f)) {
+        if (PerlIOBase(f)->flags & PERLIO_F_FASTGETS) {
+            const PerlIO_funcs * const tab = PerlIOBase(f)->tab;
 
-        if (tab)
-             return (tab->Set_ptrcnt != NULL);
-        SETERRNO(EINVAL, LIB_INVARG);
+            if (tab)
+                 return (tab->Set_ptrcnt != NULL);
+        }
     }
-    else
-        SETERRNO(EBADF, SS_IVCHAN);
 
     return 0;
 }
@@ -1805,10 +1801,7 @@ PerlIO_has_cntptr(PerlIO *f)
 
        if (tab)
             return (tab->Get_ptr != NULL && tab->Get_cnt != NULL);
-         SETERRNO(EINVAL, LIB_INVARG);
     }
-    else
-        SETERRNO(EBADF, SS_IVCHAN);
 
     return 0;
 }
@@ -1821,10 +1814,7 @@ PerlIO_canset_cnt(PerlIO *f)
 
          if (tab)
               return (tab->Set_ptrcnt != NULL);
-         SETERRNO(EINVAL, LIB_INVARG);
     }
-    else
-        SETERRNO(EBADF, SS_IVCHAN);
 
     return 0;
 }
@@ -2736,14 +2726,9 @@ PerlIOUnix_tell(pTHX_ PerlIO *f)
     return PerlLIO_lseek(PerlIOSelf(f, PerlIOUnix)->fd, 0, SEEK_CUR);
 }
 
-IV
-PerlIOUnix_close(pTHX_ PerlIO *f)
-{
-       return PerlIOBase_noop_ok(aTHX_ f);
-}
 
 IV
-PerlIOUnix_popped(pTHX_ PerlIO *f)
+PerlIOUnix_close(pTHX_ PerlIO *f)
 {
     dVAR;
     const int fd = PerlIOSelf(f, PerlIOUnix)->fd;
@@ -2777,7 +2762,7 @@ PERLIO_FUNCS_DECL(PerlIO_unix) = {
     sizeof(PerlIOUnix),
     PERLIO_K_RAW,
     PerlIOUnix_pushed,
-    PerlIOUnix_popped,
+    PerlIOBase_popped,
     PerlIOUnix_open,
     PerlIOBase_binmode,         /* binmode */
     NULL,
@@ -3038,7 +3023,9 @@ PerlIOStdio_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags)
        stdio = PerlSIO_fdopen(fd, PerlIO_modestr(o,mode));
     set_this:
        PerlIOSelf(f, PerlIOStdio)->stdio = stdio;
-       PerlIOUnix_refcnt_inc(fileno(stdio));
+        if(stdio) {
+           PerlIOUnix_refcnt_inc(fileno(stdio));
+        }
     }
     return f;
 }
@@ -3127,12 +3114,6 @@ PerlIOStdio_invalidate_fileno(pTHX_ FILE *f)
 IV
 PerlIOStdio_close(pTHX_ PerlIO *f)
 {
-       return PerlIOBase_noop_ok(aTHX_ f);
-}
-
-IV
-PerlIOStdio_popped(pTHX_ PerlIO *f)
-{
     FILE * const stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
     if (!stdio) {
        errno = EBADF;
@@ -3142,8 +3123,8 @@ PerlIOStdio_popped(pTHX_ PerlIO *f)
         const int fd = fileno(stdio);
        int invalidate = 0;
        IV result = 0;
-       int saveerr = 0;
        int dupfd = -1;
+       dSAVEDERRNO;
 #ifdef USE_ITHREADS
        dVAR;
 #endif
@@ -3177,7 +3158,7 @@ PerlIOStdio_popped(pTHX_ PerlIO *f)
               fileno slot of the FILE *
            */
            result = PerlIO_flush(f);
-           saveerr = errno;
+           SAVE_ERRNO;
            invalidate = PerlIOStdio_invalidate_fileno(aTHX_ stdio);
            if (!invalidate) {
 #ifdef USE_ITHREADS
@@ -3210,13 +3191,15 @@ PerlIOStdio_popped(pTHX_ PerlIO *f)
                }
 #endif
            }
+       } else {
+           SAVE_ERRNO;   /* This is here only to silence compiler warnings */
        }
         result = PerlSIO_fclose(stdio);
        /* We treat error from stdio as success if we invalidated
           errno may NOT be expected EBADF
         */
        if (invalidate && result != 0) {
-           errno = saveerr;
+           RESTORE_ERRNO;
            result = 0;
        }
 #ifdef SOCKS5_VERSION_NAME
@@ -3378,9 +3361,9 @@ PerlIOStdio_flush(pTHX_ PerlIO *f)
        /*
         * Not writeable - sync by attempting a seek
         */
-       const int err = errno;
+       dSAVE_ERRNO;
        if (PerlSIO_fseek(stdio, (Off_t) 0, SEEK_CUR) != 0)
-           errno = err;
+           RESTORE_ERRNO;
 #endif
     }
     return 0;
@@ -3569,7 +3552,7 @@ PERLIO_FUNCS_DECL(PerlIO_stdio) = {
     sizeof(PerlIOStdio),
     PERLIO_K_BUFFERED|PERLIO_K_RAW,
     PerlIOStdio_pushed,
-    PerlIOStdio_popped,
+    PerlIOBase_popped,
     PerlIOStdio_open,
     PerlIOBase_binmode,         /* binmode */
     NULL,
@@ -5179,18 +5162,30 @@ PerlIO_tmpfile(void)
          f = PerlIO_fdopen(fd, "w+b");
 #else /* WIN32 */
 #    if defined(HAS_MKSTEMP) && ! defined(VMS) && ! defined(OS2)
-     SV * const sv = newSVpvs("/tmp/PerlIO_XXXXXX");
+     int fd = -1;
+     char tempname[] = "/tmp/PerlIO_XXXXXX";
+     const char * const tmpdir = PL_tainting ? NULL : PerlEnv_getenv("TMPDIR");
+     SV * const sv = tmpdir && *tmpdir ? newSVpv(tmpdir, 0) : NULL;
      /*
       * I have no idea how portable mkstemp() is ... NI-S
       */
-     const int fd = mkstemp(SvPVX(sv));
+     if (sv) {
+        /* if TMPDIR is set and not empty, we try that first */
+        sv_catpv(sv, tempname + 4);
+        fd = mkstemp(SvPVX(sv));
+     }
+     if (fd < 0) {
+        /* else we try /tmp */
+        fd = mkstemp(tempname);
+     }
      if (fd >= 0) {
          f = PerlIO_fdopen(fd, "w+");
          if (f)
               PerlIOBase(f)->flags |= PERLIO_F_TEMP;
-         PerlLIO_unlink(SvPVX_const(sv));
+         PerlLIO_unlink(sv ? SvPVX_const(sv) : tempname);
      }
-     SvREFCNT_dec(sv);
+     if (sv)
+        SvREFCNT_dec(sv);
 #    else      /* !HAS_MKSTEMP, fallback to stdio tmpfile(). */
      FILE * const stdio = PerlSIO_tmpfile();