X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/7826b36fbbf24cfa659558ee5af3de424faa2d5a..3023b5f30c62e26185b48118c7c84030adb5b623:/perlio.c diff --git a/perlio.c b/perlio.c index 07e297e..e42a78f 100644 --- a/perlio.c +++ b/perlio.c @@ -1963,7 +1963,7 @@ PERLIO_FUNCS_DECL(PerlIO_utf8) = { sizeof(PerlIO_funcs), "utf8", 0, - PERLIO_K_DUMMY | PERLIO_K_UTF8, + PERLIO_K_DUMMY | PERLIO_K_UTF8 | PERLIO_K_MULTIARG, PerlIOUtf8_pushed, NULL, PerlIOBase_open, @@ -1994,7 +1994,7 @@ PERLIO_FUNCS_DECL(PerlIO_byte) = { sizeof(PerlIO_funcs), "bytes", 0, - PERLIO_K_DUMMY, + PERLIO_K_DUMMY | PERLIO_K_MULTIARG, PerlIOUtf8_pushed, NULL, PerlIOBase_open, @@ -2412,6 +2412,7 @@ PerlIOUnix_refcnt_inc(int fd) PL_perlio_fd_refcnt[fd]++; if (PL_perlio_fd_refcnt[fd] <= 0) { + /* diag_listed_as: refcnt_inc: fd %d%s */ Perl_croak(aTHX_ "refcnt_inc: fd %d: %d <= 0\n", fd, PL_perlio_fd_refcnt[fd]); } @@ -2422,6 +2423,7 @@ PerlIOUnix_refcnt_inc(int fd) MUTEX_UNLOCK(&PL_perlio_mutex); #endif } else { + /* diag_listed_as: refcnt_inc: fd %d%s */ Perl_croak(aTHX_ "refcnt_inc: fd %d < 0\n", fd); } } @@ -2437,10 +2439,12 @@ PerlIOUnix_refcnt_dec(int fd) MUTEX_LOCK(&PL_perlio_mutex); #endif if (fd >= PL_perlio_fd_refcnt_size) { + /* diag_listed_as: refcnt_dec: fd %d%s */ Perl_croak(aTHX_ "refcnt_dec: fd %d >= refcnt_size %d\n", fd, PL_perlio_fd_refcnt_size); } if (PL_perlio_fd_refcnt[fd] <= 0) { + /* diag_listed_as: refcnt_dec: fd %d%s */ Perl_croak(aTHX_ "refcnt_dec: fd %d: %d <= 0\n", fd, PL_perlio_fd_refcnt[fd]); } @@ -2450,11 +2454,43 @@ PerlIOUnix_refcnt_dec(int fd) MUTEX_UNLOCK(&PL_perlio_mutex); #endif } else { + /* diag_listed_as: refcnt_dec: fd %d%s */ Perl_croak(aTHX_ "refcnt_dec: fd %d < 0\n", fd); } return cnt; } +int +PerlIOUnix_refcnt(int fd) +{ + dTHX; + int cnt = 0; + if (fd >= 0) { + dVAR; +#ifdef USE_ITHREADS + MUTEX_LOCK(&PL_perlio_mutex); +#endif + if (fd >= PL_perlio_fd_refcnt_size) { + /* diag_listed_as: refcnt: fd %d%s */ + Perl_croak(aTHX_ "refcnt: fd %d >= refcnt_size %d\n", + fd, PL_perlio_fd_refcnt_size); + } + if (PL_perlio_fd_refcnt[fd] <= 0) { + /* diag_listed_as: refcnt: fd %d%s */ + Perl_croak(aTHX_ "refcnt: fd %d: %d <= 0\n", + fd, PL_perlio_fd_refcnt[fd]); + } + cnt = PL_perlio_fd_refcnt[fd]; +#ifdef USE_ITHREADS + MUTEX_UNLOCK(&PL_perlio_mutex); +#endif + } else { + /* diag_listed_as: refcnt: fd %d%s */ + Perl_croak(aTHX_ "refcnt: fd %d < 0\n", fd); + } + return cnt; +} + void PerlIO_cleanup(pTHX) { @@ -4508,10 +4544,8 @@ PerlIOCrlf_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab) PerlIOBase(f)->flags); #endif { - /* Enable the first CRLF capable layer you can find, but if none - * found, the one we just pushed is fine. This results in at - * any given moment at most one CRLF-capable layer being enabled - * in the whole layer stack. */ + /* If the old top layer is a CRLF layer, reactivate it (if + * necessary) and remove this new layer from the stack */ PerlIO *g = PerlIONext(f); if (PerlIOValid(g)) { PerlIOl *b = PerlIOBase(g);