From: Rudi S. <ru...@us...> - 2005-03-07 17:56:22
|
Update of /cvsroot/sbcl/sbcl/contrib/sb-simple-streams In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv31254/contrib/sb-simple-streams Modified Files: simple-stream-tests.lisp impl.lisp Log Message: 0.8.20.9 Fix sb-simple-streams; all tests pass again: * Test that clear-input can be called without errors but don't make assumptions about the stream state afterwards * Fix some LISTEN failures (simple-stream encapsulated in a two-way stream, incorrect assumptions about return value of stream-misc-dispatch :listen) Index: simple-stream-tests.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/contrib/sb-simple-streams/simple-stream-tests.lisp,v retrieving revision 1.12 retrieving revision 1.13 diff -u -d -r1.12 -r1.13 --- simple-stream-tests.lisp 3 Mar 2005 17:15:20 -0000 1.12 +++ simple-stream-tests.lisp 7 Mar 2005 17:56:11 -0000 1.13 @@ -373,8 +373,6 @@ :initial-content ,(or initial-content '*multi-line-string*)) ,@body)) -;;; 0.8.3.93 tried to fix LISTEN on dual channel streams, but failed to do so: - (deftest listen-dc-1 ;; LISTEN with filled buffer (with-dc-test-stream (s) (read-char s) (listen s)) @@ -502,8 +500,7 @@ ;; CLEAR-INPUT (via STREAM-MISC-DISPATCH) (with-sc-test-stream (*synonym*) (let ((s (make-synonym-stream '*synonym*))) - (clear-input s) - (listen s))) + (clear-input s))) NIL) (deftest synonym-stream-9 @@ -708,8 +705,7 @@ ;; CLEAR-INPUT (via STREAM-MISC-DISPATCH) (with-sc-test-stream (synonym) (let ((s (make-two-way-stream synonym synonym))) - (clear-input s) - (listen s))) + (clear-input s))) NIL) (deftest two-way-stream-9 @@ -794,8 +790,7 @@ ;; CLEAR-INPUT (via STREAM-MISC-DISPATCH) (with-sc-test-stream (*synonym*) (let ((s (make-echo-stream *synonym* *synonym*))) - (clear-input s) - (listen s))) + (clear-input s))) NIL) (deftest echo-stream-11 @@ -866,8 +861,7 @@ ;; CLEAR-INPUT (via STREAM-MISC-DISPATCH) (with-sc-test-stream (*synonym*) (let ((s (make-concatenated-stream *synonym*))) - (clear-input s) - (listen s))) + (clear-input s))) NIL) (deftest concatenated-stream-11 Index: impl.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/contrib/sb-simple-streams/impl.lisp,v retrieving revision 1.9 retrieving revision 1.10 diff -u -d -r1.9 -r1.10 --- impl.lisp 3 Mar 2005 17:15:20 -0000 1.9 +++ impl.lisp 7 Mar 2005 17:56:11 -0000 1.10 @@ -292,14 +292,13 @@ (if (not (or (eql width 1) (null width))) (funcall-stm-handler j-listen (sm melded-stream stream)) (or (< (sm buffpos stream) (sm buffer-ptr stream)) - (when (or (not (any-stream-instance-flags stream :dual :string)) - (>= (sm mode stream) 0)) ;; device-connected @@ single-channel - (let ((lcrs (sm last-char-read-size stream))) - (unwind-protect - (progn - (setf (sm last-char-read-size stream) (1+ lcrs)) - (plusp (refill-buffer stream nil))) - (setf (sm last-char-read-size stream) lcrs)))))))) + ;; Attempt buffer refill + (let ((lcrs (sm last-char-read-size stream))) + (when (and (not (any-stream-instance-flags stream :dual :string)) + (>= (sm mode stream) 0)) + ;; single-channel stream dirty -> write data before reading + (flush-buffer stream nil)) + (>= (refill-buffer stream nil) width)))))) (defun %clear-input (stream buffer-only) (declare (type simple-stream stream)) |