tests/unicode-normalization.impure.lisp

   1 (import 'sb-impl::normalize-string)
   2
   3 (defun parse-one-line (line)
   4   (do* ((i 0 (1+ i))
   5         (start 0 (1+ end))
   6         (end (position #\; line :start start) (position #\; line :start start))
   7         result)
   8        ((= i 5) (nreverse result))
   9     (with-input-from-string (s (subseq line start (1+ end)))
  10       (let ((*read-base* 16.))
  11         (push (map 'string 'code-char (read-delimited-list #\; s)) result)))))
  12
  13 (defmacro assert-all-string= (base &body others)
  14   `(progn
  15      ,@(loop for test in others
  16           collect `(assert (string= ,base ,test)))))
  17
  18 (defun test-line (c1 c2 c3 c4 c5)
  19   ;; NFC
  20   (assert-all-string= c2
  21     (normalize-string c1 :nfc)
  22     (normalize-string c2 :nfc)
  23     (normalize-string c3 :nfc))
  24   (assert-all-string= c4
  25     (normalize-string c4 :nfc)
  26     (normalize-string c5 :nfc))
  27
  28   ;; NFD
  29   (assert-all-string= c3
  30     (normalize-string c1 :nfd)
  31     (normalize-string c2 :nfd)
  32     (normalize-string c3 :nfd))
  33   (assert-all-string= c5
  34     (normalize-string c4 :nfd)
  35     (normalize-string c5 :nfd))
  36
  37   ;; NFKC
  38   (assert-all-string= c4
  39     (normalize-string c1 :nfkc)
  40     (normalize-string c2 :nfkc)
  41     (normalize-string c3 :nfkc)
  42     (normalize-string c4 :nfkc)
  43     (normalize-string c5 :nfkc))
  44
  45   ;; NFKD
  46   (assert-all-string= c5
  47     (normalize-string c1 :nfkd)
  48     (normalize-string c2 :nfkd)
  49     (normalize-string c3 :nfkd)
  50     (normalize-string c4 :nfkd)
  51     (normalize-string c5 :nfkd)))
  52
  53 (defun test-no-normalization (string)
  54   (assert-all-string= string
  55     (normalize-string string :nfc)
  56     (normalize-string string :nfd)
  57     (normalize-string string :nfkc)
  58     (normalize-string string :nfkd)))
  59
  60 (defun test-normalization ()
  61   (declare (optimize (debug 2)))
  62   (with-open-file (s "data/NormalizationTest.txt" :external-format :latin1)
  63     (do ((line (read-line s) (read-line s)))
  64         ((char/= #\# (char line 0))
  65          (assert (string= "@Part0" line :end2 6))
  66          (assert (char= #\# (char (read-line s) 0)))))
  67     ;; Part0: specific cases
  68     (with-test (:name (:unicode-normalization :part0))
  69       (do ((line (read-line s) (read-line s)))
  70           ((char= #\# (char line 0))
  71            (assert (string= "@Part1" (read-line s) :end2 6))
  72            (assert (char= #\# (char (read-line s) 0)))
  73            (assert (char= #\# (char (read-line s) 0))))
  74         (destructuring-bind (c1 c2 c3 c4 c5)
  75             (parse-one-line line)
  76           (test-line c1 c2 c3 c4 c5))))
  77     ;; Part1: single characters.  (Extra work to check for conformance
  78     ;; on unlisted entries)
  79     (with-test (:name (:unicode-normalization :part1))
  80       (do ((line (read-line s) (read-line s))
  81            (code 0))
  82           ((char= #\# (char line 0))
  83            (do ((code code (1+ code)))
  84                ((= code #x110000))
  85              (test-no-normalization (string (code-char code))))
  86            (assert (string= "@Part2" (read-line s) :end2 6))
  87            (assert (char= #\# (char (read-line s) 0))))
  88         (destructuring-bind (c1 c2 c3 c4 c5)
  89             (parse-one-line line)
  90           (do ((c code (1+ c)))
  91               ((= c (char-code (char c1 0)))
  92                (test-line c1 c2 c3 c4 c5)
  93                (setf code (1+ c)))
  94             (test-no-normalization (string (code-char code)))))))
  95     ;; Part2: Canonical Order Test
  96     (with-test (:name (:unicode-normalization :part2))
  97       (do ((line (read-line s) (read-line s)))
  98           ((char= #\# (char line 0))
  99            (assert (string= "@Part3" (read-line s) :end2 6))
 100            (assert (char= #\# (char (read-line s) 0))))
 101         (destructuring-bind (c1 c2 c3 c4 c5)
 102             (parse-one-line line)
 103           (test-line c1 c2 c3 c4 c5))))
 104     ;; Part3: PRI #29 Test
 105     (with-test (:name (:unicode-normalization :part3))
 106       (do ((line (read-line s) (read-line s)))
 107           ((char= #\# (char line 0))
 108            (assert (char= #\# (char (read-line s) 0)))
 109            (assert (null (read-line s nil nil))))
 110         (destructuring-bind (c1 c2 c3 c4 c5)
 111             (parse-one-line line)
 112           (test-line c1 c2 c3 c4 c5))))))
 113
 114 (test-normalization)