X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perlio.c;h=dd5f21c63d9d0cd1c9a6ff45c27441e67dd24879;hb=0dbd57a10c8cc972ad52305885705b0194739bca;hp=1b950aa8bb899ce876613af6836400a3b7e38e3e;hpb=04a0f00b3d99a470b527ee741b302cef993c2cc4;p=p5sagit%2Fp5-mst-13.2.git diff --git a/perlio.c b/perlio.c index 1b950aa..dd5f21c 100644 --- a/perlio.c +++ b/perlio.c @@ -1,10 +1,15 @@ /* - * perlio.c Copyright (c) 1996-2001, Nick Ing-Simmons You may distribute + * perlio.c Copyright (c) 1996-2002, Nick Ing-Simmons You may distribute * under the terms of either the GNU General Public License or the * Artistic License, as specified in the README file. */ /* + * Hour after hour for nearly three weary days he had jogged up and down, + * over passes, and through long dales, and across many streams. + */ + +/* * If we have ActivePerl-like PERL_IMPLICIT_SYS then we need a dTHX to get * at the dispatch tables, even when we do not need it for other reasons. * Invent a dSYS macro to abstract this out @@ -187,6 +192,9 @@ PerlIO_fdupopen(pTHX_ PerlIO *f, CLONE_PARAMS *param, int flags) if (fd >= 0) { char mode[8]; int omode = fcntl(fd, F_GETFL); +#ifdef DJGPP + omode = djgpp_get_stream_mode(f); +#endif PerlIO_intmode2str(omode,mode,NULL); /* the r+ is a hack */ return PerlIO_fdopen(fd, mode); @@ -448,7 +456,7 @@ PerlIO_allocate(pTHX) PerlIO * PerlIO_fdupopen(pTHX_ PerlIO *f, CLONE_PARAMS *param, int flags) { - if (f && *f) { + if (PerlIOValid(f)) { PerlIO_funcs *tab = PerlIOBase(f)->tab; PerlIO *new; PerlIO_debug("fdupopen f=%p param=%p\n",(void*)f,(void*)param); @@ -1004,7 +1012,7 @@ PerlIORaw_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg) /* * Pop back to bottom layer */ - if (f && *f) { + if (PerlIOValid(f)) { PerlIO_flush(f); while (!(PerlIOBase(f)->tab->kind & PERLIO_K_RAW)) { if (*PerlIONext(f)) { @@ -1072,30 +1080,79 @@ PerlIO_binmode(pTHX_ PerlIO *f, int iotype, int mode, const char *names) PerlIO_debug("PerlIO_binmode f=%p %s %c %x %s\n", (void*)f, PerlIOBase(f)->tab->name, iotype, mode, (names) ? names : "(Null)"); - /* Can't flush if switching encodings. */ - if (!(names && memEQ(names, ":encoding(", 10))) { - PerlIO_flush(f); + if (names) { + /* Do not flush etc. if (e.g.) switching encodings. + if a pushed layer knows it needs to flush lower layers + (for example :unix which is never going to call them) + it can do the flush when it is pushed. + */ + return PerlIO_apply_layers(aTHX_ f, NULL, names) == 0 ? TRUE : FALSE; + } + else { + /* FIXME?: Looking down the layer stack seems wrong, + but is a way of reaching past (say) an encoding layer + to flip CRLF-ness of the layer(s) below + */ #ifdef PERLIO_USING_CRLF - if (!names && (mode & O_BINARY)) { - PerlIO *top = f; - while (*top) { - if (PerlIOBase(top)->tab == &PerlIO_crlf) { - PerlIOBase(top)->flags &= ~PERLIO_F_CRLF; - break; + /* Legacy binmode only has meaning if O_TEXT has a value distinct from + O_BINARY so we can look for it in mode. + */ + if (!(mode & O_BINARY)) { + /* Text mode */ + while (*f) { + /* Perhaps we should turn on bottom-most aware layer + e.g. Ilya's idea that UNIX TTY could serve + */ + if (PerlIOBase(f)->tab->kind & PERLIO_K_CANCRLF) { + if (!(PerlIOBase(f)->flags & PERLIO_F_CRLF)) { + /* Not in text mode - flush any pending stuff and flip it */ + PerlIO_flush(f); + PerlIOBase(f)->flags |= PERLIO_F_CRLF; + } + /* Only need to turn it on in one layer so we are done */ + return TRUE; } - top = PerlIONext(top); - PerlIO_flush(top); + f = PerlIONext(f); } + /* Not finding a CRLF aware layer presumably means we are binary + which is not what was requested - so we failed + We _could_ push :crlf layer but so could caller + */ + return FALSE; } #endif + /* Either asked for BINMODE or that is normal on this platform + see if any CRLF aware layers are present and turn off the flag + and possibly remove layer. + */ + while (*f) { + if (PerlIOBase(f)->tab->kind & PERLIO_K_CANCRLF) { + if ((PerlIOBase(f)->flags & PERLIO_F_CRLF)) { + /* In text mode - flush any pending stuff and flip it */ + PerlIO_flush(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); + } +#endif + /* Normal case is only one layer doing this, so exit on first + abnormal case can always do multiple binmode calls + */ + return TRUE; + } + } + f = PerlIONext(f); + } + return TRUE; } - return PerlIO_apply_layers(aTHX_ f, NULL, names) == 0 ? TRUE : FALSE; } int PerlIO__close(pTHX_ PerlIO *f) { - if (f && *f) + if (PerlIOValid(f)) return (*PerlIOBase(f)->tab->Close) (aTHX_ f); else { SETERRNO(EBADF, SS$_IVCHAN); @@ -1107,7 +1164,7 @@ int Perl_PerlIO_close(pTHX_ PerlIO *f) { int code = -1; - if (f && *f) { + if (PerlIOValid(f)) { code = (*PerlIOBase(f)->tab->Close) (aTHX_ f); while (*f) { PerlIO_pop(aTHX_ f); @@ -1119,7 +1176,7 @@ Perl_PerlIO_close(pTHX_ PerlIO *f) int Perl_PerlIO_fileno(pTHX_ PerlIO *f) { - if (f && *f) + if (PerlIOValid(f)) return (*PerlIOBase(f)->tab->Fileno) (aTHX_ f); else { SETERRNO(EBADF, SS$_IVCHAN); @@ -1247,7 +1304,7 @@ PerlIO_openn(pTHX_ const char *layers, const char *mode, int fd, PerlIO_list_t *layera = NULL; IV n; PerlIO_funcs *tab = NULL; - if (f && *f) { + if (PerlIOValid(f)) { /* * This is "reopen" - it is not tested as perl does not use it * yet @@ -1255,9 +1312,9 @@ PerlIO_openn(pTHX_ const char *layers, const char *mode, int fd, PerlIOl *l = *f; layera = PerlIO_list_alloc(aTHX); while (l) { - SV *arg = - (l->tab->Getarg) ? (*l->tab-> - Getarg) (aTHX_ &l, NULL, 0) : &PL_sv_undef; + SV *arg = (l->tab->Getarg) + ? (*l->tab->Getarg) (aTHX_ &l, NULL, 0) + : &PL_sv_undef; PerlIO_list_push(aTHX_ layera, l->tab, arg); l = *PerlIONext(&l); } @@ -1311,7 +1368,7 @@ PerlIO_openn(pTHX_ const char *layers, const char *mode, int fd, SSize_t Perl_PerlIO_read(pTHX_ PerlIO *f, void *vbuf, Size_t count) { - if (f && *f) + if (PerlIOValid(f)) return (*PerlIOBase(f)->tab->Read) (aTHX_ f, vbuf, count); else { SETERRNO(EBADF, SS$_IVCHAN); @@ -1322,7 +1379,7 @@ Perl_PerlIO_read(pTHX_ PerlIO *f, void *vbuf, Size_t count) SSize_t Perl_PerlIO_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count) { - if (f && *f) + if (PerlIOValid(f)) return (*PerlIOBase(f)->tab->Unread) (aTHX_ f, vbuf, count); else { SETERRNO(EBADF, SS$_IVCHAN); @@ -1333,7 +1390,7 @@ Perl_PerlIO_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count) SSize_t Perl_PerlIO_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count) { - if (f && *f) + if (PerlIOValid(f)) return (*PerlIOBase(f)->tab->Write) (aTHX_ f, vbuf, count); else { SETERRNO(EBADF, SS$_IVCHAN); @@ -1344,7 +1401,7 @@ Perl_PerlIO_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count) int Perl_PerlIO_seek(pTHX_ PerlIO *f, Off_t offset, int whence) { - if (f && *f) + if (PerlIOValid(f)) return (*PerlIOBase(f)->tab->Seek) (aTHX_ f, offset, whence); else { SETERRNO(EBADF, SS$_IVCHAN); @@ -1355,7 +1412,7 @@ Perl_PerlIO_seek(pTHX_ PerlIO *f, Off_t offset, int whence) Off_t Perl_PerlIO_tell(pTHX_ PerlIO *f) { - if (f && *f) + if (PerlIOValid(f)) return (*PerlIOBase(f)->tab->Tell) (aTHX_ f); else { SETERRNO(EBADF, SS$_IVCHAN); @@ -1429,7 +1486,7 @@ PerlIOBase_flush_linebuf(pTHX) int Perl_PerlIO_fill(pTHX_ PerlIO *f) { - if (f && *f) + if (PerlIOValid(f)) return (*PerlIOBase(f)->tab->Fill) (aTHX_ f); else { SETERRNO(EBADF, SS$_IVCHAN); @@ -1440,7 +1497,7 @@ Perl_PerlIO_fill(pTHX_ PerlIO *f) int PerlIO_isutf8(PerlIO *f) { - if (f && *f) + if (PerlIOValid(f)) return (PerlIOBase(f)->flags & PERLIO_F_UTF8) != 0; else { SETERRNO(EBADF, SS$_IVCHAN); @@ -1451,7 +1508,7 @@ PerlIO_isutf8(PerlIO *f) int Perl_PerlIO_eof(pTHX_ PerlIO *f) { - if (f && *f) + if (PerlIOValid(f)) return (*PerlIOBase(f)->tab->Eof) (aTHX_ f); else { SETERRNO(EBADF, SS$_IVCHAN); @@ -1462,7 +1519,7 @@ Perl_PerlIO_eof(pTHX_ PerlIO *f) int Perl_PerlIO_error(pTHX_ PerlIO *f) { - if (f && *f) + if (PerlIOValid(f)) return (*PerlIOBase(f)->tab->Error) (aTHX_ f); else { SETERRNO(EBADF, SS$_IVCHAN); @@ -1473,7 +1530,7 @@ Perl_PerlIO_error(pTHX_ PerlIO *f) void Perl_PerlIO_clearerr(pTHX_ PerlIO *f) { - if (f && *f) + if (PerlIOValid(f)) (*PerlIOBase(f)->tab->Clearerr) (aTHX_ f); else SETERRNO(EBADF, SS$_IVCHAN); @@ -1482,7 +1539,7 @@ Perl_PerlIO_clearerr(pTHX_ PerlIO *f) void Perl_PerlIO_setlinebuf(pTHX_ PerlIO *f) { - if (f && *f) + if (PerlIOValid(f)) (*PerlIOBase(f)->tab->Setlinebuf) (aTHX_ f); else SETERRNO(EBADF, SS$_IVCHAN); @@ -1491,7 +1548,7 @@ Perl_PerlIO_setlinebuf(pTHX_ PerlIO *f) int PerlIO_has_base(PerlIO *f) { - if (f && *f) { + if (PerlIOValid(f)) { return (PerlIOBase(f)->tab->Get_base != NULL); } return 0; @@ -1500,7 +1557,7 @@ PerlIO_has_base(PerlIO *f) int PerlIO_fast_gets(PerlIO *f) { - if (f && *f && (PerlIOBase(f)->flags & PERLIO_F_FASTGETS)) { + if (PerlIOValid(f) && (PerlIOBase(f)->flags & PERLIO_F_FASTGETS)) { PerlIO_funcs *tab = PerlIOBase(f)->tab; return (tab->Set_ptrcnt != NULL); } @@ -1510,7 +1567,7 @@ PerlIO_fast_gets(PerlIO *f) int PerlIO_has_cntptr(PerlIO *f) { - if (f && *f) { + if (PerlIOValid(f)) { PerlIO_funcs *tab = PerlIOBase(f)->tab; return (tab->Get_ptr != NULL && tab->Get_cnt != NULL); } @@ -1520,7 +1577,7 @@ PerlIO_has_cntptr(PerlIO *f) int PerlIO_canset_cnt(PerlIO *f) { - if (f && *f) { + if (PerlIOValid(f)) { PerlIOl *l = PerlIOBase(f); return (l->tab->Set_ptrcnt != NULL); } @@ -1530,7 +1587,7 @@ PerlIO_canset_cnt(PerlIO *f) STDCHAR * Perl_PerlIO_get_base(pTHX_ PerlIO *f) { - if (f && *f) + if (PerlIOValid(f)) return (*PerlIOBase(f)->tab->Get_base) (aTHX_ f); return NULL; } @@ -1538,7 +1595,7 @@ Perl_PerlIO_get_base(pTHX_ PerlIO *f) int Perl_PerlIO_get_bufsiz(pTHX_ PerlIO *f) { - if (f && *f) + if (PerlIOValid(f)) return (*PerlIOBase(f)->tab->Get_bufsiz) (aTHX_ f); return 0; } @@ -1546,35 +1603,45 @@ Perl_PerlIO_get_bufsiz(pTHX_ PerlIO *f) STDCHAR * Perl_PerlIO_get_ptr(pTHX_ PerlIO *f) { - PerlIO_funcs *tab = PerlIOBase(f)->tab; - if (tab->Get_ptr == NULL) - return NULL; - return (*tab->Get_ptr) (aTHX_ f); + if (PerlIOValid(f)) { + PerlIO_funcs *tab = PerlIOBase(f)->tab; + if (tab->Get_ptr == NULL) + return NULL; + return (*tab->Get_ptr) (aTHX_ f); + } + return NULL; } int Perl_PerlIO_get_cnt(pTHX_ PerlIO *f) { - PerlIO_funcs *tab = PerlIOBase(f)->tab; - if (tab->Get_cnt == NULL) - return 0; - return (*tab->Get_cnt) (aTHX_ f); + if (PerlIOValid(f)) { + PerlIO_funcs *tab = PerlIOBase(f)->tab; + if (tab->Get_cnt == NULL) + return 0; + return (*tab->Get_cnt) (aTHX_ f); + } + return 0; } void Perl_PerlIO_set_cnt(pTHX_ PerlIO *f, int cnt) { - (*PerlIOBase(f)->tab->Set_ptrcnt) (aTHX_ f, NULL, cnt); + if (PerlIOValid(f)) { + (*PerlIOBase(f)->tab->Set_ptrcnt) (aTHX_ f, NULL, cnt); + } } void Perl_PerlIO_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR * ptr, int cnt) { - PerlIO_funcs *tab = PerlIOBase(f)->tab; - if (tab->Set_ptrcnt == NULL) { - Perl_croak(aTHX_ "PerlIO buffer snooping abuse"); + if (PerlIOValid(f)) { + PerlIO_funcs *tab = PerlIOBase(f)->tab; + if (tab->Set_ptrcnt == NULL) { + Perl_croak(aTHX_ "PerlIO buffer snooping abuse"); + } + (*PerlIOBase(f)->tab->Set_ptrcnt) (aTHX_ f, ptr, cnt); } - (*PerlIOBase(f)->tab->Set_ptrcnt) (aTHX_ f, ptr, cnt); } /*--------------------------------------------------------------------------------------*/ @@ -1585,7 +1652,7 @@ Perl_PerlIO_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR * ptr, int cnt) IV PerlIOUtf8_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg) { - if (PerlIONext(f)) { + if (*PerlIONext(f)) { PerlIO_funcs *tab = PerlIOBase(f)->tab; PerlIO_pop(aTHX_ f); if (tab->kind & PERLIO_K_UTF8) @@ -1699,7 +1766,7 @@ PerlIO_funcs PerlIO_raw = { IV PerlIOBase_fileno(pTHX_ PerlIO *f) { - return PerlIO_fileno(PerlIONext(f)); + return PerlIOValid(f) ? PerlIO_fileno(PerlIONext(f)) : -1; } char * @@ -1862,7 +1929,7 @@ PerlIOBase_close(pTHX_ PerlIO *f) PerlIO *n = PerlIONext(f); if (PerlIO_flush(f) != 0) code = -1; - if (n && *n && (*PerlIOBase(n)->tab->Close)(aTHX_ n) != 0) + if (PerlIOValid(n) && (*PerlIOBase(n)->tab->Close)(aTHX_ n) != 0) code = -1; PerlIOBase(f)->flags &= ~(PERLIO_F_CANREAD | PERLIO_F_CANWRITE | PERLIO_F_OPEN); @@ -1872,7 +1939,7 @@ PerlIOBase_close(pTHX_ PerlIO *f) IV PerlIOBase_eof(pTHX_ PerlIO *f) { - if (f && *f) { + if (PerlIOValid(f)) { return (PerlIOBase(f)->flags & PERLIO_F_EOF) != 0; } return 1; @@ -1881,7 +1948,7 @@ PerlIOBase_eof(pTHX_ PerlIO *f) IV PerlIOBase_error(pTHX_ PerlIO *f) { - if (f && *f) { + if (PerlIOValid(f)) { return (PerlIOBase(f)->flags & PERLIO_F_ERROR) != 0; } return 1; @@ -1890,10 +1957,10 @@ PerlIOBase_error(pTHX_ PerlIO *f) void PerlIOBase_clearerr(pTHX_ PerlIO *f) { - if (f && *f) { + if (PerlIOValid(f)) { PerlIO *n = PerlIONext(f); PerlIOBase(f)->flags &= ~(PERLIO_F_ERROR | PERLIO_F_EOF); - if (n) + if (PerlIOValid(n)) PerlIO_clearerr(n); } } @@ -1901,7 +1968,7 @@ PerlIOBase_clearerr(pTHX_ PerlIO *f) void PerlIOBase_setlinebuf(pTHX_ PerlIO *f) { - if (f) { + if (PerlIOValid(f)) { PerlIOBase(f)->flags |= PERLIO_F_LINEBUF; } } @@ -1927,7 +1994,7 @@ PerlIO * PerlIOBase_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags) { PerlIO *nexto = PerlIONext(o); - if (*nexto) { + if (PerlIOValid(nexto)) { PerlIO_funcs *tab = PerlIOBase(nexto)->tab; f = (*tab->Dup)(aTHX_ f, nexto, param, flags); } @@ -2092,6 +2159,8 @@ PerlIOUnix_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg) IV code = PerlIOBase_pushed(aTHX_ f, mode, arg); PerlIOUnix *s = PerlIOSelf(f, PerlIOUnix); if (*PerlIONext(f)) { + /* We never call down so any pending stuff now */ + PerlIO_flush(PerlIONext(f)); s->fd = PerlIO_fileno(PerlIONext(f)); /* * XXX could (or should) we retrieve the oflags from the open file @@ -2323,8 +2392,11 @@ PerlIOStdio_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg) FILE *stdio = PerlSIO_fdopen(PerlIO_fileno(PerlIONext(f)), mode = PerlIOStdio_mode(mode, tmode)); - if (stdio) + if (stdio) { s->stdio = stdio; + /* We never call down so any pending stuff now */ + PerlIO_flush(PerlIONext(f)); + } else return -1; } @@ -2786,21 +2858,17 @@ PerlIOBuf_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers, IV n, const char *mode, int fd, int imode, int perm, PerlIO *f, int narg, SV **args) { - if (f) { + if (PerlIOValid(f)) { PerlIO *next = PerlIONext(f); - PerlIO_funcs *tab = - PerlIO_layer_fetch(aTHX_ layers, n - 1, PerlIOBase(next)->tab); - next = - (*tab->Open) (aTHX_ tab, layers, n - 1, mode, fd, imode, perm, + PerlIO_funcs *tab = PerlIO_layer_fetch(aTHX_ layers, n - 1, PerlIOBase(next)->tab); + next = (*tab->Open) (aTHX_ tab, layers, n - 1, mode, fd, imode, perm, next, narg, args); - if (!next - || (*PerlIOBase(f)->tab->Pushed) (aTHX_ f, mode, PerlIOArg) != 0) { + if (!next || (*PerlIOBase(f)->tab->Pushed) (aTHX_ f, mode, PerlIOArg) != 0) { return NULL; } } else { - PerlIO_funcs *tab = - PerlIO_layer_fetch(aTHX_ layers, n - 1, PerlIO_default_btm()); + PerlIO_funcs *tab = PerlIO_layer_fetch(aTHX_ layers, n - 1, PerlIO_default_btm()); int init = 0; if (*mode == 'I') { init = 1; @@ -2846,13 +2914,13 @@ PerlIOBuf_flush(pTHX_ PerlIO *f) { PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf); int code = 0; + PerlIO *n = PerlIONext(f); if (PerlIOBase(f)->flags & PERLIO_F_WRBUF) { /* * write() the buffer */ STDCHAR *buf = b->buf; STDCHAR *p = buf; - PerlIO *n = PerlIONext(f); while (p < b->ptr) { SSize_t count = PerlIO_write(n, p, b->ptr - p); if (count > 0) { @@ -2876,17 +2944,17 @@ PerlIOBuf_flush(pTHX_ PerlIO *f) /* * We did not consume all of it */ - if (PerlIO_seek(PerlIONext(f), b->posn, SEEK_SET) == 0) { - b->posn = PerlIO_tell(PerlIONext(f)); + if (PerlIO_seek(n, b->posn, SEEK_SET) == 0) { + /* Reload n as some layers may pop themselves on seek */ + b->posn = PerlIO_tell(n = PerlIONext(f)); } } } b->ptr = b->end = b->buf; PerlIOBase(f)->flags &= ~(PERLIO_F_RDBUF | PERLIO_F_WRBUF); - /* - * FIXME: Is this right for read case ? - */ - if (PerlIO_flush(PerlIONext(f)) != 0) + /* We check for Valid because of dubious decision to make PerlIO_flush(NULL) flush all */ + /* FIXME: Doing downstream flush may be sub-optimal see PerlIOBuf_fill() below */ + if (PerlIOValid(n) && PerlIO_flush(n) != 0) code = -1; return code; } @@ -2898,10 +2966,10 @@ PerlIOBuf_fill(pTHX_ PerlIO *f) PerlIO *n = PerlIONext(f); SSize_t avail; /* - * FIXME: doing the down-stream flush is a bad idea if it causes - * pre-read data in stdio buffer to be discarded but this is too - * simplistic - as it skips _our_ hosekeeping and breaks tell tests. - * if (!(PerlIOBase(f)->flags & PERLIO_F_RDBUF)) { } + * FIXME: doing the down-stream flush maybe sub-optimal if it causes + * pre-read data in stdio buffer to be discarded. + * However, skipping the flush also skips _our_ hosekeeping + * and breaks tell tests. So we do the flush. */ if (PerlIO_flush(f) != 0) return -1; @@ -2914,7 +2982,7 @@ PerlIOBuf_fill(pTHX_ PerlIO *f) b->ptr = b->end = b->buf; if (PerlIO_fast_gets(n)) { /* - * Layer below is also buffered We do _NOT_ want to call its + * Layer below is also buffered. We do _NOT_ want to call its * ->Read() because that will loop till it gets what we asked for * which may hang on a pipe etc. Instead take anything it has to * hand, or ask it to fill _once_. @@ -2957,7 +3025,7 @@ SSize_t PerlIOBuf_read(pTHX_ PerlIO *f, void *vbuf, Size_t count) { PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf); - if (f) { + if (PerlIOValid(f)) { if (!b->ptr) PerlIO_get_base(f); return PerlIOBase_read(aTHX_ f, vbuf, count);