Skip to content

Commit 89341f8

Browse files
tonycozkhwilliamson
authored andcommitted
make $fh->error report errors from both input and output
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 Perl#6799
1 parent b4aeee7 commit 89341f8

File tree

2 files changed

+26
-5
lines changed

2 files changed

+26
-5
lines changed

dist/IO/IO.xs

Lines changed: 8 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -389,13 +389,17 @@ ungetc(handle, c)
389389

390390
int
391391
ferror(handle)
392-
InputStream handle
392+
SV * handle
393+
PREINIT:
394+
IO *io = sv_2io(handle);
395+
InputStream in = IoIFP(io);
396+
OutputStream out = IoOFP(io);
393397
CODE:
394-
if (handle)
398+
if (in)
395399
#ifdef PerlIO
396-
RETVAL = PerlIO_error(handle);
400+
RETVAL = PerlIO_error(in) || (in != out && PerlIO_error(out));
397401
#else
398-
RETVAL = ferror(handle);
402+
RETVAL = ferror(in) || (in != out && ferror(out));
399403
#endif
400404
else {
401405
RETVAL = -1;

dist/IO/t/io_xs.t

Lines changed: 18 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -11,7 +11,7 @@ BEGIN {
1111
}
1212
}
1313

14-
use Test::More tests => 5;
14+
use Test::More tests => 7;
1515
use IO::File;
1616
use IO::Seekable;
1717

@@ -50,3 +50,20 @@ SKIP:
5050
ok($fh->sync, "sync to a read only handle")
5151
or diag "sync(): ", $!;
5252
}
53+
54+
55+
SKIP: {
56+
# gh 6799
57+
#
58+
# This isn't really a Linux/BSD specific test, but /dev/full is (I
59+
# hope) reasonably well defined on these. Patches welcome if your platform
60+
# also supports it (or something like it)
61+
skip "no /dev/full or not a /dev/full platform", 2
62+
unless $^O =~ /^(linux|netbsd|freebsd)$/ && -c "/dev/full";
63+
open my $fh, ">", "/dev/full"
64+
or skip "Could not open /dev/full: $!", 2;
65+
$fh->print("a" x 1024);
66+
ok(!$fh->flush, "should fail to flush");
67+
ok($fh->error, "stream should be in error");
68+
close $fh; # silently ignore the error
69+
}

0 commit comments

Comments
 (0)