diff options
author | Roderick Schertler <roderick@argon.org> | 1997-04-28 18:02:20 -0400 |
---|---|---|
committer | Chip Salzenberg <chip@atlantic.net> | 1997-04-30 00:00:00 +1200 |
commit | 00db273fa22ecba6466df777a772c6017c403a96 (patch) | |
tree | a02ca86da02aaeb144a0cc73dcc5e30c7d817d6b | |
parent | cf26c822ca0e58de393c90b3f7a75af4335d0d65 (diff) | |
download | perl-00db273fa22ecba6466df777a772c6017c403a96.tar.gz |
Reset errno after failed piped close
Chip had asked me to redo the pclose patches against 97j. I'm sending
them here to encourage others to try them out since _98 looms so near.
Also included are the patches I'd sent on Friday for the bugs Gisle
reported with Time::{localtime,gmtime}, with these this message contains
all my outstanding patches.
p5p-msgid: 28152.862264940@eeyore.ibcinc.com
-rw-r--r-- | lib/Time/gmtime.pm | 7 | ||||
-rw-r--r-- | lib/Time/localtime.pm | 7 | ||||
-rw-r--r-- | pod/perlfunc.pod | 6 | ||||
-rwxr-xr-x | t/io/pipe.t | 31 | ||||
-rw-r--r-- | util.c | 11 |
5 files changed, 52 insertions, 10 deletions
diff --git a/lib/Time/gmtime.pm b/lib/Time/gmtime.pm index 7ca12bb981..c1d11d74db 100644 --- a/lib/Time/gmtime.pm +++ b/lib/Time/gmtime.pm @@ -4,7 +4,7 @@ use Time::tm; BEGIN { use Exporter (); - use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); + use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION); @ISA = qw(Exporter Time::tm); @EXPORT = qw(gmtime gmctime); @EXPORT_OK = qw( @@ -13,6 +13,7 @@ BEGIN { $tm_isdst ); %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] ); + $VERSION = 1.01; } use vars @EXPORT_OK; @@ -27,8 +28,8 @@ sub populate (@) { return $tmob; } -sub gmtime (;$) { populate CORE::gmtime(shift||time)} -sub gmctime (;$) { scalar CORE::gmtime(shift||time)} +sub gmtime (;$) { populate CORE::gmtime(@_ ? shift : time)} +sub gmctime (;$) { scalar CORE::gmtime(@_ ? shift : time)} 1; __END__ diff --git a/lib/Time/localtime.pm b/lib/Time/localtime.pm index 8d72da159a..9437752597 100644 --- a/lib/Time/localtime.pm +++ b/lib/Time/localtime.pm @@ -4,7 +4,7 @@ use Time::tm; BEGIN { use Exporter (); - use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); + use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION); @ISA = qw(Exporter Time::tm); @EXPORT = qw(localtime ctime); @EXPORT_OK = qw( @@ -13,6 +13,7 @@ BEGIN { $tm_isdst ); %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] ); + $VERSION = 1.01; } use vars @EXPORT_OK; @@ -27,8 +28,8 @@ sub populate (@) { return $tmob; } -sub localtime (;$) { populate CORE::localtime(shift||time)} -sub ctime (;$) { scalar CORE::localtime(shift||time) } +sub localtime (;$) { populate CORE::localtime(@_ ? shift : time)} +sub ctime (;$) { scalar CORE::localtime(@_ ? shift : time) } 1; diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index a99dffeb4d..823355b363 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -551,7 +551,11 @@ omitted, does chroot to $_. Closes the file or pipe associated with the file handle, returning TRUE only if stdio successfully flushes buffers and closes the system file -descriptor. You don't have to close FILEHANDLE if you are immediately +descriptor. If the file handle came from a piped open C<close> will +additionally return FALSE if one of the other system calls involved +fails or if the program exits with non-zero status. (If the problem was +that the program exited non-zero $! will be set to 0.) +You don't have to close FILEHANDLE if you are immediately going to do another open() on it, because open() will close it for you. (See open().) However, an explicit close on an input file resets the line counter ($.), while the implicit close done by open() does not. Also, diff --git a/t/io/pipe.t b/t/io/pipe.t index d70b2ab258..2af3fdaf84 100755 --- a/t/io/pipe.t +++ b/t/io/pipe.t @@ -13,7 +13,7 @@ BEGIN { } $| = 1; -print "1..8\n"; +print "1..10\n"; open(PIPE, "|-") || (exec 'tr', 'YX', 'ko'); print PIPE "Xk 1\n"; @@ -64,3 +64,32 @@ print WRITER "not ok 7\n"; close WRITER; print "ok 8\n"; + +{ + local $SIG{PIPE} = 'IGNORE'; + open NIL, '|true' or die "open failed: $!"; + sleep 2; + print NIL 'foo' or die "print failed: $!"; + if (close NIL) { + print "not ok 9\n"; + } + else { + print "ok 9\n"; + } +} + +# check that errno gets forced to 0 if the piped program exited non-zero +open NIL, '|exit 23;' or die "fork failed: $!"; +$! = 1; +if (close NIL) { + print "not ok 10\n# successful close\n"; +} +elsif ($! != 0) { + print "not ok 10\n# errno $!\n"; +} +elsif ($? == 0) { + print "not ok 10\n# status 0\n"; +} +else { + print "ok 10\n"; +} @@ -1964,6 +1964,8 @@ PerlIO *ptr; int status; SV **svp; int pid; + bool close_failed; + int saved_errno; svp = av_fetch(fdpid,PerlIO_fileno(ptr),TRUE); pid = (int)SvIVX(*svp); @@ -1974,7 +1976,8 @@ PerlIO *ptr; return my_syspclose(ptr); } #endif - PerlIO_close(ptr); + if ((close_failed = (PerlIO_close(ptr) == EOF))) + saved_errno = errno; #ifdef UTS if(kill(pid, 0) < 0) { return(pid); } /* HOM 12/23/91 */ #endif @@ -1987,7 +1990,11 @@ PerlIO *ptr; rsignal_restore(SIGHUP, &hstat); rsignal_restore(SIGINT, &istat); rsignal_restore(SIGQUIT, &qstat); - return(pid < 0 ? pid : status); + if (close_failed) { + errno = saved_errno; + return -1; + } + return(pid < 0 ? pid : status == 0 ? 0 : (errno = 0, status)); } #endif /* !DOSISH */ |