From: Juho Snellman <jsnell@iki.fi>
Date: Sat, 29 Oct 2005 12:21:25 +0000 (+0000)
Subject: 0.9.6.9:
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=c1b609d072224eddf850a0e3f85e578c6919117f;p=sbcl.git

0.9.6.9:
	Oops. Misunderstood the code, and introduced a bug into the
        UTF-8 resync handling.

        * Fix the code to implement the intended behaviour as explained
          by Christophe on #lisp: fill the buffer up to the first
          invalid sequence, only signal an error if the first code
          sequence read is invalid. (<0.9.6.6 never filled the buffer,
          0.9.6.6 looped infinitely instead of signaling an error
          99.8% of the time).
        * Add tests. One of which fails; it seems to me that the
          force-eof restart has never worked properly.
---

diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp
index 8b54799..6e2b2b4 100644
--- a/src/code/fd-stream.lisp
+++ b/src/code/fd-stream.lisp
@@ -1204,7 +1204,6 @@
           (let* ((head (fd-stream-ibuf-head stream))
                  (tail (fd-stream-ibuf-tail stream))
                  (sap (fd-stream-ibuf-sap stream))
-                 (head-start head)
                  (decode-break-reason nil))
             (declare (type index head tail))
             ;; Copy data from stream buffer into user's buffer.
@@ -1221,8 +1220,15 @@
                         (incf head size))
                       nil))
               (setf (fd-stream-ibuf-head stream) head)
-              (when (and decode-break-reason
-                         (= head head-start))
+              (when decode-break-reason
+                ;; If we've already read some characters on when the invalid
+                ;; code sequence is detected, we return immediately. The
+                ;; handling of the error is deferred until the next call
+                ;; (where this check will be false). This allows establishing
+                ;; high-level handlers for decode errors (for example
+                ;; automatically resyncing in Lisp comments).
+                (when (plusp total-copied)
+                  (return-from ,in-function total-copied))
                 (when (stream-decoding-error-and-handle
                        stream decode-break-reason)
                   (if eof-error-p
diff --git a/tests/external-format.impure.lisp b/tests/external-format.impure.lisp
index c86b6ef..5a2b4cd 100644
--- a/tests/external-format.impure.lisp
+++ b/tests/external-format.impure.lisp
@@ -89,6 +89,51 @@
     (assert (equal (read-line s nil s) "AB"))
     (assert (equal (read-line s nil s) s))))
 
+;;; And again with more data to account for buffering (this was briefly)
+;;; broken in early 0.9.6.
+(with-open-file (s "external-format-test.txt" :direction :output
+                 :if-exists :supersede :element-type '(unsigned-byte 8))
+  (let ((a (make-array 50
+                       :element-type '(unsigned-byte 64)
+                       :initial-contents (map 'list #'char-code
+                                              "1234567890123456789012345678901234567890123456789."))))
+    (setf (aref a 49) (char-code #\Newline))
+    (dotimes (i 40)
+      (write-sequence a s))
+    (write-byte #xe0 s)
+    (dotimes (i 40)
+      (write-sequence a s))))
+(with-test (:name (:character-decode-large :attempt-resync))
+  (with-open-file (s "external-format-test.txt" :direction :input
+                     :external-format :utf-8)
+    (handler-bind
+        ((sb-int:character-decoding-error #'(lambda (decoding-error)
+                                              (declare (ignore decoding-error))
+                                              (invoke-restart
+                                               'sb-int:attempt-resync)))
+         ;; The failure mode is an infinite loop, add a timeout to detetct it.
+         (sb-ext:timeout (lambda () (error "Timeout"))))
+      (sb-ext:with-timeout 5
+        (dotimes (i 80)
+          (assert (equal (read-line s nil s)
+                         "1234567890123456789012345678901234567890123456789")))))))
+(with-test (:name (:character-decode-large :force-end-of-file)
+            :fails-on :sbcl)
+  (with-open-file (s "external-format-test.txt" :direction :input
+                     :external-format :utf-8)
+    (handler-bind
+        ((sb-int:character-decoding-error #'(lambda (decoding-error)
+                                              (declare (ignore decoding-error))
+                                              (invoke-restart
+                                               'sb-int:force-end-of-file)))
+         ;; The failure mode is an infinite loop, add a timeout to detetct it.
+         (sb-ext:timeout (lambda () (error "Timeout"))))
+      (sb-ext:with-timeout 5
+        (dotimes (i 80)
+          (assert (equal (read-line s nil s)
+                         "1234567890123456789012345678901234567890123456789")))
+        (assert (equal (read-line s nil s) s))))))
+
 ;;; Test character encode restarts.
 (with-open-file (s "external-format-test.txt" :direction :output
                  :if-exists :supersede :external-format :latin-1)
diff --git a/version.lisp-expr b/version.lisp-expr
index e5fb9fc..d78db03 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.9.6.8"
+"0.9.6.9"