diff --git a/pcl/simple-streams/external-formats/utf-32-be.lisp b/pcl/simple-streams/external-formats/utf-32-be.lisp index 43e02104a589567e48f56fec5ff1b63676de4897..23f67426641296ef2fd11e54ec3c4f82626bb09f 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 c8e96efabe04747a5d4ddd27b514d7a8f7579b12..881356307acb7da7adfec76ac1d40d660c20f2b5 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 f34c4f11b84e03e4cce34edb5ed6b98d4ba4e2f7..94883d785229707d5f004d83c7f6bcf8a26ad8cd 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 a63a9e868f87817a48734bd8507eefb5ed215d3d..5407d5f92e4b843db2e463dba55f4592ed7ce83e 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)