X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fstream.impure.lisp;h=adf3986e7ba077b0d97cdf531d00b4b5c22ecf81;hb=11b5ac86a98f058fe0375b0a707c6ef9e24590c9;hp=863f4e98b4fadf9d2d8ab74d3abe96f80f00b7d8;hpb=8b244d668721358d4a452650a9e608149c72c8f2;p=sbcl.git

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