X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perlio.c;h=5db65b931aa202b6fdd13e3cc5753e00c56cf117;hb=efdc43f5015438920ce11f05539e55cb02940377;hp=ed829e46084ff8ee35cfad57641c31504cc0810d;hpb=9bab90c0f28bfa909019e7c256fe9c7dfb6ca308;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/perlio.c b/perlio.c
index ed829e4..5db65b9 100644
--- 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
@@ -810,7 +812,7 @@ PerlIO_find_layer(pTHX_ const char *name, STRLEN len, int load)
 	    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);
@@ -3129,8 +3131,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 +3146,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,25 +3166,25 @@ 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
 		MUTEX_LOCK(&PL_perlio_mutex);
-		/* Right. We need a mutex here because for a brief while we will
-		   have the situation that fd is actually closed. Hence if a
-		   second thread were to get into this block, its dup() would
-		   likely return our fd as its dupfd. (after all, it is closed).
+		/* Right. We need a mutex here because for a brief while we
+		   will have the situation that fd is actually closed. Hence if
+		   a second thread were to get into this block, its dup() would
+		   likely return our fd as its dupfd. (after all, it is closed)
 		   Then if we get to the dup2() first, we blat the fd back
 		   (messing up its temporary as a side effect) only for it to
 		   then close its dupfd (== our fd) in its close(dupfd) */
 
 		/* There is, of course, a race condition, that any other thread
 		   trying to input/output/whatever on this fd will be stuffed
-		   for the duraction of this little manoeuver. Perhaps we should
-		   hold an IO mutex for the duration of every IO operation if
-		   we know that invalidate doesn't work on this platform, but
-		   that would suck, and could kill performance.
+		   for the duration of this little manoeuvrer. Perhaps we
+		   should hold an IO mutex for the duration of every IO
+		   operation if we know that invalidate doesn't work on this
+		   platform, but that would suck, and could kill performance.
 
 		   Except that correctness trumps speed.
 		   Advice from klortho #11912. */
@@ -3187,13 +3199,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 +3369,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 +4642,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;