Upgrade to Test-Simple-0.82.

[perl5.git] / perlio.c

diff --git a/perlio.c b/perlio.c
index d9c1e97..7eb7e27 100644 (file)
--- a/perlio.c
+++ b/perlio.c
@@ -1295,7 +1295,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);
@@ -1627,18 +1627,24 @@ PerlIO_openn(pTHX_ const char *layers, const char *mode, int fd,
 SSize_t
 Perl_PerlIO_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
 {
+     PERL_ARGS_ASSERT_PERLIO_READ;
+
      Perl_PerlIO_or_Base(f, Read, read, -1, (aTHX_ f, vbuf, count));
 }
 
 SSize_t
 Perl_PerlIO_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
 {
+     PERL_ARGS_ASSERT_PERLIO_UNREAD;
+
      Perl_PerlIO_or_Base(f, Unread, unread, -1, (aTHX_ f, vbuf, count));
 }
 
 SSize_t
 Perl_PerlIO_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
 {
+     PERL_ARGS_ASSERT_PERLIO_WRITE;
+
      Perl_PerlIO_or_fail(f, Write, -1, (aTHX_ f, vbuf, count));
 }
 
@@ -2418,7 +2424,7 @@ PerlIO_cleanup(pTHX)
     }
 }
 
-void PerlIO_teardown() /* Call only from PERL_SYS_TERM(). */
+void PerlIO_teardown(void) /* Call only from PERL_SYS_TERM(). */
 {
     dVAR;
 #if 0
@@ -3124,7 +3130,10 @@ PerlIOStdio_close(pTHX_ PerlIO *f)
        int invalidate = 0;
        IV result = 0;
        int saveerr = 0;
-       int dupfd = 0;
+       int dupfd = -1;
+#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()
@@ -3150,8 +3159,37 @@ PerlIOStdio_close(pTHX_ PerlIO *f)
            result = PerlIO_flush(f);
            saveerr = errno;
            invalidate = PerlIOStdio_invalidate_fileno(aTHX_ stdio);
-           if (!invalidate)
+           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)
+                  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 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. */
+#endif
                dupfd = PerlLIO_dup(fd);
+#ifdef USE_ITHREADS
+               if (dupfd < 0) {
+                   MUTEX_UNLOCK(&PL_perlio_mutex);
+                   /* Oh cXap. This isn't going to go well. Not sure if we can
+                      recover from here, or if closing this particular FILE *
+                      is a good idea now.  */
+               }
+#endif
+           }
        }
         result = PerlSIO_fclose(stdio);
        /* We treat error from stdio as success if we invalidated
@@ -3165,9 +3203,12 @@ PerlIOStdio_close(pTHX_ PerlIO *f)
        /* in SOCKS' case, let close() determine return value */
        result = close(fd);
 #endif
-       if (dupfd) {
+       if (dupfd >= 0) {
            PerlLIO_dup2(dupfd,fd);
            PerlLIO_close(dupfd);
+#ifdef USE_ITHREADS
+           MUTEX_UNLOCK(&PL_perlio_mutex);
+#endif
        }
        return result;
     }
@@ -3400,9 +3441,7 @@ PerlIOStdio_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR * ptr, SSize_t cnt)
 #ifdef STDIO_PTR_LVALUE
        PerlSIO_set_ptr(stdio, ptr); /* LHS STDCHAR* cast non-portable */
 #ifdef STDIO_PTR_LVAL_SETS_CNT
-       if (PerlSIO_get_cnt(stdio) != (cnt)) {
-           assert(PerlSIO_get_cnt(stdio) == (cnt));
-       }
+       assert(PerlSIO_get_cnt(stdio) == (cnt));
 #endif
 #if (!defined(STDIO_PTR_LVAL_NOCHANGE_CNT))
        /*
@@ -4099,6 +4138,9 @@ void
 PerlIOBuf_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR * ptr, SSize_t cnt)
 {
     PerlIOBuf * const b = PerlIOSelf(f, PerlIOBuf);
+#ifndef DEBUGGING
+    PERL_UNUSED_ARG(cnt);
+#endif
     if (!b->buf)
        PerlIO_get_base(f);
     b->ptr = ptr;