[Sbcl-commits] master: fix CHAR-EQUALity of non-ascii caseful characters

[Christophe R. <cr...@us...>]

The branch "master" has been updated in SBCL:
       via  88429c4045707ceaf99a10801d5c5efdca765afa (commit)
      from  be974ede67a3d7f8a6e7aa200ad042d3ac644cff (commit)

- Log -----------------------------------------------------------------
commit 88429c4045707ceaf99a10801d5c5efdca765afa
Author: Christophe Rhodes <cs...@ca...>
Date:   Mon May 27 08:11:05 2013 +0100

    fix CHAR-EQUALity of non-ascii caseful characters
    
    Or at least mostly fix it.  There are issues surrounding iota subscript and
    titlecase, which aren't regressions in the current release and will require
    some more investigation to fix.
---
 src/code/target-char.lisp |    2 +-
 tests/character.pure.lisp |   15 +++++++++++++++
 2 files changed, 16 insertions(+), 1 deletions(-)

diff --git a/src/code/target-char.lisp b/src/code/target-char.lisp
index 395a894..e217f8e 100644
--- a/src/code/target-char.lisp
+++ b/src/code/target-char.lisp
@@ -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) 0)
+      (if (< (ucd-value-0 ,ch) 4)
           (ucd-value-1 ,ch)
           (char-code ,ch)))))
 
diff --git a/tests/character.pure.lisp b/tests/character.pure.lisp
index 95c5833..c84b463 100644
--- a/tests/character.pure.lisp
+++ b/tests/character.pure.lisp
@@ -126,3 +126,18 @@
                                            ((1 . ,(1- char-code-limit))))
                                           &optional))
                    (sb-impl::%fun-type f)))))
+
+(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 '(and))
+  (dotimes (i char-code-limit)
+    (let* ((char (code-char i))
+           (down (char-downcase char))
+           (up (char-upcase char)))
+      (assert (char-equal char char))
+      (when (char/= char down)
+        (assert (char-equal char down)))
+      (when (char/= char up)
+        (assert (char-equal char up))))))

-----------------------------------------------------------------------


hooks/post-receive
-- 
SBCL