From: Chris Hanson <org/chris-hanson/cph>
Date: Sun, 19 Feb 2017 01:42:53 +0000 (-0800)
Subject: Fix bugs exposed by unit tests.
X-Git-Tag: mit-scheme-pucked-9.2.12~220^2~70
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=530dc6efd35b3f9f15b1b17d3e44970499557c16;p=mit-scheme.git

Fix bugs exposed by unit tests.
---

diff --git a/src/runtime/ustring.scm b/src/runtime/ustring.scm
index b386579b3..3f2ada855 100644
--- a/src/runtime/ustring.scm
+++ b/src/runtime/ustring.scm
@@ -136,7 +136,7 @@ USA.
       (values string start end)))
 
 (define (register-ustring-predicates!)
-  (register-predicate! ustring? 'ustring)
+  (register-predicate! ustring? 'string)
   (register-predicate! legacy-string? 'legacy-string '<= ustring?)
   (register-predicate! full-string? 'full-string '<= ustring?)
   (register-predicate! slice? 'string-slice '<= ustring?)
@@ -263,16 +263,8 @@ USA.
 (define (ustring-tail string start)
   (ustring-copy string start))
 
-(define (%ustring=? string1 string2)
-  (and (fix:= (ustring-length string1) (ustring-length string2))
-       (ustring-every char=? string1 string2)))
-
-(define (%ustring-ci=? string1 string2)
-  (and (fix:= (ustring-length string1) (ustring-length string2))
-       (ustring-every char-ci=? string1 string2)))
-
 ;; Non-Unicode implementation, acceptable to R7RS.
-(define-integrable (%string-comparison-maker c= c<)
+(define-integrable (%string-comparison-maker c= c< f<)
   (lambda (string1 string2)
     (let ((end1 (ustring-length string1))
 	  (end2 (ustring-length string2)))
@@ -284,17 +276,24 @@ USA.
 		(if (c= c1 c2)
 		    (loop (fix:+ i 1))
 		    (c< c1 c2)))
-	      (fix:< end1 end2)))))))
+	      (f< end1 end2)))))))
 
-(define %ustring<? (%string-comparison-maker char=? char<?))
-(define %ustring<=? (%string-comparison-maker char=? char<=?))
-(define %ustring>? (%string-comparison-maker char=? char>?))
-(define %ustring>=? (%string-comparison-maker char=? char>=?))
+(define %ustring<? (%string-comparison-maker char=? char<? fix:<))
+(define %ustring<=? (%string-comparison-maker char=? char<=? fix:<=))
+(define %ustring=? (%string-comparison-maker char=? char=? fix:=))
+(define %ustring>? (%string-comparison-maker char=? char>? fix:>))
+(define %ustring>=? (%string-comparison-maker char=? char>=? fix:<=))
 
-(define %ustring-ci<? (%string-comparison-maker char-ci=? char-ci<?))
-(define %ustring-ci<=? (%string-comparison-maker char-ci=? char-ci<=?))
-(define %ustring-ci>? (%string-comparison-maker char-ci=? char-ci>?))
-(define %ustring-ci>=? (%string-comparison-maker char-ci=? char-ci>=?))
+(define-integrable (%string-ci-comparison-maker string-compare)
+  (lambda (string1 string2)
+    (string-compare (ustring-foldcase string1)
+		    (ustring-foldcase string2))))
+
+(define %ustring-ci<? (%string-ci-comparison-maker %ustring<?))
+(define %ustring-ci<=? (%string-ci-comparison-maker %ustring<=?))
+(define %ustring-ci=? (%string-ci-comparison-maker %ustring=?))
+(define %ustring-ci>? (%string-ci-comparison-maker %ustring>?))
+(define %ustring-ci>=? (%string-ci-comparison-maker %ustring>=?))
 
 (define-integrable (string-comparison-maker %compare)
   (lambda (string1 string2 . strings)