X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Funicode-normalization.impure.lisp;h=49aa69a49173ac75c6a8fdf23220fa89bc05d8f9;hb=1f704cd4ff7a23e518d6d1565951af7bae0a2a9f;hp=06d555f9096aa1d235f3590321051fa20b4e06b3;hpb=5877e8c2334bd87490be385af21ed9bc494f19e2;p=sbcl.git diff --git a/tests/unicode-normalization.impure.lisp b/tests/unicode-normalization.impure.lisp index 06d555f..49aa69a 100644 --- a/tests/unicode-normalization.impure.lisp +++ b/tests/unicode-normalization.impure.lisp @@ -1,3 +1,17 @@ +;;;; This software is part of the SBCL system. See the README file for +;;;; more information. +;;;; +;;;; While most of SBCL is derived from the CMU CL system, the test +;;;; files (like this one) were written from scratch after the fork +;;;; from CMU CL. +;;;; +;;;; This software is in the public domain and is provided with +;;;; absolutely no warranty. See the COPYING and CREDITS files for +;;;; more information. + +;;; KLUDGE: eventually we will export NORMALIZE-STRING from somewhere. +;;; Until we do, import it here so we can test it without putting :: +;;; everywhere. (import 'sb-impl::normalize-string) (defun parse-one-line (line) @@ -17,12 +31,10 @@ (defun test-line (c1 c2 c3 c4 c5) ;; NFC - #+nil (assert-all-string= c2 (normalize-string c1 :nfc) (normalize-string c2 :nfc) (normalize-string c3 :nfc)) - #+nil (assert-all-string= c4 (normalize-string c4 :nfc) (normalize-string c5 :nfc)) @@ -37,7 +49,6 @@ (normalize-string c5 :nfd)) ;; NFKC - #+nil (assert-all-string= c4 (normalize-string c1 :nfkc) (normalize-string c2 :nfkc) @@ -55,10 +66,8 @@ (defun test-no-normalization (string) (assert-all-string= string - #+nil (normalize-string string :nfc) (normalize-string string :nfd) - #+nil (normalize-string string :nfkc) (normalize-string string :nfkd))) @@ -70,27 +79,54 @@ (assert (string= "@Part0" line :end2 6)) (assert (char= #\# (char (read-line s) 0))))) ;; Part0: specific cases - (do ((line (read-line s) (read-line s))) - ((char= #\# (char line 0)) - (assert (string= "@Part1" (read-line s) :end2 6)) - (assert (char= #\# (char (read-line s) 0))) - (assert (char= #\# (char (read-line s) 0)))) - (destructuring-bind (c1 c2 c3 c4 c5) - (parse-one-line line) - (write-line line) - (test-line c1 c2 c3 c4 c5))) + (with-test (:name (:unicode-normalization :part0) + :skipped-on '(not :sb-unicode)) + (do ((line (read-line s) (read-line s))) + ((char= #\# (char line 0)) + (assert (string= "@Part1" (read-line s) :end2 6)) + (assert (char= #\# (char (read-line s) 0))) + (assert (char= #\# (char (read-line s) 0)))) + (destructuring-bind (c1 c2 c3 c4 c5) + (parse-one-line line) + (test-line c1 c2 c3 c4 c5)))) ;; Part1: single characters. (Extra work to check for conformance ;; on unlisted entries) - (do ((line (read-line s) (read-line s)) - (code 0)) - ((char= #\# (char line 0)) - (do ((code code (1+ code))) - ((= code #x110000)) - (test-no-normalization (string (code-char code))))) - (destructuring-bind (c1 c2 c3 c4 c5) - (parse-one-line line) - (do ((c code (1+ c))) - ((= c (char-code (char c1 0))) - (test-line c1 c2 c3 c4 c5) - (setf code (1+ c))) - (test-no-normalization (string (code-char code)))))))) \ No newline at end of file + (with-test (:name (:unicode-normalization :part1) + :skipped-on '(not :sb-unicode)) + (do ((line (read-line s) (read-line s)) + (code 0)) + ((char= #\# (char line 0)) + (do ((code code (1+ code))) + ((= code #x110000)) + (test-no-normalization (string (code-char code)))) + (assert (string= "@Part2" (read-line s) :end2 6)) + (assert (char= #\# (char (read-line s) 0)))) + (destructuring-bind (c1 c2 c3 c4 c5) + (parse-one-line line) + (do ((c code (1+ c))) + ((= c (char-code (char c1 0))) + (test-line c1 c2 c3 c4 c5) + (setf code (1+ c))) + (test-no-normalization (string (code-char code))))))) + ;; Part2: Canonical Order Test + (with-test (:name (:unicode-normalization :part2) + :skipped-on '(not :sb-unicode)) + (do ((line (read-line s) (read-line s))) + ((char= #\# (char line 0)) + (assert (string= "@Part3" (read-line s) :end2 6)) + (assert (char= #\# (char (read-line s) 0)))) + (destructuring-bind (c1 c2 c3 c4 c5) + (parse-one-line line) + (test-line c1 c2 c3 c4 c5)))) + ;; Part3: PRI #29 Test + (with-test (:name (:unicode-normalization :part3) + :skipped-on '(not :sb-unicode)) + (do ((line (read-line s) (read-line s))) + ((char= #\# (char line 0)) + (assert (char= #\# (char (read-line s) 0))) + (assert (null (read-line s nil nil)))) + (destructuring-bind (c1 c2 c3 c4 c5) + (parse-one-line line) + (test-line c1 c2 c3 c4 c5)))))) + +(test-normalization)