Bump Module-Pluggable VERSION following 4a28828fc8f160c18323be1125f0f8473bcd000f

[perl5.git] / perlio.c

diff --git a/perlio.c b/perlio.c
index 4efc88d..0a086a8 100644 (file)
--- a/perlio.c
+++ b/perlio.c
@@ -1,7 +1,7 @@
 /*
  * perlio.c
  * Copyright (c) 1996-2006, Nick Ing-Simmons
- * Copyright (c) 2006, 2007, Larry Wall and others
+ * Copyright (c) 2006, 2007, 2008 Larry Wall and others
  *
  * You may distribute under the terms of either the GNU General Public License
  * or the Artistic License, as specified in the README file.
@@ -10,6 +10,8 @@
 /*
  * Hour after hour for nearly three weary days he had jogged up and down,
  * over passes, and through long dales, and across many streams.
+ *
+ *     [pp.791-792 of _The Lord of the Rings_, V/iii: "The Muster of Rohan"]
  */
 
 /* This file contains the functions needed to implement PerlIO, which
@@ -805,12 +807,12 @@ 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) {
                SAVEGENERICSV(PL_warnhook);
-               PL_warnhook = (SV *) (SvREFCNT_inc_simple_NN(cv));
+               PL_warnhook = MUTABLE_SV((SvREFCNT_inc_simple_NN(cv)));
            }
            PL_in_load_module++;
            /*
@@ -832,7 +834,7 @@ static int
 perlio_mg_set(pTHX_ SV *sv, MAGIC *mg)
 {
     if (SvROK(sv)) {
-       IO * const io = GvIOn((GV *) SvRV(sv));
+       IO * const io = GvIOn(MUTABLE_GV(SvRV(sv)));
        PerlIO * const ifp = IoIFP(io);
        PerlIO * const ofp = IoOFP(io);
        Perl_warn(aTHX_ "set %" SVf " %p %p %p",
@@ -845,7 +847,7 @@ static int
 perlio_mg_get(pTHX_ SV *sv, MAGIC *mg)
 {
     if (SvROK(sv)) {
-       IO * const io = GvIOn((GV *) SvRV(sv));
+       IO * const io = GvIOn(MUTABLE_GV(SvRV(sv)));
        PerlIO * const ifp = IoIFP(io);
        PerlIO * const ofp = IoOFP(io);
        Perl_warn(aTHX_ "get %" SVf " %p %p %p",
@@ -884,7 +886,7 @@ XS(XS_io_MODIFY_SCALAR_ATTRIBUTES)
     MAGIC *mg;
     int count = 0;
     int i;
-    sv_magic(sv, (SV *) av, PERL_MAGIC_ext, NULL, 0);
+    sv_magic(sv, MUTABLE_SV(av), PERL_MAGIC_ext, NULL, 0);
     SvRMAGICAL_off(sv);
     mg = mg_find(sv, PERL_MAGIC_ext);
     mg->mg_virtual = &perlio_vtab;
@@ -1295,7 +1297,7 @@ PerlIORaw_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
        while (t && (l = *t)) {
            if (l->tab->Binmode) {
                /* Has a handler - normal case */
-               if ((*l->tab->Binmode)(aTHX_ f) == 0) {
+               if ((*l->tab->Binmode)(aTHX_ t) == 0) {
                    if (*t == l) {
                        /* Layer still there - move down a layer */
                        t = PerlIONext(t);
@@ -3031,7 +3033,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;
 }
@@ -3129,8 +3133,11 @@ PerlIOStdio_close(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
 #ifdef SOCKS5_VERSION_NAME
        /* Socks lib overrides close() but stdio isn't linked to
           that library (though we are) - so we must call close()
@@ -3141,8 +3148,15 @@ PerlIOStdio_close(pTHX_ PerlIO *f)
        if (getsockopt(fd, SOL_SOCKET, SO_TYPE, (void *) &optval, &optlen) == 0)
            invalidate = 1;
 #endif
-       if (PerlIOUnix_refcnt_dec(fd) > 0) /* File descriptor still in use */
+       /* Test for -1, as *BSD stdio (at least) on fclose sets the FILE* such
+          that a subsequent fileno() on it returns -1. Don't want to croak()
+          from within PerlIOUnix_refcnt_dec() if some buggy caller code is
+          trying to close an already closed handle which somehow it still has
+          a reference to. (via.xs, I'm looking at you).  */
+       if (fd != -1 && PerlIOUnix_refcnt_dec(fd) > 0) {
+           /* File descriptor still in use */
            invalidate = 1;
+       }
        if (invalidate) {
            /* For STD* handles, don't close stdio, since we shared the FILE *, too. */
            if (stdio == stdin) /* Some stdios are buggy fflush-ing inputs */
@@ -3154,7 +3168,7 @@ PerlIOStdio_close(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
@@ -3187,13 +3201,15 @@ PerlIOStdio_close(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
@@ -3355,9 +3371,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;
@@ -4628,9 +4644,7 @@ PerlIOCrlf_binmode(pTHX_ PerlIO *f)
        PerlIOBase(f)->flags &= ~PERLIO_F_CRLF;
 #ifndef PERLIO_USING_CRLF
        /* CRLF is unusual case - if this is just the :crlf layer pop it */
-       if (PerlIOBase(f)->tab == &PerlIO_crlf) {
-               PerlIO_pop(aTHX_ f);
-       }
+       PerlIO_pop(aTHX_ f);
 #endif
     }
     return 0;