make IO::Handle::error report errors from both input and output streams

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
 

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 {

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;
 	}

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
+}