fix CL case conversions of characters involving iota subscript

Oh boy.  Judging by the length of the web page explaining the issue
(at <http://www.tlg.uci.edu/~opoudjis/unicode/unicode_adscript.html>)
this is a bit of a minefield.  I hope that this doesn't contribute
further to the trouble...

Although the combined _WITH_PROSGEGRAMMENI characters are of
general class "Lt" (i.e. titlecase), for CL purposes we treat them
as the uppercase equivalent of the lowercase _WITH_YPOGEGRAMMENI
characters (as directly specified by the case mapping data in
UnicodeData.txt).  This is a little awkward, and involves a bit
of rearrangement in the indices of the misc table entries to make
the (CL) uppercase/lowercase tests efficient, but seems to be the
best of all possible worlds given that we must comply with CL's
character-to-character case mappings -- the alternative of not
providing an uppercase version of LOWERCASE_OMEGA_WITH_YPOGEGRAMMENI
seems even weirder.

The way this is done in ucd.lisp is a little bit kludgy, because we
have to avoid giving the same exception to the serbian titlecase
digraphs (Dz and friends) which mustn't map to anything, or else
we'd break invertibility.  (The lowercase dz and uppercase DZ are
already (CL) case mappings of each other).  Probably the thing which
will confuse future readers is that some (Unicode) titlecase
characters are (CL) upper-case-p.
This commit is contained in:
Christophe Rhodes 2013-06-04 13:00:50 +01:00
parent 0d51ca7e5e
commit f44f6d1adb
3 changed files with 17 additions and 10 deletions

View file

@ -400,20 +400,20 @@ argument is an alphabetic character, A-Z or a-z; otherwise NIL."
#!+sb-doc
"The argument must be a character object; UPPER-CASE-P returns T if the
argument is an upper-case character, NIL otherwise."
(< (ucd-value-0 char) 4))
(< (ucd-value-0 char) 5))
(defun lower-case-p (char)
#!+sb-doc
"The argument must be a character object; LOWER-CASE-P returns T if the
argument is a lower-case character, NIL otherwise."
(< 3 (ucd-value-0 char) 8))
(< 4 (ucd-value-0 char) 9))
(defun both-case-p (char)
#!+sb-doc
"The argument must be a character object. BOTH-CASE-P returns T if the
argument is an alphabetic character and if the character exists in both upper
and lower case. For ASCII, this is the same as ALPHA-CHAR-P."
(< (ucd-value-0 char) 8))
(< (ucd-value-0 char) 9))
(defun digit-char-p (char &optional (radix 10.))
#!+sb-doc
@ -513,7 +513,7 @@ is either numeric or alphabetic."
(defmacro equal-char-code (character)
(let ((ch (gensym)))
`(let ((,ch ,character))
(if (< (ucd-value-0 ,ch) 4)
(if (< (ucd-value-0 ,ch) 5)
(ucd-value-1 ,ch)
(char-code ,ch)))))
@ -609,14 +609,14 @@ Case is ignored."
#!+sb-doc
"Return CHAR converted to upper-case if that is possible. Don't convert
lowercase eszet (U+DF)."
(if (< 3 (ucd-value-0 char) 8)
(if (< 4 (ucd-value-0 char) 9)
(code-char (ucd-value-1 char))
char))
(defun char-downcase (char)
#!+sb-doc
"Return CHAR converted to lower-case if that is possible."
(if (< (ucd-value-0 char) 4)
(if (< (ucd-value-0 char) 5)
(code-char (ucd-value-1 char))
char))

View file

@ -130,8 +130,7 @@
(with-test (:name (:case-insensitive-char-comparisons :eacute))
(assert (char-equal (code-char 201) (code-char 233))))
(with-test (:name (:case-insensitive-char-comparisons :exhaustive)
:fails-on :sb-unicode)
(with-test (:name (:case-insensitive-char-comparisons :exhaustive))
(dotimes (i char-code-limit)
(let* ((char (code-char i))
(down (char-downcase char))

View file

@ -50,6 +50,9 @@
(setf (gethash list *misc-hash*)
(incf *misc-index*))))))
(defun gc-index-sort-key (gc-index)
(or (cdr (assoc gc-index '((1 . 2) (2 . 1)))) gc-index))
(defun compare-misc-entry (left right)
(destructuring-bind (left-gc-index left-bidi-index left-ccc-index
left-decimal-digit left-digit left-bidi-mirrored
@ -61,7 +64,8 @@
right
(or (and left-cl-both-case-p (not right-cl-both-case-p))
(and (or left-cl-both-case-p (not right-cl-both-case-p))
(or (< left-gc-index right-gc-index)
(or (< (gc-index-sort-key left-gc-index)
(gc-index-sort-key right-gc-index))
(and (= left-gc-index right-gc-index)
(or (< left-decomposition-info right-decomposition-info)
(and (= left-decomposition-info right-decomposition-info)
@ -270,7 +274,11 @@
(parse-integer simple-titlecase :radix 16)))
(cl-both-case-p
(not (null (or (and (= gc-index 0) lower-index)
(and (= gc-index 1) upper-index)))))
(and (= gc-index 1) upper-index)
;; deal with prosgegrammeni / titlecase
(and (= gc-index 2)
(typep code-point '(integer #x1000 #x1fff))
lower-index)))))
(decomposition-info 0))
(declare (ignore digit-index))
(when (and (not cl-both-case-p)