summaryrefslogtreecommitdiff
path: root/dist/IO
diff options
context:
space:
mode:
authorTony Cook <tony@develop-help.com>2020-05-12 10:59:08 +1000
committerKarl Williamson <khw@cpan.org>2020-07-30 15:29:22 -0600
commitfc5f3468dcbee38eb202cfd552a5b8dbff990c7b (patch)
tree42acf88e3adfb138a7f28091cb828bf050d2e508 /dist/IO
parent89341f87f9fc65c4d7133e497bb04586e86b8052 (diff)
downloadperl-fc5f3468dcbee38eb202cfd552a5b8dbff990c7b.tar.gz
IO::Handle: clear the error on both input and output streams
Similarly to GH #6799 clearerr() only cleared the error status of the input stream, so clear both.
Diffstat (limited to 'dist/IO')
-rw-r--r--dist/IO/IO.xs14
-rw-r--r--dist/IO/t/io_xs.t8
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
}