From 03136e130d992186c97de0acd23f4857b1a277da Mon Sep 17 00:00:00 2001
From: Chip Salzenberg <chip@atlantic.net>
Date: Wed, 30 Apr 1997 00:00:00 +1200
Subject: [PATCH] Reset errno after failed piped close

(this is the same change as commit 00db273fa22ecba6466df777a772c6017c403a96, but as applied)
---
 lib/Time/gmtime.pm    |  7 ++++---
 lib/Time/localtime.pm |  7 ++++---
 pod/perlfunc.pod      |  6 +++++-
 t/io/pipe.t           | 45 ++++++++++++++++++++++++++++++++++++++++++++-
 util.c                | 18 ++++++++++++++++--
 5 files changed, 73 insertions(+), 10 deletions(-)

diff --git a/lib/Time/gmtime.pm b/lib/Time/gmtime.pm
index 7ca12bb..c1d11d7 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 8d72da1..9437752 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 a99dffe..823355b 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 d70b2ab..21f02a7 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,46 @@ print WRITER "not ok 7\n";
 close WRITER;
 
 print "ok 8\n";
+
+# VMS doesn't like spawning subprocesses that are still connected to
+# STDOUT.  Someone should modify tests #9 and #10 to work with VMS.
+
+if ($^O eq 'VMS') {
+    print "ok 9\n";
+    print "ok 10\n";
+    exit;
+}
+
+if ($Config{d_sfio}) {
+    # Sfio doesn't report failure when closing a broken pipe
+    # that has pending output.  Go figure.
+    print "ok 9\n";
+}
+else {
+    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..2ee9c0e 100644
--- a/util.c
+++ b/util.c
@@ -1964,6 +1964,11 @@ PerlIO *ptr;
     int status;
     SV **svp;
     int pid;
+    bool close_failed;
+    int saved_errno;
+#ifdef VMS
+    int saved_vaxc_errno;
+#endif
 
     svp = av_fetch(fdpid,PerlIO_fileno(ptr),TRUE);
     pid = (int)SvIVX(*svp);
@@ -1974,7 +1979,12 @@ PerlIO *ptr;
 	return my_syspclose(ptr);
     }
 #endif 
-    PerlIO_close(ptr);
+    if ((close_failed = (PerlIO_close(ptr) == EOF))) {
+	saved_errno = errno;
+#ifdef VMS
+	saved_vaxc_errno = vaxc$errno;
+#endif
+    }
 #ifdef UTS
     if(kill(pid, 0) < 0) { return(pid); }   /* HOM 12/23/91 */
 #endif
@@ -1987,7 +1997,11 @@ PerlIO *ptr;
     rsignal_restore(SIGHUP, &hstat);
     rsignal_restore(SIGINT, &istat);
     rsignal_restore(SIGQUIT, &qstat);
-    return(pid < 0 ? pid : status);
+    if (close_failed) {
+	SETERRNO(saved_errno, saved_vaxc_errno);
+	return -1;
+    }
+    return(pid < 0 ? pid : status == 0 ? 0 : (errno = 0, status));
 }
 #endif /* !DOSISH */
 
-- 
2.7.4