From 516fe4b0f2272e154575e8024b0b12cbf27c827c Mon Sep 17 00:00:00 2001
From: Max Mikhanosha <max@openchat.com>
Date: Sat, 3 Sep 2011 14:38:26 -0400
Subject: [PATCH] Fix (run-program) to cleanup fd handlers

Signed-off-by: Christophe Rhodes <csr21@cantab.net>
---
 NEWS                          |    3 +++
 src/code/run-program.lisp     |   15 +++++++++------
 tests/run-program.impure.lisp |   29 +++++++++++++++++++++++++++++
 3 files changed, 41 insertions(+), 6 deletions(-)

diff --git a/NEWS b/NEWS
index 5020122..f917e18 100644
--- a/NEWS
+++ b/NEWS
@@ -25,6 +25,9 @@ changes relative to sbcl-1.0.51:
     as arguments of arithmetic operators.
   * bug fix: on 32-bit platforms, rounding of double floats larger than a
     fixnum is correct.  (reported by Peter Keller)
+  * bug fix: stray FD-HANDLERs are no longer left lying around after unwinds
+    from RUN-PROGRAM.  (lp#840190, reported by Dominic Pearson; fix from Max
+    Mikhanosha)
 
 changes in sbcl-1.0.51 relative to sbcl-1.0.50:
   * minor incompatible change: SB-BSD-SOCKET socket streams no longer
diff --git a/src/code/run-program.lisp b/src/code/run-program.lisp
index 1a4b7e7..512a7a9 100644
--- a/src/code/run-program.lisp
+++ b/src/code/run-program.lisp
@@ -799,13 +799,15 @@ Users Manual for details about the PROCESS structure."#-win32"
         (unless proc
           (dolist (fd *close-on-error*)
             (sb-unix:unix-close fd))
-          ;; FIXME: nothing seems to set this.
           #-win32
           (dolist (handler *handlers-installed*)
-            (sb-sys:remove-fd-handler handler))))
-      #-win32
-      (when (and wait proc)
-        (process-wait proc))
+            (sb-sys:remove-fd-handler handler)))
+        #-win32
+        (when (and wait proc)
+          (unwind-protect
+               (process-wait proc)
+            (dolist (handler *handlers-installed*)
+              (sb-sys:remove-fd-handler handler)))))
       proc)))
 
 ;;; Install a handler for any input that shows up on the file
@@ -896,7 +898,8 @@ Users Manual for details about the PROCESS structure."#-win32"
                       (strerror errno)))
                     (t
                      (incf read-end count)
-                     (funcall copy-fun))))))))))
+                     (funcall copy-fun))))))))
+    (push handler *handlers-installed*)))
 
 ;;; FIXME: something very like this is done in SB-POSIX to treat
 ;;; streams as file descriptor designators; maybe we can combine these
diff --git a/tests/run-program.impure.lisp b/tests/run-program.impure.lisp
index 098c74d..5c8b988 100644
--- a/tests/run-program.impure.lisp
+++ b/tests/run-program.impure.lisp
@@ -264,3 +264,32 @@
         (process-close proc)
         (assert (not stopped))))))
 
+
+;; Check that in when you do run-program with :wait t that causes
+;; encoding error, it does not affect the following run-program
+(with-test (:name (:run-program :clean-exit-after-encoding-error))
+  (let ((had-error-p nil))
+    (flet ((barf (&optional (format :default))
+             (with-output-to-string (stream)
+               (run-program "/usr/bin/perl"
+                            '("-e" "print \"\\x20\\xfe\\xff\\x0a\"")
+                            :output stream
+                            :external-format format)))
+           (no-barf ()
+             (with-output-to-string (stream)
+               (run-program "/bin/echo"
+                            '("This is a test")
+                            :output stream))))
+      (handler-case
+          (barf :utf-8)
+        (error ()
+          (setq had-error-p t)))
+      (assert had-error-p)
+      ;; now run the harmless program
+      (setq had-error-p nil)
+      (handler-case
+          (no-barf)
+        (error ()
+          (setq had-error-p t)))
+      (assert (not had-error-p)))))
+
-- 
1.7.10.4