From 4c2dc0f0b5ae667d9bfcea7adcd68a701c968ff3 Mon Sep 17 00:00:00 2001
From: Kevin Ryde <user42@zip.com.au>
Date: Sat, 25 Feb 2006 20:42:13 +0000
Subject: [PATCH] =?UTF-8?q?(string<=3F,=20string-ci<=3F,=20string<=3D=3F,?=
 =?UTF-8?q?=20string-ci<=3D=3F,=20string>=3F,=20string-ci>=3F,=20string>?=
 =?UTF-8?q?=3D=3F,=20string-ci>=3D=3F):=20Check=20ordering=20is=20the=20sa?=
 =?UTF-8?q?me=20as=20char<=3F=20etc.=20=20Use=20a=20define-module=20to=20k?=
 =?UTF-8?q?eep=20private=20test=20bits=20private.?=

---
 test-suite/tests/strings.test | 97 +++++++++++++++++++++++++++++++++--
 1 file changed, 94 insertions(+), 3 deletions(-)

diff --git a/test-suite/tests/strings.test b/test-suite/tests/strings.test
index b57379903..aa9196e68 100644
--- a/test-suite/tests/strings.test
+++ b/test-suite/tests/strings.test
@@ -18,11 +18,22 @@
 ;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
 ;;;; Boston, MA 02110-1301 USA
 
-(use-modules (test-suite lib))
+(define-module (test-strings)
+  #:use-module (test-suite lib))
+
 
 (define exception:read-only-string
   (cons 'misc-error "^string is read-only"))
 
+;; Create a string from integer char values, eg. (string-ints 65) => "A"
+(define (string-ints . args)
+  (apply string (map integer->char args)))
+
+
+;;
+;; string=?
+;;
+
 (with-test-prefix "string=?"
 
   (pass-if "respects 1st parameter's string length"
@@ -41,6 +52,10 @@
       exception:wrong-type-arg
       (string=? "a" 'b))))
 
+;;
+;; string<?
+;;
+
 (with-test-prefix "string<?"
 
   (pass-if "respects string length"
@@ -55,7 +70,15 @@
 
     (pass-if-exception "2nd argument symbol"
       exception:wrong-type-arg
-      (string<? "a" 'b))))
+      (string<? "a" 'b)))
+
+  (pass-if "same as char<?"
+    (eq? (char<? (integer->char 0) (integer->char 255))
+	 (string<? (string-ints 0) (string-ints 255)))))
+
+;;
+;; string-ci<?
+;;
 
 (with-test-prefix "string-ci<?"
 
@@ -71,7 +94,75 @@
 
     (pass-if-exception "2nd argument symbol"
       exception:wrong-type-arg
-      (string-ci<? "a" 'b))))
+      (string-ci<? "a" 'b)))
+
+  (pass-if "same as char-ci<?"
+    (eq? (char-ci<? (integer->char 0) (integer->char 255))
+	 (string-ci<? (string-ints 0) (string-ints 255)))))
+
+;;
+;; string<=?
+;;
+
+(with-test-prefix "string<=?"
+
+  (pass-if "same as char<=?"
+    (eq? (char<=? (integer->char 0) (integer->char 255))
+	 (string<=? (string-ints 0) (string-ints 255)))))
+
+;;
+;; string-ci<=?
+;;
+
+(with-test-prefix "string-ci<=?"
+
+  (pass-if "same as char-ci<=?"
+    (eq? (char-ci<=? (integer->char 0) (integer->char 255))
+	 (string-ci<=? (string-ints 0) (string-ints 255)))))
+
+;;
+;; string>?
+;;
+
+(with-test-prefix "string>?"
+
+  (pass-if "same as char>?"
+    (eq? (char>? (integer->char 0) (integer->char 255))
+	 (string>? (string-ints 0) (string-ints 255)))))
+
+;;
+;; string-ci>?
+;;
+
+(with-test-prefix "string-ci>?"
+
+  (pass-if "same as char-ci>?"
+    (eq? (char-ci>? (integer->char 0) (integer->char 255))
+	 (string-ci>? (string-ints 0) (string-ints 255)))))
+
+;;
+;; string>=?
+;;
+
+(with-test-prefix "string>=?"
+
+  (pass-if "same as char>=?"
+    (eq? (char>=? (integer->char 0) (integer->char 255))
+	 (string>=? (string-ints 0) (string-ints 255)))))
+
+;;
+;; string-ci>=?
+;;
+
+(with-test-prefix "string-ci>=?"
+
+  (pass-if "same as char-ci>=?"
+    (eq? (char-ci>=? (integer->char 0) (integer->char 255))
+	 (string-ci>=? (string-ints 0) (string-ints 255)))))
+
+;;
+;; string-set!
+;;
 
 (with-test-prefix "string-set!"