Fix IO::Handle::error() to report write errors

perl-5.33.0-IO-Handle-clear-the-error-on-both-input-and-output-s.patch

@@ -0,0 +1,80 @@
+From fc5f3468dcbee38eb202cfd552a5b8dbff990c7b Mon Sep 17 00:00:00 2001
+From: Tony Cook <tony@develop-help.com>
+Date: Tue, 12 May 2020 10:59:08 +1000
+Subject: [PATCH 2/2] IO::Handle: clear the error on both input and output
+ streams
+MIME-Version: 1.0
+Content-Type: text/plain; charset=UTF-8
+Content-Transfer-Encoding: 8bit
+
+Similarly to GH #6799 clearerr() only cleared the error status
+of the input stream, so clear both.
+
+Signed-off-by: Petr Písař <ppisar@redhat.com>
+---
+ dist/IO/IO.xs     | 14 +++++++++++---
+ dist/IO/t/io_xs.t |  8 +++++---
+ 2 files changed, 16 insertions(+), 6 deletions(-)
+
+diff --git a/dist/IO/IO.xs b/dist/IO/IO.xs
+index 99d523d2c1..9158106416 100644
+--- a/dist/IO/IO.xs
++++ b/dist/IO/IO.xs
+@@ -410,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 f890e92558..a8833b0651 100644
+--- a/dist/IO/t/io_xs.t
++++ b/dist/IO/t/io_xs.t
+@@ -11,7 +11,7 @@ BEGIN {
+     }
+ }
+ 
+-use Test::More tests => 7;
++use Test::More tests => 8;
+ use IO::File;
+ use IO::Seekable;
+ 
+@@ -58,12 +58,14 @@ SKIP: {
+     # 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", 2
++    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: $!", 2;
++      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
+ }
+-- 
+2.25.4
+

perl-5.33.0-make-fh-error-report-errors-from-both-input-and-outp.patch

@@ -0,0 +1,87 @@
+From 89341f87f9fc65c4d7133e497bb04586e86b8052 Mon Sep 17 00:00:00 2001
+From: Tony Cook <tony@develop-help.com>
+Date: Tue, 12 May 2020 10:29:17 +1000
+Subject: [PATCH 1/2] make $fh->error report errors from both input and output
+MIME-Version: 1.0
+Content-Type: text/plain; charset=UTF-8
+Content-Transfer-Encoding: 8bit
+
+For character devices and sockets perl uses separate PerlIO objects
+for input and output so they can be buffered separately.
+
+The IO::Handle::error() method only checked the input stream, so
+if a write error occurs error() would still returned false.
+
+Change this so both the input and output streams are checked.
+
+fixes #6799
+
+Signed-off-by: Petr Písař <ppisar@redhat.com>
+---
+ dist/IO/IO.xs     | 12 ++++++++----
+ dist/IO/t/io_xs.t | 19 ++++++++++++++++++-
+ 2 files changed, 26 insertions(+), 5 deletions(-)
+
+diff --git a/dist/IO/IO.xs b/dist/IO/IO.xs
+index 68b7352c38..99d523d2c1 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;
+diff --git a/dist/IO/t/io_xs.t b/dist/IO/t/io_xs.t
+index 1e3c49a4a7..f890e92558 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 => 7;
+ use IO::File;
+ use IO::Seekable;
+ 
+@@ -50,3 +50,20 @@ 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", 2
++      unless $^O =~ /^(linux|netbsd|freebsd)$/ && -c "/dev/full";
++    open my $fh, ">", "/dev/full"
++      or skip "Could not open /dev/full: $!", 2;
++    $fh->print("a" x 1024);
++    ok(!$fh->flush, "should fail to flush");
++    ok($fh->error, "stream should be in error");
++    close $fh; # silently ignore the error
++}
+-- 
+2.25.4
+

perl.spec

@@ -176,6 +176,10 @@ Patch16:        perl-5.33.0-Update-pod-for-SvTRUE-to-indicate-single-param-evalu
 # Fix ext/XS-APItest/t/utf8_warn_base.pl tests, in upstream after 5.33.0
 Patch17:        perl-5.33.0-ext-XS-APItest-t-utf8_warn_base.pl-Fix-a-couple-test.patch
 
+# Fix IO::Handle::error() to report write errors, GH#6799, in upstream after 5.33.0
+Patch18:        perl-5.33.0-make-fh-error-report-errors-from-both-input-and-outp.patch
+Patch19:        perl-5.33.0-IO-Handle-clear-the-error-on-both-input-and-output-s.patch
+
 # Link XS modules to libperl.so with EU::CBuilder on Linux, bug #960048
 Patch200:       perl-5.16.3-Link-XS-modules-to-libperl.so-with-EU-CBuilder-on-Li.patch
 
@@ -4179,6 +4183,8 @@ you're not running VMS, this module does nothing.
 %patch15 -p1
 %patch16 -p1
 %patch17 -p1
+%patch18 -p1
+%patch19 -p1
 %patch200 -p1
 %patch201 -p1
 
@@ -4203,6 +4209,8 @@ perl -x patchlevel.h \
     'Fedora Patch15: Fix SvUV_nomg() macro definition' \
     'Fedora Patch16: Fix SvTRUE() documentation' \
     'Fedora Patch17: Fix ext/XS-APItest/t/utf8_warn_base.pl tests' \
+    'Fedora Patch18: Fix IO::Handle::error() to report write errors (GH#6799)' \
+    'Fedora Patch19: Fix IO::Handle::error() to report write errors (GH#6799)' \
     'Fedora Patch200: Link XS modules to libperl.so with EU::CBuilder on Linux' \
     'Fedora Patch201: Link XS modules to libperl.so with EU::MM on Linux' \
     %{nil}
@@ -6925,6 +6933,7 @@ popd
 - Fix SvUV_nomg() macro definition
 - Fix SvTRUE() documentation
 - Fix ext/XS-APItest/t/utf8_warn_base.pl tests
+- Fix IO::Handle::error() to report write errors (GH#6799)
 
 * Tue Jul 28 2020 Fedora Release Engineering <releng@fedoraproject.org> - 4:5.32.0-458
 - Rebuilt for https://fedoraproject.org/wiki/Fedora_33_Mass_Rebuild