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