1 (import 'sb-impl::normalize-string)
3 (defun parse-one-line (line)
6 (end (position #\; line :start start) (position #\; line :start start))
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)))))
13 (defmacro assert-all-string= (base &body others)
15 ,@(loop for test in others
16 collect `(assert (string= ,base ,test)))))
18 (defun test-line (c1 c2 c3 c4 c5)
21 (assert-all-string= c2
22 (normalize-string c1 :nfc)
23 (normalize-string c2 :nfc)
24 (normalize-string c3 :nfc))
26 (assert-all-string= c4
27 (normalize-string c4 :nfc)
28 (normalize-string c5 :nfc))
31 (assert-all-string= c3
32 (normalize-string c1 :nfd)
33 (normalize-string c2 :nfd)
34 (normalize-string c3 :nfd))
35 (assert-all-string= c5
36 (normalize-string c4 :nfd)
37 (normalize-string c5 :nfd))
41 (assert-all-string= c4
42 (normalize-string c1 :nfkc)
43 (normalize-string c2 :nfkc)
44 (normalize-string c3 :nfkc)
45 (normalize-string c4 :nfkc)
46 (normalize-string c5 :nfkc))
49 (assert-all-string= c5
50 (normalize-string c1 :nfkd)
51 (normalize-string c2 :nfkd)
52 (normalize-string c3 :nfkd)
53 (normalize-string c4 :nfkd)
54 (normalize-string c5 :nfkd)))
56 (defun test-no-normalization (string)
57 (assert-all-string= string
59 (normalize-string string :nfc)
60 (normalize-string string :nfd)
62 (normalize-string string :nfkc)
63 (normalize-string string :nfkd)))
65 (defun test-normalization ()
66 (declare (optimize (debug 2)))
67 (with-open-file (s "data/NormalizationTest.txt" :external-format :latin1)
68 (do ((line (read-line s) (read-line s)))
69 ((char/= #\# (char line 0))
70 (assert (string= "@Part0" line :end2 6))
71 (assert (char= #\# (char (read-line s) 0)))))
72 ;; Part0: specific cases
73 (with-test (:name (:unicode-normalization :part0))
74 (do ((line (read-line s) (read-line s)))
75 ((char= #\# (char line 0))
76 (assert (string= "@Part1" (read-line s) :end2 6))
77 (assert (char= #\# (char (read-line s) 0)))
78 (assert (char= #\# (char (read-line s) 0))))
79 (destructuring-bind (c1 c2 c3 c4 c5)
81 (test-line c1 c2 c3 c4 c5))))
82 ;; Part1: single characters. (Extra work to check for conformance
83 ;; on unlisted entries)
84 (with-test (:name (:unicode-normalization :part1))
85 (do ((line (read-line s) (read-line s))
87 ((char= #\# (char line 0))
88 (do ((code code (1+ code)))
90 (test-no-normalization (string (code-char code))))
91 (assert (string= "@Part2" (read-line s) :end2 6))
92 (assert (char= #\# (char (read-line s) 0))))
93 (destructuring-bind (c1 c2 c3 c4 c5)
96 ((= c (char-code (char c1 0)))
97 (test-line c1 c2 c3 c4 c5)
99 (test-no-normalization (string (code-char code)))))))
100 ;; Part2: Canonical Order Test
101 (with-test (:name (:unicode-normalization :part2))
102 (do ((line (read-line s) (read-line s)))
103 ((char= #\# (char line 0))
104 (assert (string= "@Part3" (read-line s) :end2 6))
105 (assert (char= #\# (char (read-line s) 0))))
106 (destructuring-bind (c1 c2 c3 c4 c5)
107 (parse-one-line line)
108 (test-line c1 c2 c3 c4 c5))))
109 ;; Part3: PRI #29 Test
110 (with-test (:name (:unicode-normalization :part3))
111 (do ((line (read-line s) (read-line s)))
112 ((char= #\# (char line 0))
113 (assert (char= #\# (char (read-line s) 0)))
114 (assert (null (read-line s nil nil))))
115 (destructuring-bind (c1 c2 c3 c4 c5)
116 (parse-one-line line)
117 (test-line c1 c2 c3 c4 c5))))))