This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
make $fh->error report errors from both input and output
authorTony Cook <tony@develop-help.com>
Tue, 12 May 2020 00:29:17 +0000 (10:29 +1000)
committerKarl Williamson <khw@cpan.org>
Thu, 30 Jul 2020 21:29:22 +0000 (15:29 -0600)
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

dist/IO/IO.xs
dist/IO/t/io_xs.t

index 68b7352..99d523d 100644 (file)
@@ -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;
index 1e3c49a..f890e92 100644 (file)
@@ -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
+}