diff options
| author | Father Chrysostomos <sprout@cpan.org> | 2014-09-16 18:14:34 -0700 |
|---|---|---|
| committer | Father Chrysostomos <sprout@cpan.org> | 2014-11-02 18:23:42 -0800 |
| commit | 0ea86a1054b1b9ede7f0a103059629f7027035e4 (patch) | |
| tree | 7042433768e56ef5626f4777243c30cd2f158360 /perlio.c | |
| parent | 90a44ae623db0999c98093c3bb234c1479755a2c (diff) | |
| download | perl-0ea86a1054b1b9ede7f0a103059629f7027035e4.tar.gz | |
Record errno value in IO handles
Diffstat (limited to 'perlio.c')
| -rw-r--r-- | perlio.c | 35 |
1 files changed, 35 insertions, 0 deletions
@@ -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 |