Record errno value in IO handles
authorFather Chrysostomos <sprout@cpan.org>
Wed, 17 Sep 2014 01:14:34 +0000 (18:14 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Mon, 3 Nov 2014 02:23:42 +0000 (18:23 -0800)
embed.fnc
embed.h
ext/PerlIO-encoding/encoding.xs
ext/PerlIO-scalar/scalar.xs
makedef.pl
perlio.c
perliol.h
proto.h
win32/win32ceio.c
win32/win32io.c

index 930a44d..ab5bb0d 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -2513,6 +2513,8 @@ Ap        |SSize_t|PerlIO_unread          |NULLOK PerlIO *f|NN const void *vbuf \
                                        |Size_t count
 Ap     |Off_t  |PerlIO_tell            |NULLOK PerlIO *f
 Ap     |int    |PerlIO_seek            |NULLOK PerlIO *f|Off_t offset|int whence
+Xp     |void   |PerlIO_save_errno      |NULLOK PerlIO *f
+Xp     |void   |PerlIO_restore_errno   |NULLOK PerlIO *f
 
 Ap     |STDCHAR *|PerlIO_get_base      |NULLOK PerlIO *f
 Ap     |STDCHAR *|PerlIO_get_ptr       |NULLOK PerlIO *f
diff --git a/embed.h b/embed.h
index 365104d..b9ff3c6 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define magic_setcollxfrm(a,b) Perl_magic_setcollxfrm(aTHX_ a,b)
 #define mem_collxfrm(a,b,c)    Perl_mem_collxfrm(aTHX_ a,b,c)
 #  endif
+#  if defined(USE_PERLIO)
+#define PerlIO_restore_errno(a)        Perl_PerlIO_restore_errno(aTHX_ a)
+#define PerlIO_save_errno(a)   Perl_PerlIO_save_errno(aTHX_ a)
+#  endif
 #  if defined(_MSC_VER)
 #define magic_regdatum_set(a,b)        Perl_magic_regdatum_set(aTHX_ a,b)
 #  endif
index cc329d3..d41227c 100644 (file)
@@ -385,7 +385,10 @@ PerlIOEncode_fill(pTHX_ PerlIO * f)
        if (avail == 0)
            PerlIOBase(f)->flags |= PERLIO_F_EOF;
        else
+       {
            PerlIOBase(f)->flags |= PERLIO_F_ERROR;
+           Perl_PerlIO_save_errno(aTHX_ f);
+       }
     }
     FREETMPS;
     LEAVE;
index ca5368e..67e9ae3 100644 (file)
@@ -144,6 +144,7 @@ PerlIOScalar_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
     if (!(PerlIOBase(f)->flags & PERLIO_F_CANREAD)) {
        PerlIOBase(f)->flags |= PERLIO_F_ERROR;
        SETERRNO(EBADF, SS_IVCHAN);
+       Perl_PerlIO_save_errno(aTHX_ f);
        return 0;
     }
     {
index 5f26bcb..cef976b 100644 (file)
@@ -772,6 +772,8 @@ my @layer_syms = qw(
                    Perl_PerlIO_get_cnt
                    Perl_PerlIO_get_ptr
                    Perl_PerlIO_read
+                   Perl_PerlIO_restore_errno
+                   Perl_PerlIO_save_errno
                    Perl_PerlIO_seek
                    Perl_PerlIO_set_cnt
                    Perl_PerlIO_set_ptrcnt
index 7eac37f..08ffc83 100644 (file)
--- a/perlio.c
+++ b/perlio.c
@@ -2059,6 +2059,7 @@ PerlIOBase_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
         if (!(PerlIOBase(f)->flags & PERLIO_F_CANREAD)) {
            PerlIOBase(f)->flags |= PERLIO_F_ERROR;
            SETERRNO(EBADF, SS_IVCHAN);
+           PerlIO_save_errno(f);
            return 0;
        }
        while (count > 0) {
@@ -2731,6 +2732,7 @@ PerlIOUnix_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
            if (len < 0) {
                if (errno != EAGAIN) {
                    PerlIOBase(f)->flags |= PERLIO_F_ERROR;
+                   PerlIO_save_errno(f);
                }
            }
            else if (len == 0 && count != 0) {
@@ -2763,6 +2765,7 @@ PerlIOUnix_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
            if (len < 0) {
                if (errno != EAGAIN) {
                    PerlIOBase(f)->flags |= PERLIO_F_ERROR;
+                   PerlIO_save_errno(f);
                }
            }
            return len;
@@ -3929,6 +3932,7 @@ PerlIOBuf_flush(pTHX_ PerlIO *f)
            }
            else if (count < 0 || PerlIO_error(n)) {
                PerlIOBase(f)->flags |= PERLIO_F_ERROR;
+               PerlIO_save_errno(f);
                code = -1;
                break;
            }
@@ -4031,7 +4035,10 @@ PerlIOBuf_fill(pTHX_ PerlIO *f)
        if (avail == 0)
            PerlIOBase(f)->flags |= PERLIO_F_EOF;
        else
+       {
            PerlIOBase(f)->flags |= PERLIO_F_ERROR;
+           PerlIO_save_errno(f);
+       }
        return -1;
     }
     b->end = b->buf + avail;
@@ -5055,6 +5062,34 @@ PerlIO_tmpfile(void)
      return f;
 }
 
+void
+Perl_PerlIO_save_errno(pTHX_ PerlIO *f)
+{
+    if (!PerlIOValid(f))
+       return;
+    PerlIOBase(f)->err = errno;
+#ifdef VMS
+    PerlIOBase(f)->os_err = vaxc$errno;
+#elif defined(OS2)
+    PerlIOBase(f)->os_err = Perl_rc;
+#elif defined(WIN32)
+    PerlIOBase(f)->os_err = GetLastError();
+#endif
+}
+
+void
+Perl_PerlIO_restore_errno(pTHX_ PerlIO *f)
+{
+    if (!PerlIOValid(f))
+       return;
+    SETERRNO(PerlIOBase(f)->err, PerlIOBase(f)->os_err);
+#ifdef OS2
+    Perl_rc = PerlIOBase(f)->os_err);
+#elif defined(WIN32)
+    SetLastError(PerlIOBase(f)->os_err);
+#endif
+}
+
 #undef HAS_FSETPOS
 #undef HAS_FGETPOS
 
