From c33ad6c936c277e7d15e3930e9b0fed77df4eb39 Mon Sep 17 00:00:00 2001 From: rtoy <rtoy> Date: Mon, 28 Sep 2009 18:12:59 +0000 Subject: [PATCH] Merge changes from 20a release branch. --- pcl/simple-streams/external-formats/utf-32-be.lisp | 4 ++-- pcl/simple-streams/external-formats/utf-32-le.lisp | 4 ++-- pcl/simple-streams/external-formats/utf-32.lisp | 12 +++++++----- pcl/simple-streams/external-formats/utf-8.lisp | 11 +++++++---- 4 files changed, 18 insertions(+), 13 deletions(-) diff --git a/pcl/simple-streams/external-formats/utf-32-be.lisp b/pcl/simple-streams/external-formats/utf-32-be.lisp index 43e02104a..23f674266 100644 --- a/pcl/simple-streams/external-formats/utf-32-be.lisp +++ b/pcl/simple-streams/external-formats/utf-32-be.lisp @@ -4,7 +4,7 @@ ;;; This code was written by Raymond Toy and has been placed in the public ;;; domain. ;;; -(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/utf-32-be.lisp,v 1.2 2009/06/11 16:04:02 rtoy Rel $") +(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/utf-32-be.lisp,v 1.3 2009/09/28 18:12:59 rtoy Exp $") (in-package "STREAM") @@ -20,7 +20,7 @@ (ash ,c2 16) (ash ,c3 8) ,c4))) - (declaim (type (unsigned-byte 8) ,c1 ,c2 ,c3 ,c4) + (declare (type (unsigned-byte 8) ,c1 ,c2 ,c3 ,c4) (optimize (speed 3))) (cond ((or (> ,c #x10ffff) (lisp::surrogatep ,c)) diff --git a/pcl/simple-streams/external-formats/utf-32-le.lisp b/pcl/simple-streams/external-formats/utf-32-le.lisp index c8e96efab..881356307 100644 --- a/pcl/simple-streams/external-formats/utf-32-le.lisp +++ b/pcl/simple-streams/external-formats/utf-32-le.lisp @@ -4,7 +4,7 @@ ;;; This code was written by Raymond Toy and has been placed in the public ;;; domain. ;;; -(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/utf-32-le.lisp,v 1.2 2009/06/11 16:04:02 rtoy Rel $") +(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/utf-32-le.lisp,v 1.3 2009/09/28 18:12:59 rtoy Exp $") (in-package "STREAM") @@ -20,7 +20,7 @@ (ash ,c2 8) (ash ,c3 16) (ash ,c4 24)))) - (declaim (type (unsigned-byte 8) ,c1 ,c2 ,c3 ,c4) + (declare (type (unsigned-byte 8) ,c1 ,c2 ,c3 ,c4) (optimize (speed 3))) (cond ((or (> ,c #x10ffff) (lisp::surrogatep ,c)) diff --git a/pcl/simple-streams/external-formats/utf-32.lisp b/pcl/simple-streams/external-formats/utf-32.lisp index f34c4f11b..94883d785 100644 --- a/pcl/simple-streams/external-formats/utf-32.lisp +++ b/pcl/simple-streams/external-formats/utf-32.lisp @@ -4,7 +4,7 @@ ;;; This code was written by Raymond Toy and has been placed in the public ;;; domain. ;;; -(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/utf-32.lisp,v 1.3 2009/09/09 15:51:28 rtoy Rel $") +(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/utf-32.lisp,v 1.4 2009/09/28 18:12:59 rtoy Exp $") (in-package "STREAM") @@ -51,12 +51,14 @@ (ash ,c3 8) ,c4))) (,wd 4)) - (declaim (type (integer 0 2) ,st) + (declare (type (integer 0 2) ,st) (type (unsigned-byte 8) ,c1 ,c2 ,c3 ,c4) - (type lisp:codepoint ,code) (optimize (speed 3))) - (cond ((lisp::surrogatep ,code) - ;; Surrogates are illegal. Use replacement character. + (cond ((or (> ,code #x10fff) + (lisp::surrogatep ,code)) + ;; Surrogates are illegal and codepoints outside + ;; the Unicode range are illegal. Use replacement + ;; character. (setf ,code +replacement-character-code+)) ((and (zerop ,st) (= ,code #xFFFE0000)) ;; BOM for little-endian diff --git a/pcl/simple-streams/external-formats/utf-8.lisp b/pcl/simple-streams/external-formats/utf-8.lisp index a63a9e868..5407d5f92 100644 --- a/pcl/simple-streams/external-formats/utf-8.lisp +++ b/pcl/simple-streams/external-formats/utf-8.lisp @@ -4,7 +4,7 @@ ;;; This code was written by Paul Foley and has been placed in the public ;;; domain. ;;; -(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/utf-8.lisp,v 1.4 2009/06/11 16:04:02 rtoy Rel $") +(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/utf-8.lisp,v 1.5 2009/09/28 18:12:59 rtoy Exp $") (in-package "STREAM") @@ -35,12 +35,15 @@ (,unput 1) (return (values +replacement-character-code+ (1+ ,j))))))))) (check (,n ,i) - (declare (type lisp:codepoint ,n) + (declare (type (unsigned-byte 31) ,n) (type (integer 1 5) ,i)) ;; We check for overlong sequences (sequences that ;; encode to codepoints that don't need that long of a - ;; sequence) and any surrogate values. - (if (or (<= ,n (the (member 127 1023 32767) (svref #(127 1023 32767) (1- ,i)))) ; overlong + ;; sequence) and any surrogate values and any code + ;; outside the 21-bit Unicode range. + (if (or (> ,n #x10ffff) + (<= ,n (the (member 127 1023 32767) + (svref #(127 1023 32767) (1- ,i)))) ; overlong (lisp::surrogatep ,n)) ; surrogate (progn (,unput ,i) -- GitLab