For now reword the sysread/syswrite description to
[p5sagit/p5-mst-13.2.git] / perlio.c
index 3a05273..05b53c9 100644 (file)
--- a/perlio.c
+++ b/perlio.c
@@ -51,7 +51,7 @@
 #include "XSUB.h"
 
 /* Call the callback or PerlIOBase, and return failure. */
-#define PERL_PERLIO_BASE(f, callback, base, failure, args)     \
+#define Perl_PerlIO_or_Base(f, callback, base, failure, args)  \
        if (PerlIOValid(f)) {                                   \
                PerlIO_funcs *tab = PerlIOBase(f)->tab;         \
                if (tab && tab->callback)                       \
@@ -64,7 +64,7 @@
        return failure
 
 /* Call the callback or fail, and return failure. */
-#define PERL_PERLIO_FAIL(f, callback, failure, args)           \
+#define Perl_PerlIO_or_fail(f, callback, failure, args)        \
        if (PerlIOValid(f)) {                                   \
                PerlIO_funcs *tab = PerlIOBase(f)->tab;         \
                if (tab && tab->callback)                       \
        return failure
 
 /* Call the callback or PerlIOBase, and be void. */
-#define PERL_PERLIO_VOID_BASE(f, callback, base, args)                 \
+#define Perl_PerlIO_or_Base_void(f, callback, base, args)      \
        if (PerlIOValid(f)) {                                   \
                PerlIO_funcs *tab = PerlIOBase(f)->tab;         \
                if (tab && tab->callback)                       \
                        (*tab->callback) args;                  \
                else                                            \
                        PerlIOBase_ ## base args;               \
-               SETERRNO(EINVAL, LIB_INVARG);                   \
        }                                                       \
        else                                                    \
                SETERRNO(EBADF, SS_IVCHAN)
 
 /* Call the callback or fail, and be void. */
-#define PERL_PERLIO_VOID_FAIL(f, callback, args)               \
+#define Perl_PerlIO_or_fail_void(f, callback, args)            \
        if (PerlIOValid(f)) {                                   \
                PerlIO_funcs *tab = PerlIOBase(f)->tab;         \
                if (tab && tab->callback)                       \
                        (*tab->callback) args;                  \
-               SETERRNO(EINVAL, LIB_INVARG);                   \
+               else                                            \
+                       SETERRNO(EINVAL, LIB_INVARG);           \
        }                                                       \
        else                                                    \
                SETERRNO(EBADF, SS_IVCHAN)
@@ -430,9 +430,11 @@ PerlIO_findFILE(PerlIO *pio)
 #include <sys/mman.h>
 #endif
 
-
+/*
+ * Why is this here - not in perlio.h?  RMB
+ */
 void PerlIO_debug(const char *fmt, ...)
-    __attribute__ ((format(__printf__, 1, 2)));
+    __attribute__format__(__printf__, 1, 2);
 
 void
 PerlIO_debug(const char *fmt, ...)
@@ -524,15 +526,17 @@ PerlIO_fdupopen(pTHX_ PerlIO *f, CLONE_PARAMS *param, int flags)
 {
     if (PerlIOValid(f)) {
        PerlIO_funcs *tab = PerlIOBase(f)->tab;
-       PerlIO *new;
        PerlIO_debug("fdupopen f=%p param=%p\n",(void*)f,(void*)param);
-       new = (*tab->Dup)(aTHX_ PerlIO_allocate(aTHX),f,param, flags);
-       return new;
-    }
-    else {
-       SETERRNO(EBADF, SS_IVCHAN);
-       return NULL;
+       if (tab && tab->Dup)
+            return (*tab->Dup)(aTHX_ PerlIO_allocate(aTHX), f, param, flags);
+       else {
+            return PerlIOBase_dup(aTHX_ PerlIO_allocate(aTHX), f, param, flags);
+       }
     }
+    else
+        SETERRNO(EBADF, SS_IVCHAN);
+
+    return NULL;
 }
 
 void
@@ -855,7 +859,7 @@ PerlIO_tab_sv(pTHX_ PerlIO_funcs *tab)
 
 XS(XS_PerlIO__Layer__NoWarnings)
 {
-    /* This is used as a %SIG{__WARN__} handler to supress warnings 
+    /* This is used as a %SIG{__WARN__} handler to supress warnings
        during loading of layers.
      */
     dXSARGS;
@@ -1153,7 +1157,8 @@ PerlIO_push(pTHX_ PerlIO *f, PerlIO_funcs *tab, const char *mode, SV *arg)
            *f = l;
            PerlIO_debug("PerlIO_push f=%p %s %s %p\n", (void*)f, tab->name,
                        (mode) ? mode : "(Null)", (void*)arg);
-           if ((*l->tab->Pushed) (aTHX_ f, mode, arg, tab) != 0) {
+           if (*l->tab->Pushed &&
+               (*l->tab->Pushed) (aTHX_ f, mode, arg, tab) != 0) {
                PerlIO_pop(aTHX_ f);
                return NULL;
            }
@@ -1163,8 +1168,9 @@ PerlIO_push(pTHX_ PerlIO *f, PerlIO_funcs *tab, const char *mode, SV *arg)
        /* Pseudo-layer where push does its own stack adjust */
        PerlIO_debug("PerlIO_push f=%p %s %s %p\n", (void*)f, tab->name,
                     (mode) ? mode : "(Null)", (void*)arg);
-       if ((*tab->Pushed) (aTHX_ f, mode, arg, tab) != 0) {
-           return NULL;
+       if (tab->Pushed &&
+           (*tab->Pushed) (aTHX_ f, mode, arg, tab) != 0) {
+            return NULL;
        }
     }
     return f;
@@ -1323,8 +1329,13 @@ PerlIO_binmode(pTHX_ PerlIO *f, int iotype, int mode, const char *names)
 int
 PerlIO__close(pTHX_ PerlIO *f)
 {
-    if (PerlIOValid(f))
-       return (*PerlIOBase(f)->tab->Close) (aTHX_ f);
+    if (PerlIOValid(f)) {
+       PerlIO_funcs *tab = PerlIOBase(f)->tab;
+       if (tab && tab->Close)
+           return (*tab->Close)(aTHX_ f);
+       else
+           return PerlIOBase_close(aTHX_ f);
+    }
     else {
        SETERRNO(EBADF, SS_IVCHAN);
        return -1;
@@ -1334,28 +1345,17 @@ PerlIO__close(pTHX_ PerlIO *f)
 int
 Perl_PerlIO_close(pTHX_ PerlIO *f)
 {
-    int code = -1;
-
-    if (PerlIOValid(f)) {
-        PerlIO_funcs *tab = PerlIOBase(f)->tab;
-
-        if (tab && tab->Close) {
-             code = (*tab->Close)(aTHX_ f);
-             while (*f) {
-                  PerlIO_pop(aTHX_ f);
-             }
-        }
-        else
-             PerlIOBase_close(aTHX_ f);
+    int code = PerlIO__close(aTHX_ f);
+    while (PerlIOValid(f)) {
+       PerlIO_pop(aTHX_ f);
     }
-
     return code;
 }
 
 int
 Perl_PerlIO_fileno(pTHX_ PerlIO *f)
 {
-     PERL_PERLIO_BASE(f, Fileno, fileno, -1, (aTHX_ f));
+     Perl_PerlIO_or_Base(f, Fileno, fileno, -1, (aTHX_ f));
 }
 
 static const char *
@@ -1526,8 +1526,13 @@ PerlIO_openn(pTHX_ const char *layers, const char *mode, int fd,
            PerlIO_debug("openn(%s,'%s','%s',%d,%x,%o,%p,%d,%p)\n",
                         tab->name, layers, mode, fd, imode, perm,
                         (void*)f, narg, (void*)args);
-           f = (*tab->Open) (aTHX_ tab, layera, n, mode, fd, imode, perm,
-                             f, narg, args);
+           if (tab->Open)
+                f = (*tab->Open) (aTHX_ tab, layera, n, mode, fd, imode, perm,
+                                  f, narg, args);
+           else {
+                SETERRNO(EINVAL, LIB_INVARG);
+                f = NULL;
+           }
            if (f) {
                if (n + 1 < layera->cur) {
                    /*
@@ -1551,31 +1556,31 @@ 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_BASE(f, Read, read, -1, (aTHX_ f, vbuf, count));
+     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_BASE(f, Unread, unread, -1, (aTHX_ f, vbuf, count));
+     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(f, Write, -1, (aTHX_ f, vbuf, count));
+     Perl_PerlIO_or_fail(f, Write, -1, (aTHX_ f, vbuf, count));
 }
 
 int
 Perl_PerlIO_seek(pTHX_ PerlIO *f, Off_t offset, int whence)
 {
-     PERL_PERLIO_FAIL(f, Seek, -1, (aTHX_ f, offset, whence));
+     Perl_PerlIO_or_fail(f, Seek, -1, (aTHX_ f, offset, whence));
 }
 
 Off_t
 Perl_PerlIO_tell(pTHX_ PerlIO *f)
 {
-     PERL_PERLIO_FAIL(f, Tell, -1, (aTHX_ f));
+     Perl_PerlIO_or_fail(f, Tell, -1, (aTHX_ f));
 }
 
 int
@@ -1641,7 +1646,7 @@ PerlIOBase_flush_linebuf(pTHX)
 int
 Perl_PerlIO_fill(pTHX_ PerlIO *f)
 {
-     PERL_PERLIO_FAIL(f, Fill, -1, (aTHX_ f));
+     Perl_PerlIO_or_fail(f, Fill, -1, (aTHX_ f));
 }
 
 int
@@ -1651,32 +1656,32 @@ PerlIO_isutf8(PerlIO *f)
          return (PerlIOBase(f)->flags & PERLIO_F_UTF8) != 0;
      else
          SETERRNO(EBADF, SS_IVCHAN);
-     
+
      return -1;
 }
 
 int
 Perl_PerlIO_eof(pTHX_ PerlIO *f)
 {
-     PERL_PERLIO_BASE(f, Eof, eof, -1, (aTHX_ f));
+     Perl_PerlIO_or_Base(f, Eof, eof, -1, (aTHX_ f));
 }
 
 int
 Perl_PerlIO_error(pTHX_ PerlIO *f)
 {
-     PERL_PERLIO_BASE(f, Error, error, -1, (aTHX_ f));
+     Perl_PerlIO_or_Base(f, Error, error, -1, (aTHX_ f));
 }
 
 void
 Perl_PerlIO_clearerr(pTHX_ PerlIO *f)
 {
-     PERL_PERLIO_VOID_BASE(f, Clearerr, clearerr, (aTHX_ f));
+     Perl_PerlIO_or_Base_void(f, Clearerr, clearerr, (aTHX_ f));
 }
 
 void
 Perl_PerlIO_setlinebuf(pTHX_ PerlIO *f)
 {
-     PERL_PERLIO_VOID_BASE(f, Setlinebuf, setlinebuf, (aTHX_ f));
+     Perl_PerlIO_or_Base_void(f, Setlinebuf, setlinebuf, (aTHX_ f));
 }
 
 int
@@ -1746,37 +1751,37 @@ PerlIO_canset_cnt(PerlIO *f)
 STDCHAR *
 Perl_PerlIO_get_base(pTHX_ PerlIO *f)
 {
-     PERL_PERLIO_FAIL(f, Get_base, NULL, (aTHX_ f));
+     Perl_PerlIO_or_fail(f, Get_base, NULL, (aTHX_ f));
 }
 
 int
 Perl_PerlIO_get_bufsiz(pTHX_ PerlIO *f)
 {
-     PERL_PERLIO_FAIL(f, Get_bufsiz, -1, (aTHX_ f));
+     Perl_PerlIO_or_fail(f, Get_bufsiz, -1, (aTHX_ f));
 }
 
 STDCHAR *
 Perl_PerlIO_get_ptr(pTHX_ PerlIO *f)
 {
-     PERL_PERLIO_FAIL(f, Get_ptr, NULL, (aTHX_ f));
+     Perl_PerlIO_or_fail(f, Get_ptr, NULL, (aTHX_ f));
 }
 
 int
 Perl_PerlIO_get_cnt(pTHX_ PerlIO *f)
 {
-     PERL_PERLIO_FAIL(f, Get_cnt, -1, (aTHX_ f));
+     Perl_PerlIO_or_fail(f, Get_cnt, -1, (aTHX_ f));
 }
 
 void
 Perl_PerlIO_set_cnt(pTHX_ PerlIO *f, int cnt)
 {
-     PERL_PERLIO_VOID_FAIL(f, Set_ptrcnt, (aTHX_ f, NULL, cnt));
+     Perl_PerlIO_or_fail_void(f, Set_ptrcnt, (aTHX_ f, NULL, cnt));
 }
 
 void
 Perl_PerlIO_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR * ptr, int cnt)
 {
-     PERL_PERLIO_VOID_FAIL(f, Set_ptrcnt, (aTHX_ f, ptr, cnt));
+     Perl_PerlIO_or_fail_void(f, Set_ptrcnt, (aTHX_ f, ptr, cnt));
 }
 
 
@@ -1862,8 +1867,11 @@ PerlIORaw_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
               PerlIO *old, int narg, SV **args)
 {
     PerlIO_funcs *tab = PerlIO_default_btm();
-    return (*tab->Open) (aTHX_ tab, layers, n - 1, mode, fd, imode, perm,
-                        old, narg, args);
+    if (tab && tab->Open)
+        return (*tab->Open) (aTHX_ tab, layers, n - 1, mode, fd, imode, perm,
+                             old, narg, args);
+    SETERRNO(EINVAL, LIB_INVARG);
+    return NULL;
 }
 
 PerlIO_funcs PerlIO_raw = {
@@ -2064,14 +2072,29 @@ PerlIOBase_noop_fail(pTHX_ PerlIO *f)
 IV
 PerlIOBase_close(pTHX_ PerlIO *f)
 {
-    IV code = 0;
-    PerlIO *n = PerlIONext(f);
-    if (PerlIO_flush(f) != 0)
-       code = -1;
-    if (PerlIOValid(n) && (*PerlIOBase(n)->tab->Close)(aTHX_ n) != 0)
-       code = -1;
-    PerlIOBase(f)->flags &=
-       ~(PERLIO_F_CANREAD | PERLIO_F_CANWRITE | PERLIO_F_OPEN);
+    IV code = -1;
+    if (PerlIOValid(f)) {
+       PerlIO *n = PerlIONext(f);
+       code = PerlIO_flush(f);
+       PerlIOBase(f)->flags &=
+          ~(PERLIO_F_CANREAD | PERLIO_F_CANWRITE | PERLIO_F_OPEN);
+       while (PerlIOValid(n)) {
+           PerlIO_funcs *tab = PerlIOBase(n)->tab;
+           if (tab && tab->Close) {
+               if ((*tab->Close)(aTHX_ n) != 0)
+                   code = -1;
+               break;
+           }
+           else {
+               PerlIOBase(n)->flags &=
+                   ~(PERLIO_F_CANREAD | PERLIO_F_CANWRITE | PERLIO_F_OPEN);
+           }
+           n = PerlIONext(n);
+       }
+    }
+    else {
+       SETERRNO(EBADF, SS_IVCHAN);
+    }
     return code;
 }
 
@@ -2135,16 +2158,21 @@ PerlIOBase_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags)
     PerlIO *nexto = PerlIONext(o);
     if (PerlIOValid(nexto)) {
        PerlIO_funcs *tab = PerlIOBase(nexto)->tab;
-       f = (*tab->Dup)(aTHX_ f, nexto, param, flags);
+       if (tab && tab->Dup)
+           f = (*tab->Dup)(aTHX_ f, nexto, param, flags);
+       else
+           f = PerlIOBase_dup(aTHX_ f, nexto, param, flags);
     }
     if (f) {
        PerlIO_funcs *self = PerlIOBase(o)->tab;
-       SV *arg = Nullsv;
+       SV *arg;
        char buf[8];
        PerlIO_debug("PerlIOBase_dup %s f=%p o=%p param=%p\n",
                     self->name, (void*)f, (void*)o, (void*)param);
-       if (self->Getarg) {
-           arg = (*self->Getarg)(aTHX_ o,param,flags);
+       if (self->Getarg)
+           arg = (*self->Getarg)(aTHX_ o, param, flags);
+       else {
+           arg = Nullsv;
        }
        f = PerlIO_push(aTHX_ f, self, PerlIO_modestr(o,buf), arg);
        if (arg) {
@@ -2303,23 +2331,44 @@ PerlIOUnix_fileno(pTHX_ PerlIO *f)
     return PerlIOSelf(f, PerlIOUnix)->fd;
 }
 
+static void
+PerlIOUnix_setfd(pTHX_ PerlIO *f, int fd, int imode)
+{
+    PerlIOUnix *s = PerlIOSelf(f, PerlIOUnix);
+#if defined(WIN32)
+    Stat_t st;
+    if (PerlLIO_fstat(fd, &st) == 0) {
+       if (!S_ISREG(st.st_mode)) {
+           PerlIO_debug("%d is not regular file\n",fd);
+           PerlIOBase(f)->flags |= PERLIO_F_NOTREG;
+       }
+       else {
+           PerlIO_debug("%d _is_ a regular file\n",fd);
+       }
+    }
+#endif
+    s->fd = fd;
+    s->oflags = imode;
+    PerlIOUnix_refcnt_inc(fd);
+}
+
 IV
 PerlIOUnix_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
 {
     IV code = PerlIOBase_pushed(aTHX_ f, mode, arg, tab);
-    PerlIOUnix *s = PerlIOSelf(f, PerlIOUnix);
     if (*PerlIONext(f)) {
        /* We never call down so do 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
         * handle rather than believing the "mode" we are passed in? XXX
         * Should the value on NULL mode be 0 or -1?
         */
-       s->oflags = mode ? PerlIOUnix_oflags(mode) : -1;
+        PerlIOUnix_setfd(aTHX_ f, PerlIO_fileno(PerlIONext(f)),
+                         mode ? PerlIOUnix_oflags(mode) : -1);
     }
     PerlIOBase(f)->flags |= PERLIO_F_OPEN;
+
     return code;
 }
 
@@ -2345,7 +2394,6 @@ PerlIOUnix_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
        }
     }
     if (fd >= 0) {
-       PerlIOUnix *s;
        if (*mode == 'I')
            mode++;
        if (!f) {
@@ -2356,11 +2404,8 @@ PerlIOUnix_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
                return NULL;
            }
        }
-       s = PerlIOSelf(f, PerlIOUnix);
-       s->fd = fd;
-       s->oflags = imode;
+        PerlIOUnix_setfd(aTHX_ f, fd, imode);
        PerlIOBase(f)->flags |= PERLIO_F_OPEN;
-       PerlIOUnix_refcnt_inc(fd);
        return f;
     }
     else {
@@ -2385,9 +2430,7 @@ PerlIOUnix_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags)
        f = PerlIOBase_dup(aTHX_ f, o, param, flags);
        if (f) {
            /* If all went well overwrite fd in dup'ed lay with the dup()'ed fd */
-           PerlIOUnix *s = PerlIOSelf(f, PerlIOUnix);
-           s->fd = fd;
-           PerlIOUnix_refcnt_inc(fd);
+           PerlIOUnix_setfd(aTHX_ f, fd, os->oflags);
            return f;
        }
     }
@@ -2406,10 +2449,15 @@ PerlIOUnix_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
     while (1) {
        SSize_t len = PerlLIO_read(fd, vbuf, count);
        if (len >= 0 || errno != EINTR) {
-           if (len < 0)
-               PerlIOBase(f)->flags |= PERLIO_F_ERROR;
-           else if (len == 0 && count != 0)
+           if (len < 0) {
+               if (errno != EAGAIN) {
+                   PerlIOBase(f)->flags |= PERLIO_F_ERROR;
+               }
+           }
+           else if (len == 0 && count != 0) {
                PerlIOBase(f)->flags |= PERLIO_F_EOF;
+               SETERRNO(0,0);
+           }
            return len;
        }
        PERL_ASYNC_CHECK();
@@ -2423,8 +2471,11 @@ PerlIOUnix_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
     while (1) {
        SSize_t len = PerlLIO_write(fd, vbuf, count);
        if (len >= 0 || errno != EINTR) {
-           if (len < 0)
-               PerlIOBase(f)->flags |= PERLIO_F_ERROR;
+           if (len < 0) {
+               if (errno != EAGAIN) {
+                   PerlIOBase(f)->flags |= PERLIO_F_ERROR;
+               }
+           }
            return len;
        }
        PERL_ASYNC_CHECK();
@@ -2434,10 +2485,23 @@ PerlIOUnix_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
 IV
 PerlIOUnix_seek(pTHX_ PerlIO *f, Off_t offset, int whence)
 {
-    Off_t new =
-       PerlLIO_lseek(PerlIOSelf(f, PerlIOUnix)->fd, offset, whence);
+    int fd = PerlIOSelf(f, PerlIOUnix)->fd;
+    Off_t new;
+    if (PerlIOBase(f)->flags & PERLIO_F_NOTREG) {
+#ifdef  ESPIPE
+       SETERRNO(ESPIPE, LIB_INVARG);
+#else
+       SETERRNO(EINVAL, LIB_INVARG);
+#endif
+       return -1;
+    }
+    new  = PerlLIO_lseek(fd, offset, whence);
+    if (new == (Off_t) - 1)
+     {
+      return -1;
+     }
     PerlIOBase(f)->flags &= ~PERLIO_F_EOF;
-    return (new == (Off_t) - 1) ? -1 : 0;
+    return  0;
 }
 
 Off_t
@@ -2738,11 +2802,11 @@ static int
 PerlIOStdio_invalidate_fileno(pTHX_ FILE *f)
 {
     /* XXX this could use PerlIO_canset_fileno() and
-     * PerlIO_set_fileno() support from Configure 
+     * PerlIO_set_fileno() support from Configure
      */
 #  if defined(__GLIBC__)
     /* There may be a better way for GLIBC:
-       - libio.h defines a flag to not close() on cleanup 
+       - libio.h defines a flag to not close() on cleanup
      */        
     f->_fileno = -1;
     return 1;
@@ -2754,7 +2818,7 @@ PerlIOStdio_invalidate_fileno(pTHX_ FILE *f)
      *      long __pad[16];
      *  };
      *
-     * It turns out that the fd is stored in the top 32 bits of 
+     * It turns out that the fd is stored in the top 32 bits of
      * file->__pad[4]. The lower 32 bits contain flags. file->pad[5] appears
      * to contain a pointer or offset into another structure. All the
      * remaining fields are zero.
@@ -2764,9 +2828,9 @@ PerlIOStdio_invalidate_fileno(pTHX_ FILE *f)
     f->__pad[4] |= 0xffffffff00000000L;
     assert(fileno(f) == 0xffffffff);
 #    else /* !defined(_LP64) */
-    /* _file is just a unsigned char :-( 
-       Not clear why we dup() rather than using -1 
-       even if that would be treated as 0xFF - so will 
+    /* _file is just a unsigned char :-(
+       Not clear why we dup() rather than using -1
+       even if that would be treated as 0xFF - so will
        a dup fail ...
      */
     f->_file = PerlLIO_dup(fileno(f));
@@ -2777,24 +2841,24 @@ PerlIOStdio_invalidate_fileno(pTHX_ FILE *f)
     f->__fileL = 0xff;
     return 1;
    /* Next one ->_file seems to be a reasonable fallback, i.e. if
-      your platform does not have special entry try this one.       
+      your platform does not have special entry try this one.
       [For OSF only have confirmation for Tru64 (alpha)
       but assume other OSFs will be similar.]
-    */    
+    */
 #  elif defined(_AIX) || defined(__osf__) || defined(__irix__)
     f->_file = -1;
     return 1;
 #  elif defined(__FreeBSD__)
     /* There may be a better way on FreeBSD:
-        - we could insert a dummy func in the _close function entry 
-       f->_close = (int (*)(void *)) dummy_close; 
+        - we could insert a dummy func in the _close function entry
+       f->_close = (int (*)(void *)) dummy_close;
      */
     f->_file = -1;
     return 1;
 #  elif defined(__CYGWIN__)
     /* There may be a better way on CYGWIN:
-        - we could insert a dummy func in the _close function entry 
-       f->_close = (int (*)(void *)) dummy_close; 
+        - we could insert a dummy func in the _close function entry
+       f->_close = (int (*)(void *)) dummy_close;
      */
     f->_file = -1;
     return 1;
@@ -2811,9 +2875,9 @@ PerlIOStdio_invalidate_fileno(pTHX_ FILE *f)
     return 1;
 #  else
 #if 0
-    /* Sarathy's code did this - we fall back to a dup/dup2 hack 
+    /* Sarathy's code did this - we fall back to a dup/dup2 hack
        (which isn't thread safe) instead
-     */  
+     */
 #    error "Don't know how to set FILE.fileno on your platform"
 #endif
     return 0;
@@ -2836,25 +2900,25 @@ PerlIOStdio_close(pTHX_ PerlIO *f)
        int saveerr = 0;
        int dupfd = 0;
 #ifdef SOCKS5_VERSION_NAME
-       /* Socks lib overrides close() but stdio isn't linked to 
-          that library (though we are) - so we must call close() 
-          on sockets on stdio's behalf. 
-        */   
+       /* Socks lib overrides close() but stdio isn't linked to
+          that library (though we are) - so we must call close()
+          on sockets on stdio's behalf.
+        */
        int optval;
        Sock_size_t optlen = sizeof(int);
        if (getsockopt(fd, SOL_SOCKET, SO_TYPE, (void *) &optval, &optlen) == 0) {
             socksfd = 1;
-           invalidate = 1;  
+           invalidate = 1;
        }
 #endif
        if (PerlIOUnix_refcnt_dec(fd) > 0) {
            /* File descriptor still in use */
            invalidate = 1;
            socksfd = 0;
-       }    
+       }
        if (invalidate) {
-           /* For STD* handles don't close the stdio at all 
-              this is because we have shared the FILE * too 
+           /* For STD* handles don't close the stdio at all
+              this is because we have shared the FILE * too
             */
            if (stdio == stdin) {
                /* Some stdios are buggy fflush-ing inputs */
@@ -2863,34 +2927,34 @@ PerlIOStdio_close(pTHX_ PerlIO *f)
            else if (stdio == stdout || stdio == stderr) {
                return PerlIO_flush(f);
            }
-            /* Tricky - must fclose(stdio) to free memory but not close(fd) 
-              Use Sarathy's trick from maint-5.6 to invalidate the 
-              fileno slot of the FILE * 
-           */ 
+            /* Tricky - must fclose(stdio) to free memory but not close(fd)
+              Use Sarathy's trick from maint-5.6 to invalidate the
+              fileno slot of the FILE *
+           */
            result = PerlIO_flush(f);
            saveerr = errno;
            if (!(invalidate = PerlIOStdio_invalidate_fileno(aTHX_ stdio))) {
                dupfd = PerlLIO_dup(fd);
            }
-       } 
+       }
         result = PerlSIO_fclose(stdio);
-       /* We treat error from stdio as success if we invalidated 
-          errno may NOT be expected EBADF 
+       /* We treat error from stdio as success if we invalidated
+          errno may NOT be expected EBADF
         */
        if (invalidate && result != 0) {
            errno = saveerr;
            result = 0;
-       } 
+       }
        if (socksfd) {
            /* in SOCKS case let close() determine return value */
            result = close(fd);
        }
        if (dupfd) {
            PerlLIO_dup2(dupfd,fd);
-           close(dupfd);
+           PerlLIO_close(dupfd);
        }
        return result;
-    } 
+    }
 }
 
 SSize_t
@@ -2913,10 +2977,10 @@ PerlIOStdio_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
        }
        else
            got = PerlSIO_fread(vbuf, 1, count, s);
