tests/unicode-misc.pure.lisp

   1 ;;;; This software is part of the SBCL system. See the README file for
   2 ;;;; more information.
   3 ;;;;
   4 ;;;; While most of SBCL is derived from the CMU CL system, the test
   5 ;;;; files (like this one) were written from scratch after the fork
   6 ;;;; from CMU CL.
   7 ;;;;
   8 ;;;; This software is in the public domain and is provided with
   9 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
  10 ;;;; more information.
  11
  12 #+sb-unicode
  13 (with-test (:name (:unicode-casing)
  14                   :skipped-on '(not :sb-unicode))
  15   (labels ((str (&rest chars)
  16              (coerce chars 'string))
  17            (test-fn (fn locale pairs)
  18              (loop for (a . b) in pairs do
  19                   (assert (string= (funcall fn (apply #'str a) :locale locale)
  20                                    (funcall fn (apply #'str b) :locale locale))))))
  21     (test-fn
  22      #'sb-unicode:uppercase nil
  23      '(((#\i) . (#\I)) ((#\a) . (#\a)) ((#\U+DF) . (#\s #\s))
  24        ((#\GREEK_SMALL_LETTER_SIGMA) . (#\GREEK_SMALL_LETTER_FINAL_SIGMA))))
  25     (test-fn
  26      #'sb-unicode:lowercase nil
  27      '(((#\I) . (#\i)) ((#\U+03A3) . (#\U+03C3)) ((#\a #\U+03A3) . (#\a #\U+03C2))
  28        ((#\a #\U+03A3 #\U+0308) . (#\a #\U+03C2 #\U+0308))
  29        ((#\Space #\U+03A3 #\Space) . (#\Space #\U+03C3 #\Space))
  30        ((#\U+03A3 #\U+03A3) . (#\U+03C3 #\U+03C2))))
  31     (test-fn
  32      #'sb-unicode:uppercase :tr
  33      '(((#\U+0131) . (#\I))
  34        ((#\i) . (#\U+0130))))
  35     (test-fn
  36      #'sb-unicode:lowercase :tr
  37      '(((#\I) . (#\U+0131))
  38        ((#\U+130) . (#\i))
  39        ((#\I #\COMBINING_DOT_ABOVE) . (#\i))))
  40     (test-fn
  41      #'sb-unicode:uppercase :lt
  42      '(((#\i #\U+0307) . (#\I))))
  43     (test-fn
  44      #'sb-unicode:lowercase :lt
  45      '(((#\I #\U+0301) . (#\i #\U+0307 #\U+0301))))))
  46
  47 (with-test (:name (:cl-case-invertibility))
  48   (loop for i from 0 below char-code-limit
  49      for char = (code-char i)
  50      do
  51        (when (upper-case-p char)
  52          (assert (char= char (char-upcase (char-downcase char)))))
  53        (when (lower-case-p char)
  54          (assert (char= char (char-downcase (char-upcase char)))))))
  55
  56 (with-test (:name (:basic-confusable-detection))
  57   (assert (sb-unicode:confusable-p "l0" "1O"))
  58   (assert (sb-unicode:confusable-p "\"" "''"))
  59   (assert (not (sb-unicode:confusable-p "a" "A")))
  60   (assert (not (sb-unicode:confusable-p "" "<")))
  61   #+sb-unicode
  62   (assert (sb-unicode:confusable-p
  63            (coerce '(#\a #\COMBINING_RING_ABOVE) 'string)
  64            (string #\LATIN_SMALL_LETTER_A_WITH_RING_ABOVE))))
  65
  66 (with-test (:name :normalize-dispalced)
  67   (assert (equal (sb-unicode:normalize-string
  68                   (make-array 3 :element-type 'character
  69                                 :displaced-to "abcd"
  70                                 :displaced-index-offset 1
  71                                 :fill-pointer 2) :nfc)
  72                  "bc")))