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