-       if (got || errno != EINTR)
+       if (got >= 0 || errno != EINTR)
            break;
        PERL_ASYNC_CHECK();
-       errno = 0;      /* just in case */
+       SETERRNO(0,0);  /* just in case */
     }
     return got;
 }
@@ -2986,10 +3050,10 @@ PerlIOStdio_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
     for (;;) {
        got = PerlSIO_fwrite(vbuf, 1, count,
                              PerlIOSelf(f, PerlIOStdio)->stdio);
-       if (got || errno != EINTR)
+       if (got >= 0 || errno != EINTR)
            break;
        PERL_ASYNC_CHECK();
-       errno = 0;      /* just in case */
+       SETERRNO(0,0);  /* just in case */
     }
     return got;
 }
@@ -3662,7 +3726,7 @@ PerlIOBuf_tell(pTHX_ PerlIO *f)
      * b->posn is file position where b->buf was read, or will be written
      */
     Off_t posn = b->posn;
-    if ((PerlIOBase(f)->flags & PERLIO_F_APPEND) && 
+    if ((PerlIOBase(f)->flags & PERLIO_F_APPEND) &&
         (PerlIOBase(f)->flags & PERLIO_F_WRBUF)) {
 #if 1
        /* As O_APPEND files are normally shared in some sense it is better
@@ -3670,7 +3734,7 @@ PerlIOBuf_tell(pTHX_ PerlIO *f)
         */     
        PerlIO_flush(f);
 #else  
-        /* when file is NOT shared then this is sufficient */ 
+        /* when file is NOT shared then this is sufficient */
        PerlIO_seek(PerlIONext(f),0, SEEK_END);
 #endif
        posn = b->posn = PerlIO_tell(PerlIONext(f));