From: Christophe Rhodes <csr21@cantab.net>
Date: Thu, 12 Nov 2009 11:29:23 +0000 (+0000)
Subject: 1.0.32.28: fix listen / read-char-no-hang
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=d508d8681eab5c3c3a36cb96c64a5367d0c7ddb3;p=sbcl.git

1.0.32.28: fix listen / read-char-no-hang

Whoops.  The external-format changes broke read-char-no-hang after an
unread-char: very noticeable indeed just as soon as an error occurs in
slime.  In my defence, this was already broken on bivalent streams; I just
propagated that brokenness to all fd-streams.

Include a run-program-based test, because that produces the kind of streams
that can have no data and yet not be at EOF.  In the slime context, they're
sockets, so it's a bit difficult to test the slime case exactly; ideas for
good simulations welcome.
---

diff --git a/NEWS b/NEWS
index f96f318..aee52cf 100644
--- a/NEWS
+++ b/NEWS
@@ -18,7 +18,8 @@ changes relative to sbcl-1.0.32:
        external format the system supports, it is now possible to specify
        (:<encoding> :replacement <character>) as an external format which will
        automatically substitute <character> on encoding or decoding errors for
-       streams and for STRING-TO-OCTETS and its inverse.
+       streams and for STRING-TO-OCTETS and its inverse.  (launchpad bug
+       #317072)
     ** improvement: the file streams underlying the standard streams (such as
        *STANDARD-INPUT*, *TERMINAL-IO*) are opened with an external format 
        which uses the replacement mechanism to handle encoding errors,
@@ -39,6 +40,8 @@ changes relative to sbcl-1.0.32:
     ** fix a double-error case in unibyte octet conversions, when the first
        use of USE-VALUE is ignored.
     ** fix bugs in handling of undefined code points in unibyte encodings.
+    ** fix LISTEN (and consequent hangs in READ-CHAR-NO-HANG) on bivalent
+       streams after an UNREAD-CHAR.
   * enhancement: SB-INTROSPECT:ALLOCATION-INFORMATION also reports if the
     object is allocated in a boxed region of dynamic space.
   * bug fix: uses of slot accessors on specialized method parameters within
@@ -57,6 +60,7 @@ changes relative to sbcl-1.0.32:
     the cross-compiler without warnings.  (thanks to Josh Elasser; launchpad
     bug #396597)
   * bug fix: correctly dump literal objects in defaulting forms of arglists.
+    (reported by Attila Lendvai; launchpad bug #310132)
 
 changes in sbcl-1.0.32 relative to sbcl-1.0.31:
   * optimization: faster FIND and POSITION on strings of unknown element type
diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp
index 020840c..79911fc 100644
--- a/src/code/fd-stream.lisp
+++ b/src/code/fd-stream.lisp
@@ -1485,6 +1485,8 @@
           (setf (aref buffer (+ start total-copied)) (vector-pop instead))
           (incf total-copied)
           (when (= requested total-copied)
+            (when (= (fill-pointer instead) 0)
+              (setf (fd-stream-listen stream) nil))
             (return-from ,in-function total-copied)))
         (do ()
             (nil)
@@ -1925,8 +1927,7 @@
        (do-listen)))
     (:unread
      (decf (buffer-head (fd-stream-ibuf fd-stream))
-           (fd-stream-character-size fd-stream arg1))
-     (setf (fd-stream-listen fd-stream) t))
+           (fd-stream-character-size fd-stream arg1)))
     (:close
      ;; Drop input buffers
      (setf (ansi-stream-in-index fd-stream) +ansi-stream-in-buffer-length+
diff --git a/tests/stream.impure.lisp b/tests/stream.impure.lisp
index 863f4e9..adf3986 100644
--- a/tests/stream.impure.lisp
+++ b/tests/stream.impure.lisp
@@ -589,4 +589,22 @@
       (assert (equal "still open" (read-line f)))))
   (assert (not (probe-file "delete-file-on-stream-test.tmp"))))
 
+;;; READ-CHAR-NO-HANG on bivalent streams (as returned by RUN-PROGRAM)
+;;; was wrong.  CSR managed to promote the wrongness to all streams in
+;;; the 1.0.32.x series, breaking slime instantly.
+(with-test (:name :read-char-no-hang-after-unread-char)
+  (let* ((process (run-program "/bin/sh" '("-c" "echo a && sleep 10")
+                               :output :stream :wait nil))
+         (stream (process-output process))
+         (char (read-char stream)))
+    (assert (char= char #\a))
+    (unread-char char stream)
+    (assert (char= (read-char stream) #\a))
+    (assert (char= (read-char stream) #\Newline))
+    (let ((time (get-universal-time)))
+      ;; no input, not yet known to be at EOF: should return
+      ;; immediately
+      (read-char-no-hang stream)
+      (assert (< (- (get-universal-time) time) 2)))))
+
 ;;; success
diff --git a/version.lisp-expr b/version.lisp-expr
index 4cd032c..191d195 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.32.27"
+"1.0.32.28"