[perl #50538] when( @n && %n ) fails to smart match

[p5sagit/p5-mst-13.2.git] / perlio.c

diff --git a/perlio.c b/perlio.c
index 2ea86aa..d0f51d5 100644 (file)
--- a/perlio.c
+++ b/perlio.c
@@ -759,6 +759,11 @@ PerlIO_get_layers(pTHX_ PerlIO *f)
        PerlIOl *l = PerlIOBase(f);
 
        while (l) {
+           /* There is some collusion in the implementation of
+              XS_PerlIO_get_layers - it knows that name and flags are
+              generated as fresh SVs here, and takes advantage of that to
+              "copy" them by taking a reference. If it changes here, it needs
+              to change there too.  */
            SV * const name = l->tab && l->tab->name ?
            newSVpv(l->tab->name, 0) : &PL_sv_undef;
            SV * const arg = l->tab && l->tab->Getarg ?
@@ -1622,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));
 }
 
@@ -2413,22 +2424,36 @@ PerlIO_cleanup(pTHX)
     }
 }
 
-void PerlIO_teardown(pTHX) /* Call only from PERL_SYS_TERM(). */
+void PerlIO_teardown(void) /* Call only from PERL_SYS_TERM(). */
 {
     dVAR;
+#if 0
+/* XXX we can't rely on an interpreter being present at this late stage,
+   XXX so we can't use a function like PerlLIO_write that relies on one
+   being present (at least in win32) :-(.
+   Disable for now.
+*/
 #ifdef DEBUGGING
     {
        /* By now all filehandles should have been closed, so any
         * stray (non-STD-)filehandles indicate *possible* (PerlIO)
         * errors. */
+#define PERLIO_TEARDOWN_MESSAGE_BUF_SIZE 64
+#define PERLIO_TEARDOWN_MESSAGE_FD 2
+       char buf[PERLIO_TEARDOWN_MESSAGE_BUF_SIZE];
        int i;
        for (i = 3; i < PL_perlio_fd_refcnt_size; i++) {
-           if (PL_perlio_fd_refcnt[i])
-               PerlIO_debug("PerlIO_cleanup: fd %d refcnt=%d\n",
-                            i, PL_perlio_fd_refcnt[i]);
+           if (PL_perlio_fd_refcnt[i]) {
+               const STRLEN len =
+                   my_snprintf(buf, sizeof(buf),
+                               "PerlIO_teardown: fd %d refcnt=%d\n",
+                               i, PL_perlio_fd_refcnt[i]);
+               PerlLIO_write(PERLIO_TEARDOWN_MESSAGE_FD, buf, len);
+           }
        }
     }
 #endif
+#endif
     /* Not bothering with PL_perlio_mutex since by now
      * all the interpreters are gone. */
     if (PL_perlio_fd_refcnt_size /* Assuming initial size of zero. */
@@ -3381,9 +3406,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))
        /*
@@ -3571,6 +3594,7 @@ FILE *
 PerlIO_findFILE(PerlIO *f)
 {
     PerlIOl *l = *f;
+    FILE *stdio;
     while (l) {
        if (l->tab == &PerlIO_stdio) {
            PerlIOStdio *s = PerlIOSelf(&l, PerlIOStdio);
@@ -3579,7 +3603,19 @@ PerlIO_findFILE(PerlIO *f)
        l = *PerlIONext(&l);
     }
     /* Uses fallback "mode" via PerlIO_modestr() in PerlIO_exportFILE */
-    return PerlIO_exportFILE(f, NULL);
+    /* However, we're not really exporting a FILE * to someone else (who
+       becomes responsible for closing it, or calling PerlIO_releaseFILE())
+       So we need to undo its refernce count increase on the underlying file
+       descriptor. We have to do this, because if the loop above returns you
+       the FILE *, then *it* didn't increase any reference count. So there's
+       only one way to be consistent. */
+    stdio = PerlIO_exportFILE(f, NULL);
+    if (stdio) {
+       const int fd = fileno(stdio);
+       if (fd >= 0)
+           PerlIOUnix_refcnt_dec(fd);
+    }
+    return stdio;
 }
 
 /* Use this to reverse PerlIO_exportFILE calls. */
@@ -4067,13 +4103,14 @@ 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;
-    if (PerlIO_get_cnt(f) != cnt || b->ptr < b->buf) {
-       assert(PerlIO_get_cnt(f) == cnt);
-       assert(b->ptr >= b->buf);
-    }
+    assert(PerlIO_get_cnt(f) == cnt);
+    assert(b->ptr >= b->buf);
     PerlIOBase(f)->flags |= PERLIO_F_RDBUF;
 }