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)
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))
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))
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))
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)))
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)))
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)
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))
82 ((char= #\# (char line 0))
83 (do ((code code (1+ code)))
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)
91 ((= c (char-code (char c1 0)))
92 (test-line c1 c2 c3 c4 c5)
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))))))