CMUCL commit: RELEASE-20B-BRANCH src/code (stream.lisp)

[Raymond Toy]

    Date: Friday, September 3, 2010 @ 12:32:38
  Author: rtoy
    Path: /project/cmucl/cvsroot/src/code
     Tag: RELEASE-20B-BRANCH

Modified: stream.lisp

More fixes.  With these changes, the normalization and word-break
tests pass without problems.  Copying the lines from the test files to
a new file also produces a file that is identical to the original.
(Previously, this was failing.)

o For debugging, clear out the parts of in-buffer that have already
  been processed.  Not enabled normally.
o When retrying the read to get more octets, we weren't reading the
  new octets into the correct spot in the in-buffer, and we weren't
  updating the in-length with the correct length.


-------------+
 stream.lisp |   59 +++++++++++++++++++++++++++++++++++++++++++---------------
 1 file changed, 44 insertions(+), 15 deletions(-)


Index: src/code/stream.lisp
diff -u src/code/stream.lisp:1.94.4.4 src/code/stream.lisp:1.94.4.5
--- src/code/stream.lisp:1.94.4.4	Thu Sep  2 22:18:53 2010
+++ src/code/stream.lisp	Fri Sep  3 12:32:38 2010
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /project/cmucl/cvsroot/src/code/stream.lisp,v 1.94.4.4 2010-09-03 02:18:53 rtoy Exp $")
+  "$Header: /project/cmucl/cvsroot/src/code/stream.lisp,v 1.94.4.5 2010-09-03 16:32:38 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -740,6 +740,11 @@
       (format t "sbuf before = ~S~%" (subseq (lisp-stream-string-buffer stream) 0
 					     (lisp-stream-string-buffer-len stream))))
 
+    ;; For debugging, clear out the stuff we've already read so we can
+    ;; see what's happening.
+    #+(or debug-frc-sr)
+    (fill ibuf 0 :start 0 :end index)
+
     ;; Copy the stuff we haven't read from in-buffer to the beginning
     ;; of the buffer.
     (if (< index in-length)
@@ -747,6 +752,13 @@
 		 :start1 0
 		 :start2 index :end2 in-length)
 	(setf index in-length))
+
+    ;; For debugging, clear out the stuff we've already read so we can
+    ;; see what's happening.
+    #+(or debug-frc-sr)
+    (when (< index (1- in-buffer-length))
+      (fill ibuf 0 :start (1+ index) :end in-buffer-length))
+    
     (setf index (- in-length index))
     
     #+(or debug-frc-sr)
@@ -793,12 +805,14 @@
 			     (funcall (ef-copy-state (fd-stream-external-format stream))
 				      (cdr state)))))
 
-	       ;; Copy the last read character to the beginning of the
-	       ;; buffer to support unreading.
 	       #+(or debug-frc-sr)
 	       (format t "slen = ~A~%" slen)
+
+	       ;; Copy the last read character to the beginning of the
+	       ;; buffer to support unreading.
 	       (when (plusp slen)
 		 (setf (schar sbuf 0) (schar sbuf (1- slen))))
+
 	       #+(or debug-frc-sr)
 	       (progn
 		 (format t "sbuf[0] = ~S~%" (schar sbuf 0))
@@ -822,27 +836,39 @@
 			   :error (fd-stream-octets-to-char-error stream))
 			(declare (ignore s)
 				 (type (integer 0 #.in-buffer-length) char-count octet-count))
-			(setf (fd-stream-oc-state stream) new-state)
-			(setf (lisp-stream-string-buffer-len stream) (1+ char-count))
-			(setf (lisp-stream-string-index stream) 2)
-			(setf (lisp-stream-in-index stream) (if (plusp octet-count)
-								octet-count
-								index))
 			#+(or debug-frc-sr)
 			(progn
-			  (format t "new in-index = ~A~%" (lisp-stream-in-index stream))
 			  (format t "char-count = ~A~%" char-count)
-			  (format t "new sbuf = ~S~%" 
-				  (subseq sbuf 0 (1+ char-count))))
-			(when (plusp char-count)
+			  (format t "octet-count = ~A~%" octet-count)
+			  (format t "in-index = ~A~%" (lisp-stream-in-index stream)))
+			(when (> char-count 0)
+			  (setf (fd-stream-oc-state stream) new-state)
+			  (setf (lisp-stream-string-buffer-len stream) (1+ char-count))
+			  (setf (lisp-stream-string-index stream) 2)
+			  (setf (lisp-stream-in-index stream) octet-count)
+			  #+(or debug-frc-sr)
+			  (progn
+			    (format t "new in-index = ~A~%" (lisp-stream-in-index stream))
+			    (format t "new sbuf = ~S~%" 
+				    (subseq sbuf 0 (1+ char-count))))
 			  (schar sbuf 1)))))
 		 (let ((out (convert-buffer)))
 		   (or out
-		       (let ((count (funcall (lisp-stream-n-bin stream) stream
+		       ;; There weren't enough octets to convert at
+		       ;; least one character.  Try to read some more
+		       ;; octets and try again.  (If we still fail,
+		       ;; what should we do then?  Currently, just
+		       ;; just return NIL and let other parts of Lisp
+		       ;; catch that.)
+		       ;;
+		       ;; The in buffer holds unread octets up to
+		       ;; index in-length.  So start reading octets there.
+		       (let* ((index (fd-stream-in-length stream))
+			      (count (funcall (lisp-stream-n-bin stream) stream
 					     ibuf index
 					     (- in-buffer-length index)
 					     nil)))
-			 (declare (type (integer 0 #.in-buffer-length) count))
+			 (declare (type (integer 0 #.in-buffer-length) count index))
 			 (cond ((zerop count)
 				;; Nothing left in the stream, so update our pointers to
 				;; indicate we've read everything and call the stream-in
@@ -852,6 +878,9 @@
 				      (lisp-stream-string-buffer-len stream))
 				(funcall (lisp-stream-in stream) stream eof-errorp eof-value))
 			       (t
+				;; Adjust in-length to the total
+				;; number of octets that are now in
+				;; the buffer.
 				(setf (fd-stream-in-length stream) (+ count index))
 				(convert-buffer)))))))))))))