From: Juho Snellman <jsnell@iki.fi>
Date: Wed, 28 Jun 2006 11:35:51 +0000 (+0000)
Subject: 0.9.14.4:
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=99d995b576ffe87b5b762e0590d0fafe73fc05e0;p=sbcl.git

0.9.14.4:
	FILE-POSITION sometimes returned inconsistent results for multibyte
        external-format streams. (Reported by Lutz Euler on sbcl-devel,
        patch from sbcl-devel "Patch: FILE-POSITION bug" by "vbzoli")
---

diff --git a/NEWS b/NEWS
index 3f992c6..d6f5be5 100644
--- a/NEWS
+++ b/NEWS
@@ -4,6 +4,8 @@ changes in sbcl-0.9.15 relative to sbcl-0.9.14:
     (cons symbol) is, in the default pprint-dispatch-table, now
     sensitive to whether the symbol satisfies FBOUNDP.  (thanks to
     Marcus Pearce)
+  * fixed bug: FILE-POSITION sometimes returned inconsistent results
+    for multibyte external-format streams (thanks to "vbzoli")
 
 changes in sbcl-0.9.14 relative to sbcl-0.9.13:
   * feature: thread support on Solaris/x86, and experimental thread support
diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp
index 5de405b..faab631 100644
--- a/src/code/fd-stream.lisp
+++ b/src/code/fd-stream.lisp
@@ -1001,6 +1001,16 @@
     (when sizer
       (loop for char across string summing (funcall sizer char)))))
 
+(defun find-external-format (external-format)
+  (when external-format
+    (find external-format *external-formats* :test #'member :key #'car)))
+
+(defun variable-width-external-format-p (ef-entry)
+  (when (eighth ef-entry) t))
+
+(defun bytes-for-char-fun (ef-entry)
+  (if ef-entry (symbol-function (ninth ef-entry)) (constantly 1)))
+
 ;;; FIXME: OAOOM here vrt. *EXTERNAL-FORMAT-FUNCTIONS* in fd-stream.lisp
 (defmacro define-external-format (external-format size output-restart
                                   out-expr in-expr)
diff --git a/src/code/stream.lisp b/src/code/stream.lisp
index 1e6dcdc..5d339b7 100644
--- a/src/code/stream.lisp
+++ b/src/code/stream.lisp
@@ -157,9 +157,24 @@
     (t
      (let ((res (funcall (ansi-stream-misc stream) stream :file-position nil)))
        (when res
+         #!-sb-unicode
          (- res
             (- +ansi-stream-in-buffer-length+
-               (ansi-stream-in-index stream))))))))
+               (ansi-stream-in-index stream)))
+         #!+sb-unicode
+         (let* ((external-format (stream-external-format stream))
+                (ef-entry (find-external-format external-format))
+                (variable-width-p (variable-width-external-format-p ef-entry))
+                (char-len (bytes-for-char-fun ef-entry)))
+           (- res
+              (if variable-width-p
+                  (loop with buffer = (ansi-stream-cin-buffer stream)
+                        with start = (ansi-stream-in-index stream)
+                        for i from start below +ansi-stream-in-buffer-length+
+                        sum (funcall char-len (aref buffer i)))
+                  (* (funcall char-len #\x)  ; arbitrary argument
+                     (- +ansi-stream-in-buffer-length+
+                        (ansi-stream-in-index stream)))))))))))
 
 
 (defun file-position (stream &optional position)
diff --git a/tests/external-format.impure.lisp b/tests/external-format.impure.lisp
index cff240a..7724c96 100644
--- a/tests/external-format.impure.lisp
+++ b/tests/external-format.impure.lisp
@@ -258,8 +258,7 @@
 
 ;;; See sbcl-devel "Subject: Bug in FILE-POSITION on UTF-8-encoded files"
 ;;; by Lutz Euler on 2006-03-05 for more details.
-(with-test (:name (:file-position :utf-8)
-                  :fails-on :sbcl)
+(with-test (:name (:file-position :utf-8))
   (let ((path "external-format-test.txt"))
     (with-open-file (s path
                        :direction :output
diff --git a/version.lisp-expr b/version.lisp-expr
index 2cfc0f5..0724bf6 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.14.3"
+"0.9.14.4"