[Sbcl-commits] 1.0.45.14: fix handling of multibyte character encoding errors

[Nikodemus S. <nik...@ra...>]

...the CVS came back on, but mail appears to be in the fritz, so I'm
sending manual commit messages along with git diffs.

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