8446b7
From 89341f87f9fc65c4d7133e497bb04586e86b8052 Mon Sep 17 00:00:00 2001
8446b7
From: Tony Cook <tony@develop-help.com>
8446b7
Date: Tue, 12 May 2020 10:29:17 +1000
8446b7
Subject: [PATCH 1/2] make $fh->error report errors from both input and output
8446b7
MIME-Version: 1.0
8446b7
Content-Type: text/plain; charset=UTF-8
8446b7
Content-Transfer-Encoding: 8bit
8446b7
8446b7
For character devices and sockets perl uses separate PerlIO objects
8446b7
for input and output so they can be buffered separately.
8446b7
8446b7
The IO::Handle::error() method only checked the input stream, so
8446b7
if a write error occurs error() would still returned false.
8446b7
8446b7
Change this so both the input and output streams are checked.
8446b7
8446b7
fixes #6799
8446b7
8446b7
Signed-off-by: Petr Písař <ppisar@redhat.com>
8446b7
---
8446b7
 dist/IO/IO.xs     | 12 ++++++++----
8446b7
 dist/IO/t/io_xs.t | 19 ++++++++++++++++++-
8446b7
 2 files changed, 26 insertions(+), 5 deletions(-)
8446b7
8446b7
diff --git a/dist/IO/IO.xs b/dist/IO/IO.xs
8446b7
index 68b7352c38..99d523d2c1 100644
8446b7
--- a/dist/IO/IO.xs
8446b7
+++ b/dist/IO/IO.xs
8446b7
@@ -389,13 +389,17 @@ ungetc(handle, c)
8446b7
 
8446b7
 int
8446b7
 ferror(handle)
8446b7
-	InputStream	handle
8446b7
+	SV *	handle
8446b7
+    PREINIT:
8446b7
+        IO *io = sv_2io(handle);
8446b7
+        InputStream in = IoIFP(io);
8446b7
+        OutputStream out = IoOFP(io);
8446b7
     CODE:
8446b7
-	if (handle)
8446b7
+	if (in)
8446b7
 #ifdef PerlIO
8446b7
-	    RETVAL = PerlIO_error(handle);
8446b7
+	    RETVAL = PerlIO_error(in) || (in != out && PerlIO_error(out));
8446b7
 #else
8446b7
-	    RETVAL = ferror(handle);
8446b7
+	    RETVAL = ferror(in) || (in != out && ferror(out));
8446b7
 #endif
8446b7
 	else {
8446b7
 	    RETVAL = -1;
8446b7
diff --git a/dist/IO/t/io_xs.t b/dist/IO/t/io_xs.t
8446b7
index 1e3c49a4a7..f890e92558 100644
8446b7
--- a/dist/IO/t/io_xs.t
8446b7
+++ b/dist/IO/t/io_xs.t
8446b7
@@ -11,7 +11,7 @@ BEGIN {
8446b7
     }
8446b7
 }
8446b7
 
8446b7
-use Test::More tests => 5;
8446b7
+use Test::More tests => 7;
8446b7
 use IO::File;
8446b7
 use IO::Seekable;
8446b7
 
8446b7
@@ -50,3 +50,20 @@ SKIP:
8446b7
     ok($fh->sync, "sync to a read only handle")
8446b7
 	or diag "sync(): ", $!;
8446b7
 }
8446b7
+
8446b7
+
8446b7
+SKIP: {
8446b7
+    # gh 6799
8446b7
+    #
8446b7
+    # This isn't really a Linux/BSD specific test, but /dev/full is (I
8446b7
+    # hope) reasonably well defined on these.  Patches welcome if your platform
8446b7
+    # also supports it (or something like it)
8446b7
+    skip "no /dev/full or not a /dev/full platform", 2
8446b7
+      unless $^O =~ /^(linux|netbsd|freebsd)$/ && -c "/dev/full";
8446b7
+    open my $fh, ">", "/dev/full"
8446b7
+      or skip "Could not open /dev/full: $!", 2;
8446b7
+    $fh->print("a" x 1024);
8446b7
+    ok(!$fh->flush, "should fail to flush");
8446b7
+    ok($fh->error, "stream should be in error");
8446b7
+    close $fh; # silently ignore the error
8446b7
+}
8446b7
-- 
8446b7
2.25.4
8446b7