From: Jarkko Hietaniemi Date: Mon, 7 Jul 2003 09:38:28 +0000 (+0000) Subject: Try making PerlIO errors more consistent. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=1f376c7ce977bb89362f73c478e0b87765bc5b5b;p=p5sagit%2Fp5-mst-13.2.git Try making PerlIO errors more consistent. (1) Check early whether the filehandle is capable of the requested action. (2) PerlIO_read() really can return -1, and so can PerlIOUnix_read(). (3) Some stdio implementations are more forgiving than others, so check also for errors recorded by PerlIO in PerlStdio_errno(). p4raw-id: //depot/perl@20050 --- diff --git a/perlio.c b/perlio.c index b0649df..178ad7c 100644 --- a/perlio.c +++ b/perlio.c @@ -99,6 +99,20 @@ else \ SETERRNO(EBADF, SS_IVCHAN) +#define Perl_PerlIO_fail_if_hasnot(f, able, ueno, veno, ret) \ + if (PerlIOValid(f) && (PerlIOBase(f)->flags & (able)) == 0) { \ + PerlIOBase(f)->flags |= PERLIO_F_ERROR; \ + SETERRNO(ueno, veno); \ + return ret; \ + } + +#define Perl_PerlIO_fail_if_has(f, able, ueno, veno, ret) \ + if (PerlIOValid(f) && (PerlIOBase(f)->flags & (able)) == able) { \ + PerlIOBase(f)->flags |= PERLIO_F_ERROR; \ + SETERRNO(ueno, veno); \ + return ret; \ + } + int perlsio_binmode(FILE *fp, int iotype, int mode) { @@ -1556,18 +1570,21 @@ 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_PerlIO_fail_if_hasnot(f, PERLIO_F_CANREAD, EBADF, SS_IVCHAN, -1); 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_PerlIO_fail_if_hasnot(f, PERLIO_F_CANREAD, EBADF, SS_IVCHAN, -1); 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_PerlIO_fail_if_hasnot(f, PERLIO_F_CANWRITE, EBADF, SS_IVCHAN, -1); Perl_PerlIO_or_fail(f, Write, -1, (aTHX_ f, vbuf, count)); } @@ -2033,11 +2050,6 @@ PerlIOBase_read(pTHX_ PerlIO *f, void *vbuf, Size_t count) { STDCHAR *buf = (STDCHAR *) vbuf; if (f) { - if (!(PerlIOBase(f)->flags & PERLIO_F_CANREAD)) { - PerlIOBase(f)->flags |= PERLIO_F_ERROR; - SETERRNO(EBADF, SS_IVCHAN); - return 0; - } while (count > 0) { SSize_t avail = PerlIO_get_cnt(f); SSize_t take = 0; @@ -2447,7 +2459,7 @@ PerlIOUnix_read(pTHX_ PerlIO *f, void *vbuf, Size_t count) int fd = PerlIOSelf(f, PerlIOUnix)->fd; if (!(PerlIOBase(f)->flags & PERLIO_F_CANREAD) || PerlIOBase(f)->flags & (PERLIO_F_EOF|PERLIO_F_ERROR)) { - return 0; + return -1; } while (1) { SSize_t len = PerlLIO_read(fd, vbuf, count); @@ -2488,17 +2500,15 @@ PerlIOUnix_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count) IV PerlIOUnix_seek(pTHX_ PerlIO *f, Off_t offset, int whence) { - int fd = PerlIOSelf(f, PerlIOUnix)->fd; + int fd; Off_t new; - if (PerlIOBase(f)->flags & PERLIO_F_NOTREG) { -#ifdef ESPIPE - SETERRNO(ESPIPE, LIB_INVARG); +#ifdef ESPIPE + Perl_PerlIO_fail_if_has(f, PERLIO_F_NOTREG, ESPIPE, SS_IVCHAN, -1); #else - SETERRNO(EINVAL, LIB_INVARG); + Perl_PerlIO_fail_if_has(f, PERLIO_F_NOTREG, EBADF, SS_IVCHAN, -1); #endif - return -1; - } - new = PerlLIO_lseek(fd, offset, whence); + fd = PerlIOSelf(f, PerlIOUnix)->fd; + new = PerlLIO_lseek(fd, offset, whence); if (new == (Off_t) - 1) { return -1; @@ -3110,7 +3120,13 @@ PerlIOStdio_eof(pTHX_ PerlIO *f) IV PerlIOStdio_error(pTHX_ PerlIO *f) { - return PerlSIO_ferror(PerlIOSelf(f, PerlIOStdio)->stdio); + IV stdio_error = PerlSIO_ferror(PerlIOSelf(f, PerlIOStdio)->stdio); + /* Some stdio implementations do not mind e.g. trying to output + * to a write-only filehandle, or vice versa. Therefore we will + * try both the stdio way and the perlio way. */ + IV iobase_error = PerlIOValid(f) ? + ((PerlIOBase(f)->flags & PERLIO_F_ERROR) != 0) : 0; + return stdio_error || iobase_error; } void