Commit 8630ece3 authored by rtoy's avatar rtoy
Browse files

code/unidata.lisp: 

o Add UNICODE-ASSIGNED-CODEPOINT-P

code/string.lisp:
o Make UTF16-STRING-P check for unassigned codepoints in the string.
parent 4347b68d

code/string.lisp

+8 −5
Original line number Diff line number Diff line
@@ -5,7 +5,7 @@ 
;;; Carnegie Mellon University, and has been placed in the public domain.

;;;

(ext:file-comment

  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/string.lisp,v 1.12.30.27 2009/05/28 16:17:48 rtoy Exp $")

  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/string.lisp,v 1.12.30.28 2009/06/04 15:47:40 rtoy Exp $")

;;;

;;; **********************************************************************

;;;
@@ -110,7 +110,8 @@ 
(defun utf16-string-p (string)

  "Check if String is a valid UTF-16 string.  If the string is valid,

  T is returned.  If the string is not valid, NIL is returned, and the

  second value is the index into the string of the invalid character."

  second value is the index into the string of the invalid character.

  A string is also invalid if it contains any unassigned codepoints."

  (do ((len (length string))

       (index 0 (1+ index)))

      ((>= index len)
@@ -120,10 +121,12 @@ 
      ;; We step through the string in order.  If there are any

      ;; surrogates pairs, we must reach the lead surrogate first,

      ;; which means WIDE is +1.  Otherwise, we have an invalid

      ;; surrogate pair.  If we get any codepoint that is in

      ;; the surrogate range, we also have an invalid string.

      ;; surrogate pair.  If we get any codepoint that is in the

      ;; surrogate range, we also have an invalid string.  An

      ;; unassigned codepoint is also considered invalid.

      (when (or (eq wide -1)

		(surrogatep codepoint))

		(surrogatep codepoint)

		(lisp::unicode-assigned-codepoint-p codepoint))

	(return-from utf16-string-p (values nil index)))

      (when wide (incf index)))))

code/unidata.lisp

+5 −1
Original line number Diff line number Diff line
@@ -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/code/unidata.lisp,v 1.1.2.25 2009/05/29 16:12:40 rtoy Exp $")

(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/unidata.lisp,v 1.1.2.26 2009/06/04 15:47:40 rtoy Exp $")

;;;

;;; **********************************************************************

;;;
@@ -710,6 +710,10 @@ 
	  (schar s 1) (schar "nsifepkcdmulto??" (ldb (byte 4 0) n)))

    s))



(declaim (inline unicode-assigned-codepoint-p))

(defun unicode-assigned-codepoint-p (code)

  (not (zerop (unicode-category code))))



;; Look at unicode-category-string to see how we get these numbers.

;; +unicode-category-graphic+ is the first graphic character

;; +unicode-category-letter+ is the first letter