index 2369326..87b1fc7 100644 (file)
--- a/perliol.h
+++ b/perliol.h
@@ -67,6 +67,14 @@ struct _PerlIO {
     PerlIOl *next;             /* Lower layer */
     PerlIO_funcs *tab;         /* Functions for this layer */
     U32 flags;                 /* Various flags for state */
+    int err;                   /* Saved errno value */
+#ifdef VMS
+    unsigned os_err;           /* Saved vaxc$errno value */
+#elif defined (OS2)
+    unsigned long os_err;
+#elif defined (WIN32)
+    DWORD os_err;              /* Saved GetLastError() value */
+#endif
     PerlIOl *head;             /* our ultimate parent pointer */
 };
 
diff --git a/proto.h b/proto.h
index d8994b5..3835a17 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -8125,6 +8125,8 @@ PERL_CALLCONV SSize_t     Perl_PerlIO_read(pTHX_ PerlIO *f, void *vbuf, Size_t count
 #define PERL_ARGS_ASSERT_PERLIO_READ   \
        assert(vbuf)
 
+PERL_CALLCONV void     Perl_PerlIO_restore_errno(pTHX_ PerlIO *f);
+PERL_CALLCONV void     Perl_PerlIO_save_errno(pTHX_ PerlIO *f);
 PERL_CALLCONV int      Perl_PerlIO_seek(pTHX_ PerlIO *f, Off_t offset, int whence);
 PERL_CALLCONV void     Perl_PerlIO_set_cnt(pTHX_ PerlIO *f, SSize_t cnt);
 PERL_CALLCONV void     Perl_PerlIO_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR *ptr, SSize_t cnt);
index e0b75b5..aa916a1 100644 (file)
@@ -226,6 +226,7 @@ PerlIOWin32_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
    if (GetLastError() != NO_ERROR)
     {
      PerlIOBase(f)->flags |= PERLIO_F_ERROR;
+     PerlIO_save_errno(f);
      return -1;
     }
    else
@@ -249,6 +250,7 @@ PerlIOWin32_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
  else
   {
    PerlIOBase(f)->flags |= PERLIO_F_ERROR;
+   PerlIO_save_errno(f);
    return -1;
   }
 }
index dc35d88..00f5bb8 100644 (file)
@@ -230,6 +230,7 @@ PerlIOWin32_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
    if (GetLastError() != NO_ERROR)
     {
      PerlIOBase(f)->flags |= PERLIO_F_ERROR;
+     PerlIO_save_errno(f);
      return -1;
     }
    else
@@ -253,6 +254,7 @@ PerlIOWin32_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
  else
   {
    PerlIOBase(f)->flags |= PERLIO_F_ERROR;
+   PerlIO_save_errno(f);
    return -1;
   }
 }