[cmucl-cvs] CMUCL commit: src/code (fd-stream.lisp stream.lisp)

Raymond Toy rtoy at common-lisp.net
Tue Jun 28 17:55:05 PDT 2011


    Date: Tuesday, June 28, 2011 @ 17:55:05
  Author: rtoy
    Path: /project/cmucl/cvsroot/src/code

Modified: fd-stream.lisp stream.lisp

Fix Trac #43 again.

stream.lisp:
o Remove the old code that was the first attempt at fixing issue #43.
  This was wrong.

fd-stream.lisp:
o Fix issue #43.  Even if we have a string-buffer, we need to take
  into account any octets in the in-buffer (if it exists) that have
  not been processed.  This happens if the in-buffer does not have
  enough octets at the end to form a complete character for the given
  encoding. 
o Some debugging prints added, but disabled.


----------------+
 fd-stream.lisp |   75 +++++++++++++++++++++++++++++++++----------------------
 stream.lisp    |    8 -----
 2 files changed, 46 insertions(+), 37 deletions(-)


Index: src/code/fd-stream.lisp
diff -u src/code/fd-stream.lisp:1.124 src/code/fd-stream.lisp:1.125
--- src/code/fd-stream.lisp:1.124	Tue May 31 06:14:39 2011
+++ src/code/fd-stream.lisp	Tue Jun 28 17:55:04 2011
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /project/cmucl/cvsroot/src/code/fd-stream.lisp,v 1.124 2011/05/31 13:14:39 rtoy Exp $")
+  "$Header: /project/cmucl/cvsroot/src/code/fd-stream.lisp,v 1.125 2011/06/29 00:55:04 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1717,35 +1717,50 @@
 			       (fd-stream-ibuf-head stream)))
 
 		 #+unicode
-		 (if (fd-stream-string-buffer stream)
-		     ;; The string buffer contains Lisp characters,
-		     ;; not octets!  To figure out how many octets
-		     ;; have not been already supplied, we need to
-		     ;; count how many octets were consumed for all
-		     ;; the characters in the string bbuffer that have
-		     ;; not been supplied.
-		     (let ((ocount (fd-stream-octet-count stream)))
-		       (when ocount
-			 ;; Note: string-index starts at 1 (because
-			 ;; index 0 is for the unread-char), but
-			 ;; octet-count doesn't use that.  Hence,
-			 ;; subtract one from string-index and
-			 ;; string-buffer-len.
-			 (loop for k of-type fixnum from (1- (fd-stream-string-index stream))
-			    below (1- (fd-stream-string-buffer-len stream))
-			    do (decf posn (aref ocount k)))))
-		     (when (fd-stream-in-buffer stream)
-		       ;; When we have an in-buffer (but no
-		       ;; string-buffer!), we need to adjust for the
-		       ;; octets that have not yet been supplied.
-		       ;; This situation (should!) only happens for an
-		       ;; external-format of ISO-8859-1.  If there's
-		       ;; no string-buffer and no in-buffer, then the
-		       ;; ibuf tail and head pointers contain all the
-		       ;; information needed.
-		       (decf posn (- in-buffer-length
-				     (fd-stream-in-index stream)))))
-		 
+		 (when (fd-stream-string-buffer stream)
+		   ;; The string buffer contains Lisp characters,
+		   ;; not octets!  To figure out how many octets
+		   ;; have not been already supplied, we need to
+		   ;; count how many octets were consumed for all
+		   ;; the characters in the string bbuffer that have
+		   ;; not been supplied.
+		   (let ((ocount (fd-stream-octet-count stream)))
+		     (when ocount
+		       ;; Note: string-index starts at 1 (because
+		       ;; index 0 is for the unread-char), but
+		       ;; octet-count doesn't use that.  Hence,
+		       ;; subtract one from string-index and
+		       ;; string-buffer-len.
+		       #+nil
+		       (progn
+			 (format t "~&ocount = ~D~%" ocount)
+			 (format t "posn = ~D~%" posn))
+		       (loop for k of-type fixnum from (1- (fd-stream-string-index stream))
+			       below (1- (fd-stream-string-buffer-len stream))
+			     do (decf posn (aref ocount k)))
+		       #+nil
+		       (progn
+			 (format t "new posn = ~D~%" posn)
+			 (format t "in-buffer-length = ~D~%" in-buffer-length)
+			 (format t "fd-stream-in-index = ~D~%" (fd-stream-in-index stream))))))
+		 (when (fd-stream-in-buffer stream)
+		   ;; When we have an in-buffer (whether we have a
+		   ;; string-buffer or not!), we need to adjust for
+		   ;; the octets that have not yet been supplied.
+		   ;; (This case happens with string-buffer when the
+		   ;; in-buffer does not have enough octets to form a
+		   ;; complete character.)  If there's no
+		   ;; string-buffer and no in-buffer, then the ibuf
+		   ;; tail and head pointers contain all the
+		   ;; information needed.
+		   #+nil
+		   (progn
+		     (format t "in-buffer-length = ~D~%" in-buffer-length)
+		     (format t "fd-stream-in-index = ~D~%" (fd-stream-in-index stream)))
+		   (decf posn (- in-buffer-length
+				 (fd-stream-in-index stream))))
+		 #+nil
+		 (format t "fd-stream-unread = ~S~%" (fd-stream-unread stream))
 		 (when (fd-stream-unread stream) ;;@@
 		   (decf posn))
 		 ;; Divide bytes by element size.
Index: src/code/stream.lisp
diff -u src/code/stream.lisp:1.101 src/code/stream.lisp:1.102
--- src/code/stream.lisp:1.101	Mon Jun 27 08:05:27 2011
+++ src/code/stream.lisp	Tue Jun 28 17:55:04 2011
@@ -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.101 2011/06/27 15:05:27 rtoy Exp $")
+  "$Header: /project/cmucl/cvsroot/src/code/stream.lisp,v 1.102 2011/06/29 00:55:04 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -851,12 +851,6 @@
 			    (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)
-			    ;; If we didn't convert all the octets,
-			    ;; adjust the head pointer to indicate
-			    ;; that we have unread octets left.
-			    #+nil
-			    (decf (lisp::fd-stream-ibuf-head stream)
-				  (- (fd-stream-in-length stream) octet-count))
 			    #+(or debug-frc-sr)
 			    (progn
 			      (format t "new in-index = ~A~%" (lisp-stream-in-index stream))



More information about the cmucl-cvs mailing list