From: Mark-Jason Dominus <mjd@plover.com>
Date: Tue, 16 Apr 2002 19:24:12 +0000 (-0400)
Subject: Re: [ID 20020416.001] 'close' does not report failure when buffer flush fails
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0b8d6043dc77b60f4e7020acd7548c8bcae74009;p=p5sagit%2Fp5-mst-13.2.git

Re: [ID 20020416.001] 'close' does not report failure when buffer flush fails
Message-ID: <20020416232412.14297.qmail@plover.com>

p4raw-id: //depot/perl@15962
---

diff --git a/MANIFEST b/MANIFEST
index f7b0f54..4594ce4 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -2272,6 +2272,7 @@ t/io/crlf.t			See if :crlf works
 t/io/dup.t			See if >& works right
 t/io/fflush.t			See if auto-flush on fork/exec/system/qx works
 t/io/fs.t			See if directory manipulations work
+t/io/full.t			See if 'disk full' errors are reported
 t/io/inplace.t			See if inplace editing works
 t/io/iprefix.t			See if inplace editing works with prefixes
 t/io/nargv.t			See if nested ARGV stuff works
diff --git a/perlio.c b/perlio.c
index 7661fc4..60346b5 100644
--- a/perlio.c
+++ b/perlio.c
@@ -2537,8 +2537,7 @@ PerlIOStdio_close(pTHX_ PerlIO *f)
     FILE *stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
     if (PerlIOUnix_refcnt_dec(fileno(stdio)) > 0) {
 	/* Do not close it but do flush any buffers */
-	PerlIO_flush(f);
-	return 0;
+        return PerlIO_flush(f);
     }
     return (
 #ifdef SOCKS5_VERSION_NAME
diff --git a/t/io/full.t b/t/io/full.t
new file mode 100644
index 0000000..d59689f
--- /dev/null
+++ b/t/io/full.t
@@ -0,0 +1,31 @@
+#!./perl
+#
+# Test for 'disk full' errors, if possible
+# 20020416 mjd-perl-patch+@plover.com
+
+unless (-c "/dev/full" && open FULL, "> /dev/full") {
+  print "1..0\n"; exit;
+}
+
+my $z;
+print "1..6\n";
+
+print FULL "I like pie.\n" ? print "ok 1\n" : print "not ok 1\n";
+# Should fail
+$z = close(FULL);
+print $z ? "not ok 2 # z=$z; $!\n" : "ok 2\n";
+print $!{ENOSPC} ? "ok 3\n" : print "not ok 3\n";
+  
+unless (open FULL, "> /dev/full") {
+  print "# couldn't open /dev/full the second time: $!\n";
+  print "not ok $_\n" for 4..6;
+}
+
+select FULL;   $| = 1;  select STDOUT;
+
+# Should fail
+$z = print FULL "I like pie.\n";
+print $z ? "not ok 4 # z=$z; $!\n" : "ok 4\n";
+print $!{ENOSPC} ? "ok 5\n" : "not ok 5\n";
+$z = close FULL;
+print $z ? "ok 6\n" : "not ok 6 # z=$s; $!\n";