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 (file)
--- 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