diff --git a/dist/IO/ChangeLog b/dist/IO/ChangeLog index 5ed2b464579f..52f74dff4ab2 100644 --- a/dist/IO/ChangeLog +++ b/dist/IO/ChangeLog @@ -1,3 +1,16 @@ +IO 1.44 + * IO::Handle::error() now checks both the input and output stream + for error. This is an issue for sockets and character devices. GH #6799 + * IO::Handle::clearerr() now clears the error on both input and + output streams. + +IO 1.43 + * only cache the protocol for sockets when one is supplied, + otherwise protocol could return an incorrect protocol. This means + that on platforms that don't support SO_PROTOCOL (or don't support + it for some socket types) protocol() can now return undef. + + IO 1.42 - Jan 20 2020 - Todd Rinaldo * Point IO support to perl/perl5 not dual-life/IO diff --git a/dist/IO/IO.pm b/dist/IO/IO.pm index eacd4c2bd646..5b637df61dcc 100644 --- a/dist/IO/IO.pm +++ b/dist/IO/IO.pm @@ -7,7 +7,7 @@ use Carp; use strict; use warnings; -our $VERSION = "1.43"; +our $VERSION = "1.44"; XSLoader::load 'IO', $VERSION; sub import { diff --git a/dist/IO/IO.xs b/dist/IO/IO.xs index 68b7352c3887..91581064167c 100644 --- a/dist/IO/IO.xs +++ b/dist/IO/IO.xs @@ -389,13 +389,17 @@ ungetc(handle, c) int ferror(handle) - InputStream handle + SV * handle + PREINIT: + IO *io = sv_2io(handle); + InputStream in = IoIFP(io); + OutputStream out = IoOFP(io); CODE: - if (handle) + if (in) #ifdef PerlIO - RETVAL = PerlIO_error(handle); + RETVAL = PerlIO_error(in) || (in != out && PerlIO_error(out)); #else - RETVAL = ferror(handle); + RETVAL = ferror(in) || (in != out && ferror(out)); #endif else { RETVAL = -1; @@ -406,13 +410,21 @@ ferror(handle) int clearerr(handle) - InputStream handle + SV * handle + PREINIT: + IO *io = sv_2io(handle); + InputStream in = IoIFP(io); + OutputStream out = IoOFP(io); CODE: if (handle) { #ifdef PerlIO - PerlIO_clearerr(handle); + PerlIO_clearerr(in); + if (in != out) + PerlIO_clearerr(out); #else - clearerr(handle); + clearerr(in); + if (in != out) + clearerr(out); #endif RETVAL = 0; } diff --git a/dist/IO/t/io_xs.t b/dist/IO/t/io_xs.t index f7d7258caf88..d406769db114 100644 --- a/dist/IO/t/io_xs.t +++ b/dist/IO/t/io_xs.t @@ -11,7 +11,7 @@ BEGIN { } } -use Test::More tests => 5; +use Test::More tests => 8; use IO::File; use IO::Seekable; @@ -50,3 +50,22 @@ SKIP: ok($fh->sync, "sync to a read only handle") or diag "sync(): ", $!; } + + +SKIP: { + # gh 6799 + # + # This isn't really a Linux/BSD specific test, but /dev/full is (I + # hope) reasonably well defined on these. Patches welcome if your platform + # also supports it (or something like it) + skip "no /dev/full or not a /dev/full platform", 3 + unless $^O =~ /^(linux|netbsd|freebsd)$/ && -c "/dev/full"; + open my $fh, ">", "/dev/full" + or skip "Could not open /dev/full: $!", 3; + $fh->print("a" x 1024); + ok(!$fh->flush, "should fail to flush"); + ok($fh->error, "stream should be in error"); + $fh->clearerr; + ok(!$fh->error, "check clearerr removed the error"); + close $fh; # silently ignore the error +}