From: Nikodemus S. <de...@us...> - 2010-09-30 08:23:43
|
Update of /cvsroot/sbcl/sbcl/tests In directory sfp-cvsdas-3.v30.ch3.sourceforge.com:/tmp/cvs-serv13494/tests Modified Files: stream.impure.lisp Log Message: 1.0.43.6: fix overeager input-buffer filling by external-format routines Fixes lp#643686. Previously the character-input functions returned only after filling the entire request by fast-read-char-refill, or if an EOF was reached. This meant that on a pipe we would not receive any input until there was a buffer's worth of it, or the other end closed. Not so good. New the drill is: 0, N characters requested. 1. Decode upto N characters from binary buffer to the character buffer. 2. If any characters were decoded or at EOF, return. 3. Otherwise refill the binary buffer with at most one read() and goto 1. Previously at #1 we returned only if the entire request was satisfied. Index: stream.impure.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/tests/stream.impure.lisp,v retrieving revision 1.35 retrieving revision 1.36 diff -u -d -r1.35 -r1.36 --- stream.impure.lisp 30 Sep 2010 07:38:07 -0000 1.35 +++ stream.impure.lisp 30 Sep 2010 08:23:34 -0000 1.36 @@ -639,4 +639,40 @@ (when fifo (ignore-errors (delete-file fifo)))))) +#-win32 +(require :sb-posix) +#-win32 +(with-test (:name :overager-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.tmp")) + (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 (process-close proc)) + (setf proc nil)) + (when fifo + (ignore-errors (delete-file fifo)) + (setf fifo nil)))) + sb-impl::*external-formats*))) + ;;; success |