From: Chris Hanson <org/chris-hanson/cph>
Date: Sun, 19 Mar 2017 20:20:31 +0000 (-0700)
Subject: D'oh!  String normalization tests were broken, which explains why they pass.
X-Git-Tag: mit-scheme-pucked-9.2.12~158^2~80
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=f10076f8ab79e71a40ad47f09a3aa1d246decfb3;p=mit-scheme.git

D'oh!  String normalization tests were broken, which explains why they pass.
---

diff --git a/tests/runtime/test-string-normalization.scm b/tests/runtime/test-string-normalization.scm
index 68eb58ad0..6387cc863 100644
--- a/tests/runtime/test-string-normalization.scm
+++ b/tests/runtime/test-string-normalization.scm
@@ -93709,18 +93709,31 @@ USA.
 (define (run-nfd-test tc)
   (with-test-properties
    (lambda ()
-     (assert (string->nfd (norm-tc-source tc))
-             (norm-tc-nfd tc))
-     (assert (string->nfd (norm-tc-nfc tc))
-             (norm-tc-nfd tc))
-     (assert (string->nfd (norm-tc-nfd tc))
-             (norm-tc-nfd tc))
-     (assert (string->nfd (norm-tc-nfkc tc))
-             (norm-tc-nfkd tc))
-     (assert (string->nfd (norm-tc-nfkd tc))
-             (norm-tc-nfkd tc)))
+     (assert-ts= (string->nfd (norm-tc-source tc))
+		 (norm-tc-nfd tc))
+     (assert-ts= (string->nfd (norm-tc-nfc tc))
+		 (norm-tc-nfd tc))
+     (assert-ts= (string->nfd (norm-tc-nfd tc))
+		 (norm-tc-nfd tc))
+     (assert-ts= (string->nfd (norm-tc-nfkc tc))
+		 (norm-tc-nfkd tc))
+     (assert-ts= (string->nfd (norm-tc-nfkd tc))
+		 (norm-tc-nfkd tc)))
    'expression `(nfd-test ,tc)))
 
+(define (trivial-string=? s1 s2)
+  (let ((n (string-length s1)))
+    (and (fix:= n (string-length s2))
+	 (let loop ((i 0))
+	   (if (fix:< i n)
+	       (and (char=? (string-ref s1 i)
+			    (string-ref s2 i))
+		    (loop (fix:+ i 1)))
+	       #t)))))
+
+(define-comparator trivial-string=? 'trivial-string=?)
+(define assert-ts= (simple-binary-assertion trivial-string=? #f))
+
 (define (norm-tc-source tc)
   (car tc))