From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Fri, 11 Feb 2011 16:59:56 +0000 (+0000)
Subject: 1.0.45.14: fix handling of multibyte character encoding errors
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=29dd8b299b1b12eed29e4a67aa378db009e93622;p=sbcl.git

1.0.45.14: fix handling of multibyte character encoding errors

 In encodings defined using DEFINE-MULTIBYTE-ENCODING, if there is no
 translation for the character, report the size as 0 -- replacements
 get their size accounted for elsewhere.

 Fixes lp#713063.
---

diff --git a/NEWS b/NEWS
index fd5dbc1..85c2bf7 100644
--- a/NEWS
+++ b/NEWS
@@ -2,6 +2,8 @@
 changes relative to sbcl-1.0.45:
   * bug fix: local tail calls to DYNAMIC-EXTENT functions can no longer cause
     lifetime analysis to overwrite closed-over variables (lp#681092).
+  * bug fix: encoding errors from some multibyte external formats such as EUC-JP
+    were not handled correctly (lp#713063).
 
 changes in sbcl-1.0.45 relative to sbcl-1.0.44:
   * enhancement: ~/ and ~user/ are treated specially in pathnames.
diff --git a/src/code/external-formats/mb-util.lisp b/src/code/external-formats/mb-util.lisp
index 9a82d45..5569a9f 100644
--- a/src/code/external-formats/mb-util.lisp
+++ b/src/code/external-formats/mb-util.lisp
@@ -254,7 +254,9 @@
          ;; replacement character, so we hardcode the preferred
          ;; replacement here.
          #\?
-         (mb-char-len (or (,ucs-to-mb (char-code byte)) -1))
+         (block size
+           (mb-char-len (or (,ucs-to-mb (char-code byte))
+                            (return-from size 0))))
          (let ((mb (,ucs-to-mb bits)))
            (if (null mb)
                (external-format-encoding-error stream byte)
diff --git a/tests/external-format.impure.lisp b/tests/external-format.impure.lisp
index 11586b9..bd521f8 100644
--- a/tests/external-format.impure.lisp
+++ b/tests/external-format.impure.lisp
@@ -1020,5 +1020,18 @@
        (handler-case
            (octets-to-string octets :external-format :bad-format)
          (error (e) e))))))
+
+(with-test (:name :lp713063)
+  (with-open-file (f *test-path*
+                     :direction :output
+                     :external-format '(:euc-jp :replacement #\?)
+                     :if-exists :supersede)
+    (write-string (make-string 3 :initial-element #\horizontal_bar) f))
+  (assert (equal "???"
+                 (with-open-file (f *test-path*
+                                    :direction :input
+                                    :external-format :euc-jp)
+                   (read-line f))))
+  (delete-file *test-path*))
 
 ;;;; success
diff --git a/version.lisp-expr b/version.lisp-expr
index f3c41e2..cc5e097 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -20,4 +20,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.45.13"
+"1.0.45.14"