Make ir1-convert-hairy-lambda safe for non-local exits.

[sbcl.git] / tests / unicode-normalization.impure.lisp

diff --git a/tests/unicode-normalization.impure.lisp b/tests/unicode-normalization.impure.lisp
index 06d555f..7cd0fdd 100644 (file)
--- a/tests/unicode-normalization.impure.lisp
+++ b/tests/unicode-normalization.impure.lisp
@@ -17,12 +17,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 +35,6 @@
     (normalize-string c5 :nfd))
 
   ;; NFKC
-  #+nil
   (assert-all-string= c4
     (normalize-string c1 :nfkc)
     (normalize-string c2 :nfkc)
@@ -55,10 +52,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 +65,50 @@
          (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))
+      (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))
+      (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))
+      (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))
+      (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)