From 43ed30b023d8ea5d0cd9c6a8928b4169aa0275ef Mon Sep 17 00:00:00 2001
From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Thu, 13 Dec 2007 20:15:32 +0000
Subject: [PATCH] 1.0.12.31: fix READ-SEQUENCE regression from 1.0.12.22

  * Keep track of FRC buffer index properly.

  * Test-case.
---
 src/code/stream.lisp     |  1 +
 tests/stream.impure.lisp | 25 +++++++++++++++++++++++++
 version.lisp-expr        |  2 +-
 3 files changed, 27 insertions(+), 1 deletion(-)

diff --git a/src/code/stream.lisp b/src/code/stream.lisp
index 223a9a143..c3825ace6 100644
--- a/src/code/stream.lisp
+++ b/src/code/stream.lisp
@@ -2108,6 +2108,7 @@ benefit of the function GET-OUTPUT-STREAM-STRING.")
                               :start2 %frc-index%
                               :end2 (+ %frc-index% len)))
                    (incf read len)
+                   (incf %frc-index% len)
                    (when (or (eql needed read)
                              (refill-buffer))
                      (done-with-fast-read-char)
diff --git a/tests/stream.impure.lisp b/tests/stream.impure.lisp
index 2db66068f..64d589cd6 100644
--- a/tests/stream.impure.lisp
+++ b/tests/stream.impure.lisp
@@ -442,4 +442,29 @@
       (when (probe-file test)
         (delete-file test)))))
 
+;;; read-sequence misreported the amount read and lost position
+(let ((string (make-array (* 3 sb-impl::+ansi-stream-in-buffer-length+)
+                          :element-type 'character)))
+  (dotimes (i (length string))
+    (setf (char string i) (code-char (mod i char-code-limit))))
+  (with-open-file (f "read-sequence-character-test-data.tmp"
+                     :if-exists :supersede
+                     :direction :output
+                     :external-format :utf-8)
+    (write-sequence string f))
+  (let ((copy
+         (with-open-file (f "read-sequence-character-test-data.tmp"
+                            :if-does-not-exist :error
+                            :direction :input
+                            :external-format :utf-8)
+           (let ((buffer (make-array 128 :element-type 'character))
+                 (total 0))
+             (with-output-to-string (datum)
+               (loop for n-read = (read-sequence buffer f)
+                     do (write-sequence buffer datum :start 0 :end n-read)
+                        (assert (<= (incf total n-read) (length string)))
+                     while (and (= n-read 128))))))))
+    (assert (equal copy string)))
+  (delete-file "read-sequence-character-test-data.tmp"))
+
 ;;; success
diff --git a/version.lisp-expr b/version.lisp-expr
index a4267bebb..184cce593 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".)
-"1.0.12.30"
+"1.0.12.31"
-- 
2.11.4.GIT