CMUCL commit: RELEASE-20B-BRANCH src/code (extfmts.lisp stream.lisp)
Raymond Toy
rtoy at common-lisp.net
Fri Sep 3 01:47:32 CEST 2010
Date: Thursday, September 2, 2010 @ 19:47:32
Author: rtoy
Path: /project/cmucl/cvsroot/src/code
Tag: RELEASE-20B-BRANCH
Modified: extfmts.lisp stream.lisp
Fix yet another bug in the FAST-READ-CHAR-STRING-REFILL. This shows
up when running the word break test in
i18n/tests/word-break-test.lisp.
extfmts.lisp:
o Return the number of characters that were actually converted instead
of the position of the starting point of the output string.
stream.lisp:
o In FAST-READ-CHAR-STRING-REFILL, sometimes, we'll only read one
octet into the octet buffer, and the octet will be the first octet
of a multi-octet character. If this happens, we need to try to read
some more octets in so that the call to FAST-READ-CHAR-STRING-REFILL
can return a character. We only retry once. If this still fails to
read enough octets to form a character, we're hosed since we don't
check for this. (Should we?)
Need to refactor this code a bit too.
--------------+
extfmts.lisp | 4 +-
stream.lisp | 79 ++++++++++++++++++++++++++++++++++++++++-----------------
2 files changed, 58 insertions(+), 25 deletions(-)
Index: src/code/extfmts.lisp
diff -u src/code/extfmts.lisp:1.35.4.3 src/code/extfmts.lisp:1.35.4.4
--- src/code/extfmts.lisp:1.35.4.3 Sun Aug 15 11:07:51 2010
+++ src/code/extfmts.lisp Thu Sep 2 19:47:31 2010
@@ -5,7 +5,7 @@
;;; domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/code/extfmts.lisp,v 1.35.4.3 2010-08-15 15:07:51 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/code/extfmts.lisp,v 1.35.4.4 2010-09-02 23:47:31 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -987,7 +987,7 @@
(or string (make-string (length octets)))
s-start s-end
error)
- (values (if stringp string (lisp::shrink-vector string pos)) pos last-octet new-state))))
+ (values (if stringp string (lisp::shrink-vector string pos)) (- pos s-start) last-octet new-state))))
Index: src/code/stream.lisp
diff -u src/code/stream.lisp:1.94.4.2 src/code/stream.lisp:1.94.4.3
--- src/code/stream.lisp:1.94.4.2 Sun Aug 15 11:07:51 2010
+++ src/code/stream.lisp Thu Sep 2 19:47:31 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.2 2010-08-15 15:07:51 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/code/stream.lisp,v 1.94.4.3 2010-09-02 23:47:31 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -736,7 +736,9 @@
(progn
(format t "index = ~A~%" index)
(format t "in-length = ~A~%" in-length)
- (format t "ibuf before = ~A~%" ibuf))
+ (format t "ibuf before = ~A~%" ibuf)
+ (format t "sbuf before = ~S~%" (subseq (lisp-stream-string-buffer stream) 0
+ (1+ (lisp-stream-string-buffer-len stream)))))
;; Copy the stuff we haven't read from in-buffer to the beginning
;; of the buffer.
@@ -793,33 +795,64 @@
;; Copy the last read character to the beginning of the
;; buffer to support unreading.
- #+(or)
+ #+(or debug-frc-sr)
(format t "slen = ~A~%" slen)
(when (plusp slen)
- (setf (schar sbuf 0) (schar sbuf (1- slen))))
+ (setf (schar sbuf 0) (schar sbuf slen)))
+ #+(or debug-frc-sr)
+ (progn
+ (format t "sbuf[0] = ~S~%" (schar sbuf 0))
+ (format t "index = ~S~%" index))
;; Convert all the octets, including the ones that we
;; haven't processed yet and the ones we just read in.
- (multiple-value-bind (s char-count octet-count new-state)
- (stream::octets-to-string-counted
- ibuf
- (fd-stream-octet-count stream)
- :start 0
- :end (fd-stream-in-length stream)
- :state (fd-stream-oc-state stream)
- :string sbuf
- :s-start 1
- :external-format (fd-stream-external-format stream)
- :error (fd-stream-octets-to-char-error stream))
- (declare (ignore s))
- (setf (fd-stream-oc-state stream) new-state)
- (setf (lisp-stream-string-buffer-len stream) char-count)
- (setf (lisp-stream-string-index stream) 2)
- (setf (lisp-stream-in-index stream) octet-count)
- #+(or debug-frc-sr)
- (format t "new in-index = ~A~%" (lisp-stream-in-index stream))
- (schar sbuf 1))))))))
+ (flet
+ ((convert-buffer ()
+ (multiple-value-bind (s char-count octet-count new-state)
+ (stream::octets-to-string-counted
+ ibuf
+ (fd-stream-octet-count stream)
+ :start 0
+ :end (fd-stream-in-length stream)
+ :state (fd-stream-oc-state stream)
+ :string sbuf
+ :s-start 1
+ :external-format (fd-stream-external-format stream)
+ :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)
+ (schar sbuf 1)))))
+ (let ((out (convert-buffer)))
+ (or out
+ (let ((count (funcall (lisp-stream-n-bin stream) stream
+ ibuf index
+ (- in-buffer-length index)
+ nil)))
+ (declare (type (integer 0 #.in-buffer-length) count))
+ (cond ((zerop count)
+ ;; Nothing left in the stream, so update our pointers to
+ ;; indicate we've read everything and call the stream-in
+ ;; function so that we do the right thing for eof.
+ (setf (lisp-stream-in-index stream) in-buffer-length)
+ (setf (lisp-stream-string-index stream)
+ (lisp-stream-string-buffer-len stream))
+ (funcall (lisp-stream-in stream) stream eof-errorp eof-value))
+ (t
+ (convert-buffer)))))))))))))
;;; FAST-READ-BYTE-REFILL -- Interface
;;;
More information about the cmucl-commit
mailing list