diff options
| author | Mark-Jason Dominus <mjd@plover.com> | 2002-04-16 15:24:12 -0400 |
|---|---|---|
| committer | Jarkko Hietaniemi <jhi@iki.fi> | 2002-04-16 22:14:41 +0000 |
| commit | 0b8d6043dc77b60f4e7020acd7548c8bcae74009 (patch) | |
| tree | 69779074e474d318243575cb55c403e1737cb31e | |
| parent | 0011a49711e81f74ab7ef20748880d37389e0872 (diff) | |
| download | perl-0b8d6043dc77b60f4e7020acd7548c8bcae74009.tar.gz | |
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
| -rw-r--r-- | MANIFEST | 1 | ||||
| -rw-r--r-- | perlio.c | 3 | ||||
| -rw-r--r-- | t/io/full.t | 31 |
3 files changed, 33 insertions, 2 deletions
@@ -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 @@ -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 0000000000..d59689fbe7 --- /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"; |