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

diff --git a/lib/Time/gmtime.pm b/lib/Time/gmtime.pm
index 7ca12bb..c1d11d7 100644 (file)
--- 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 8d72da1..9437752 100644 (file)
--- 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 a99dffe..823355b 100644 (file)
--- 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 d70b2ab..2af3fda 100755 (executable)
--- 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";
+}

diff --git a/util.c b/util.c
index e78ad82..740399a 100644 (file)
--- a/util.c
+++ b/util.c
@@ -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 */