(read-char-no-hang stream)
(assert (< (- (get-universal-time) time) 2)))))
+#-win32
+(require :sb-posix)
+
+#-win32
+(with-test (:name :interrupt-open)
+ (let ((fifo nil)
+ (to 0))
+ (unwind-protect
+ (progn
+ ;; Make a FIFO
+ (setf fifo (sb-posix:mktemp "SBCL-fifo.XXXXXXX"))
+ (sb-posix:mkfifo fifo (logior sb-posix:s-iwusr sb-posix:s-irusr))
+ ;; Try to open it (which hangs), and interrupt ourselves with a timer,
+ ;; continue (this used to result in an error due to open(2) returning with
+ ;; EINTR, then interupt again and unwind.
+ (handler-case
+ (with-timeout 2
+ (handler-bind ((timeout (lambda (c)
+ (when (eql 1 (incf to))
+ (continue c)))))
+ (with-timeout 1
+ (with-open-file (f fifo :direction :input)
+ :open))))
+ (timeout ()
+ (if (eql 2 to)
+ :timeout
+ :wtf))
+ (error (e)
+ e)))
+ (when fifo
+ (ignore-errors (delete-file fifo))))))
+
+#-win32
+(require :sb-posix)
+#-win32
+(with-test (:name :overeager-character-buffering)
+ (let ((fifo nil)
+ (proc nil))
+ (maphash
+ (lambda (format _)
+ (declare (ignore _))
+ (format t "trying ~A~%" format)
+ (finish-output t)
+ (unwind-protect
+ (progn
+ (setf fifo (sb-posix:mktemp "SBCL-fifo-XXXXXXX"))
+ (sb-posix:mkfifo fifo (logior sb-posix:s-iwusr sb-posix:s-irusr))
+ ;; KLUDGE: because we have both ends in the same process, we would
+ ;; need to use O_NONBLOCK, but this works too.
+ (setf proc
+ (run-program "/bin/sh"
+ (list "-c"
+ (format nil "cat > ~A" (native-namestring fifo)))
+ :input :stream
+ :wait nil
+ :external-format format))
+ (write-line "foobar" (process-input proc))
+ (finish-output (process-input proc))
+ (with-open-file (f fifo :direction :input :external-format format)
+ (assert (equal "foobar" (read-line f)))))
+ (when proc
+ (ignore-errors
+ (close (process-input proc) :abort t)
+ (process-wait proc))
+ (ignore-errors (process-close proc))
+ (setf proc nil))
+ (when fifo
+ (ignore-errors (delete-file fifo))
+ (setf fifo nil))))
+ sb-impl::*external-formats*)))
+
+(with-test (:name :bug-657183)
+ (let ((name (merge-pathnames "stream-impure.temp-test"))
+ (text '(#\GREEK_SMALL_LETTER_LAMDA
+ #\JAPANESE_BANK_SYMBOL
+ #\Space
+ #\HEAVY_BLACK_HEART))
+ (positions '(2 5 6 9))
+ (sb-impl::*default-external-format* :utf-8))
+ (unwind-protect
+ (progn
+ (with-open-file (f name :external-format :default :direction :output
+ :if-exists :supersede)
+ (assert (eql 0 (file-position f)))
+ (mapc (lambda (char pos)
+ (write-char char f)
+ (assert (eql pos (file-position f))))
+ text
+ positions))
+ (with-open-file (f name :external-format :default :direction :input)
+ (assert (eql 0 (file-position f)))
+ (assert (eql (pop text) (read-char f)))
+ (assert (eql (file-position f) 2))
+ (assert (eql (pop text) (read-char f)))
+ (assert (eql (file-position f) 5))
+ (assert (eql (pop text) (read-char f)))
+ (assert (eql (file-position f) 6))
+ (assert (eql (pop text) (read-char f)))
+ (assert (eql (file-position f) 9))
+ (assert (eql (file-length f) 9))))
+ (ignore-errors (delete-file name)))))
+
;;; success