Skip to content
Snippets Groups Projects
Commit 99d39125 authored by Raymond Toy's avatar Raymond Toy
Browse files

UTF-16-BE and UTF-16-LE external formats were returning the incorrect

number of octets for surrogate pairs.  Two was returned instead of
four.

 * src/pcl/simple-streams/external-formats/utf-16-be.lisp:
 * src/pcl/simple-streams/external-formats/utf-16-le.lisp:
   * Return correct number of octets
 * src/general-info/release-20d.txt
   * Update.
parent 9f6b065b
Branches
Tags
No related merge requests found
......@@ -61,6 +61,9 @@ New in this release:
double-float multiplier from being used when sse3 is available.
* External format for UTF-32 was generating an error when
converting octets to a string.
* The UTF-16-BE and UTF-16-LE external formats were returning the
incorrect number of octets when surrogates pairs were decoded.
This confuses the stream buffering code.
* Trac Tickets:
* #50: Print/read error with make-pathname.
......
......@@ -21,10 +21,11 @@ By default, illegal inputs and illegal outputs are replaced by the
Unicode replacement character.")
()
(octets-to-code (state input unput error c1 c2 code next)
(octets-to-code (state input unput error c1 c2 code wd next)
`(let* ((,c1 ,input)
(,c2 ,input)
(,code (+ (* 256 ,c1) ,c2)))
(,code (+ (* 256 ,c1) ,c2))
(, wd 2))
(declare (type lisp:codepoint ,code))
(cond ((lisp::surrogatep ,code :low)
;; Got low surrogate. Combine with the state (high
......@@ -55,7 +56,8 @@ Unicode replacement character.")
;; unput 2 so it'll be read as another character
;; next time around?
(if (lisp::surrogatep ,next :low)
(setq ,code (+ (ash (- ,code #xD800) 10) ,next #x2400))
(setq ,code (+ (ash (- ,code #xD800) 10) ,next #x2400)
,wd 4)
(setf ,code
(if ,error
(locally
......@@ -74,7 +76,7 @@ Unicode replacement character.")
(funcall ,error "BOM is not valid within a UTF-16 stream" ,code 2))
+replacement-character-code+)))
(t (setf ,state nil)))
(values ,code 2)))
(values ,code ,wd)))
(code-to-octets (code state output error c c1 c2)
`(flet ((output (code)
(,output (ldb (byte 8 8) code))
......
......@@ -22,10 +22,11 @@ By default, illegal inputs and illegal outputs are replaced by the
Unicode replacement character.")
()
(octets-to-code (state input unput error c1 c2 code next)
(octets-to-code (state input unput error c1 c2 code wd next)
`(let* ((,c1 ,input)
(,c2 ,input)
(,code (+ (* 256 ,c2) ,c1)))
(,code (+ (* 256 ,c2) ,c1))
(,wd 2))
(declare (type lisp:codepoint ,code))
(cond ((lisp::surrogatep ,code :low)
;; If possible combine this low surrogate with the
......@@ -56,14 +57,15 @@ Unicode replacement character.")
;; unput 2 so it'll be read as another character
;; next time around?
(if (lisp::surrogatep ,next :low)
(setq ,code (+ (ash (- ,code #xD800) 10) ,next #x2400))
(setq ,code (+ (ash (- ,code #xD800) 10) ,next #x2400)
,wd 4)
(setq ,code
(if ,error
(locally
;; No warnings about fdefinition
(declare (optimize (ext:inhibit-warnings 3)))
(funcall ,error "High surrogate followed by #x~4,'0X ~
instead of low surrogate" ,next 2))
instead of low surrogate" ,next ,wd))
+replacement-character-code+)))))
((= ,code #xFFFE)
;; replace with REPLACEMENT CHARACTER.
......@@ -75,7 +77,7 @@ Unicode replacement character.")
(funcall ,error "BOM is not valid within a UTF-16 stream" ,code 2))
+replacement-character-code+)))
(t (setf ,state nil)))
(values ,code 2)))
(values ,code ,wd)))
(code-to-octets (code state output error c c1 c2)
`(flet ((output (code)
(,output (ldb (byte 8 0) code))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please to comment