From 9398d91d7eb36c049b07f11836ea11db5adcdb34 Mon Sep 17 00:00:00 2001
From: Ken Harris <kengruven@gmail.com>
Date: Thu, 13 Jun 2013 10:24:02 -0700
Subject: [PATCH] Case-insensitive character inequalities.

---
 src/string.lisp    |   28 ++++--
 tests/strings.lisp |  277 ++++++++++++++++++++++++++--------------------------
 2 files changed, 158 insertions(+), 147 deletions(-)

diff --git a/src/string.lisp b/src/string.lisp
index 91ab8c3..adfb9aa 100644
--- a/src/string.lisp
+++ b/src/string.lisp
@@ -85,23 +85,35 @@
 
 (defun string< (s1 s2 &key (start1 0) end1 (start2 0) end2)
   (compare-strings s1 s2 start1 end1 start2 end2
-		   #'char= #'char>
-		   nil t nil))
+		   #'char= #'char> nil t nil))
 
 (defun string> (s1 s2 &key (start1 0) end1 (start2 0) end2)
   (compare-strings s1 s2 start1 end1 start2 end2
-		   #'char= #'char<
-		   nil nil t))
+		   #'char= #'char< nil nil t))
 
 (defun string<= (s1 s2 &key (start1 0) end1 (start2 0) end2)
   (compare-strings s1 s2 start1 end1 start2 end2
-		   #'char= #'char>
-		   t t nil))
+		   #'char= #'char> t t nil))
   
 (defun string>= (s1 s2 &key (start1 0) end1 (start2 0) end2)
   (compare-strings s1 s2 start1 end1 start2 end2
-		   #'char= #'char<
-		   t nil t))
+		   #'char= #'char< t nil t))
+
+(defun string-lessp (s1 s2 &key (start1 0) end1 (start2 0) end2)
+  (compare-strings s1 s2 start1 end1 start2 end2
+		   #'char-equal #'char-greaterp nil t nil))
+
+(defun string-greaterp (s1 s2 &key (start1 0) end1 (start2 0) end2)
+  (compare-strings s1 s2 start1 end1 start2 end2
+		   #'char-equal #'char-lessp nil nil t))
+
+(defun string-not-greaterp (s1 s2 &key (start1 0) end1 (start2 0) end2)
+  (compare-strings s1 s2 start1 end1 start2 end2
+		   #'char-equal #'char-greaterp t t nil))
+
+(defun string-not-lessp (s1 s2 &key (start1 0) end1 (start2 0) end2)
+  (compare-strings s1 s2 start1 end1 start2 end2
+		   #'char-equal #'char-lessp t nil t))
 
 (define-setf-expander char (string index)
   (let ((g!string (gensym))
diff --git a/tests/strings.lisp b/tests/strings.lisp
index ccfc5e5..da13f35 100644
--- a/tests/strings.lisp
+++ b/tests/strings.lisp
@@ -130,7 +130,7 @@
 (test (string= (string-capitalize "pipe 13a, foo16c") "Pipe 13a, Foo16c"))
 (test (string= (string-capitalize "a fool" :start 2 :end nil) "a Fool"))
 
-;; JSCL HACK: a simple COPY-SEQ for testing string functions, since we don't have a real one yet
+;; JSCL HACK: a simple COPY-SEQ for testing string functions, since we don't have a real one yet -- remove me
 (defun copy-seq (string)
   (let ((copy (make-string (length string))))
     (dotimes (i (length string) copy)
@@ -254,12 +254,11 @@
 (test (string= "abcd" "01234abcd9012" :start2 5 :end2 9))
 (test (eql (string< "aaaa" "aaab") 3))
 (test (eql (string>= "aaaaa" "aaaa") 4))
-;; JSCL: STRING-NOT-GREATERP doesn't exist yet, disabling:
-;; (test (eql (string-not-greaterp "Abcde" "abcdE") 5))
-;; (test (eql (string-lessp "012AAAA789" "01aaab6"
-;; 		   :start1 3 :end1 7
-;; 		   :start2 2 :end2 6) 6))
-;; (test (not (string-not-equal "AAAA" "aaaA")))
+(test (eql (string-not-greaterp "Abcde" "abcdE") 5))
+(test (eql (string-lessp "012AAAA789" "01aaab6"
+		   :start1 3 :end1 7
+		   :start2 2 :end2 6) 6))
+(test (not (string-not-equal "AAAA" "aaaA")))
 
 
 (test (string= "" ""))
@@ -494,146 +493,146 @@
 (test (= (string-not-equal #\z #\a) 0))
 
 
-;; (test (not (string-lessp "" "")))
-;; (test (not (string-lessp "dog" "dog")))
-;; (test (not (string-lessp " " " ")))
-;; (test (not (string-lessp "abc" "")))
-;; (test (eql (string-lessp "" "abc") 0))
-;; (test (eql (string-lessp "ab" "abc") 2))
-;; (test (not (string-lessp "abc" "ab")))
-;; (test (eql (string-lessp "aaa" "aba") 1))
-;; (test (not (string-lessp "aba" "aaa")))
-;; (test (not (string-lessp "my cat food" "your dog food" :start1 6 :start2 8)))
-;; (test (not (string-lessp "cat food 2 dollars" "dog food 3 dollars"
-;; 		   :start1 3 :end1 9 :start2 3 :end2 9)))
-;; (test (eql (string-lessp "xyzabc" "abcd" :start1 3) 6))
-;; (test (eql (string-lessp "abc" "abc" :end1 1) 1))
-;; (test (eql (string-lessp "xyzabc" "abc" :start1 3 :end1 5) 5))
-;; (test (eql (string-lessp "xyz" "abcxyzXYZ" :start2 3) 3))
-;; (test (not (string-lessp "abc" "abcxyz" :end2 3)))
-;; (test (eql (string-lessp "xyz" "abcxyz" :end1 2 :start2 3) 2))
-;; (test (not (string-lessp "xyzabc" "abcdef" :start1 3 :end2 3)))
-;; (test (eql (string-lessp "aaaa" "z") 0))
-;; (test (eql (string-lessp "pppTTTaTTTqqq" "pTTTxTTT" :start1 3 :start2 1) 6))
-;; (test (eql (string-lessp "pppTTTaTTTqqq" "pTTTxTTT"
-;; 		   :start1 6 :end1 7
-;; 		   :start2 4 :end2 5) 6))
+(test (not (string-lessp "" "")))
+(test (not (string-lessp "dog" "dog")))
+(test (not (string-lessp " " " ")))
+(test (not (string-lessp "abc" "")))
+(test (eql (string-lessp "" "abc") 0))
+(test (eql (string-lessp "ab" "abc") 2))
+(test (not (string-lessp "abc" "ab")))
+(test (eql (string-lessp "aaa" "aba") 1))
+(test (not (string-lessp "aba" "aaa")))
+(test (not (string-lessp "my cat food" "your dog food" :start1 6 :start2 8)))
+(test (not (string-lessp "cat food 2 dollars" "dog food 3 dollars"
+		   :start1 3 :end1 9 :start2 3 :end2 9)))
+(test (eql (string-lessp "xyzabc" "abcd" :start1 3) 6))
+(test (eql (string-lessp "abc" "abc" :end1 1) 1))
+(test (eql (string-lessp "xyzabc" "abc" :start1 3 :end1 5) 5))
+(test (eql (string-lessp "xyz" "abcxyzXYZ" :start2 3) 3))
+(test (not (string-lessp "abc" "abcxyz" :end2 3)))
+(test (eql (string-lessp "xyz" "abcxyz" :end1 2 :start2 3) 2))
+(test (not (string-lessp "xyzabc" "abcdef" :start1 3 :end2 3)))
+(test (eql (string-lessp "aaaa" "z") 0))
+(test (eql (string-lessp "pppTTTaTTTqqq" "pTTTxTTT" :start1 3 :start2 1) 6))
+(test (eql (string-lessp "pppTTTaTTTqqq" "pTTTxTTT"
+		   :start1 6 :end1 7
+		   :start2 4 :end2 5) 6))
 ;; (test (not (string-lessp (make-array 0 :element-type 'character)
 ;; 		   (make-array 0 :element-type 'base-char))))
-;; (test (and (not (string-lessp "abc" "ABC"))
-;;      (not (string-lessp "ABC" "abc"))))
-;; (test (not (string-lessp 'love 'hate)))
-;; (test (= (string-lessp 'peace 'war) 0))
-;; (test (not (string-lessp 'love 'love)))
-;; (test (not (string-lessp #\a #\a)))
-;; (test (= (string-lessp #\a #\b) 0))
-;; (test (not (string-lessp #\z #\a)))
-
-
-;; (test (not (string-greaterp "" "")))
-;; (test (not (string-greaterp "dog" "dog")))
-;; (test (not (string-greaterp " " " ")))
-;; (test (eql (string-greaterp "abc" "") 0))
-;; (test (not (string-greaterp "" "abc")))
-;; (test (not (string-greaterp "ab" "abc")))
-;; (test (eql (string-greaterp "abc" "ab") 2))
-;; (test (eql (string-greaterp "aba" "aaa") 1))
-;; (test (not (string-greaterp "aaa" "aba")))
-;; (test (not (string-greaterp "my cat food" "your dog food" :start1 6 :start2 8)))
-;; (test (not (string-greaterp "cat food 2 dollars" "dog food 3 dollars"
-;; 		      :start1 3 :end1 9 :start2 3 :end2 9)))
-;; (test (eql (string-greaterp "xyzabcde" "abcd" :start1 3) 7))
-;; (test (not (string-greaterp "abc" "abc" :end1 1)))
-;; (test (eql (string-greaterp "xyzabc" "a" :start1 3 :end1 5) 4))
-;; (test (eql (string-greaterp "xyzXYZ" "abcxyz" :start2 3) 3))
-;; (test (eql (string-greaterp "abcxyz" "abcxyz" :end2 3) 3))
-;; (test (not (string-greaterp "xyzXYZ" "abcxyz" :end1 2 :start2 3)))
-;; (test (not (string-greaterp "xyzabc" "abcdef" :start1 3 :end2 3)))
-;; (test (eql (string-greaterp "z" "aaaa") 0))
-;; (test (eql (string-greaterp "pTTTxTTTqqq" "pppTTTaTTT" :start1 1 :start2 3) 4))
-;; (test (eql (string-greaterp "pppTTTxTTTqqq" "pTTTaTTT"
-;; 		      :start1 6 :end1 7
-;; 		      :start2 4 :end2 5) 6))
+(test (and (not (string-lessp "abc" "ABC"))
+     (not (string-lessp "ABC" "abc"))))
+(test (not (string-lessp 'love 'hate)))
+(test (= (string-lessp 'peace 'war) 0))
+(test (not (string-lessp 'love 'love)))
+(test (not (string-lessp #\a #\a)))
+(test (= (string-lessp #\a #\b) 0))
+(test (not (string-lessp #\z #\a)))
+
+
+(test (not (string-greaterp "" "")))
+(test (not (string-greaterp "dog" "dog")))
+(test (not (string-greaterp " " " ")))
+(test (eql (string-greaterp "abc" "") 0))
+(test (not (string-greaterp "" "abc")))
+(test (not (string-greaterp "ab" "abc")))
+(test (eql (string-greaterp "abc" "ab") 2))
+(test (eql (string-greaterp "aba" "aaa") 1))
+(test (not (string-greaterp "aaa" "aba")))
+(test (not (string-greaterp "my cat food" "your dog food" :start1 6 :start2 8)))
+(test (not (string-greaterp "cat food 2 dollars" "dog food 3 dollars"
+		      :start1 3 :end1 9 :start2 3 :end2 9)))
+(test (eql (string-greaterp "xyzabcde" "abcd" :start1 3) 7))
+(test (not (string-greaterp "abc" "abc" :end1 1)))
+(test (eql (string-greaterp "xyzabc" "a" :start1 3 :end1 5) 4))
+(test (eql (string-greaterp "xyzXYZ" "abcxyz" :start2 3) 3))
+(test (eql (string-greaterp "abcxyz" "abcxyz" :end2 3) 3))
+(test (not (string-greaterp "xyzXYZ" "abcxyz" :end1 2 :start2 3)))
+(test (not (string-greaterp "xyzabc" "abcdef" :start1 3 :end2 3)))
+(test (eql (string-greaterp "z" "aaaa") 0))
+(test (eql (string-greaterp "pTTTxTTTqqq" "pppTTTaTTT" :start1 1 :start2 3) 4))
+(test (eql (string-greaterp "pppTTTxTTTqqq" "pTTTaTTT"
+		      :start1 6 :end1 7
+		      :start2 4 :end2 5) 6))
 ;; (test (not (string-greaterp (make-array 0 :element-type 'character)
 ;; 		      (make-array 0 :element-type 'base-char))))
-;; (test (and (not (string-greaterp "abc" "ABC"))
-;;      (not (string-greaterp "ABC" "abc"))))
-;; (test (= (string-greaterp 'love 'hate) 0))
-;; (test (not (string-greaterp 'peace 'war)))
-;; (test (not (string-greaterp 'love 'love)))
-;; (test (not (string-greaterp #\a #\a)))
-;; (test (not (string-greaterp #\a #\b)))
-;; (test (= (string-greaterp #\z #\a) 0))
-
-
-;; (test (eql (string-not-greaterp "" "") 0))
-;; (test (eql (string-not-greaterp "dog" "dog") 3))
-;; (test (eql (string-not-greaterp " " " ") 1))
-;; (test (not (string-not-greaterp "abc" "")))
-;; (test (eql (string-not-greaterp "ab" "abc") 2))
-;; (test (eql (string-not-greaterp "aaa" "aba") 1))
-;; (test (not (string-not-greaterp "aba" "aaa")))
-;; (test (eql (string-not-greaterp "my cat food" "your dog food" :start1 6 :start2 8) 11))
-;; (test (eql (string-not-greaterp "cat food 2 dollars" "dog food 3 dollars"
-;; 			  :start1 3 :end1 9 :start2 3 :end2 9) 9))
-;; (test (eql (string-not-greaterp "xyzabc" "abcd" :start1 3) 6))
-;; (test (eql (string-not-greaterp "abc" "abc" :end1 1) 1))
-;; (test (eql (string-not-greaterp "xyzabc" "abc" :start1 3 :end1 5) 5))
-;; (test (eql (string-not-greaterp "xyz" "abcxyzXYZ" :start2 3) 3))
-;; (test (eql (string-not-greaterp "abc" "abcxyz" :end2 3) 3))
-;; (test (eql (string-not-greaterp "xyz" "abcxyz" :end1 2 :start2 3) 2))
-;; (test (eql (string-not-greaterp "xyzabc" "abcdef" :start1 3 :end2 3) 6))
-;; (test (eql (string-not-greaterp "aaaa" "z") 0))
-;; (test (eql (string-not-greaterp "pppTTTaTTTqqq" "pTTTxTTT" :start1 3 :start2 1) 6))
-;; (test (eql (string-not-greaterp "pppTTTaTTTqqq" "pTTTxTTT"
-;; 			  :start1 6 :end1 7
-;; 			  :start2 4 :end2 5) 6))
+(test (and (not (string-greaterp "abc" "ABC"))
+     (not (string-greaterp "ABC" "abc"))))
+(test (= (string-greaterp 'love 'hate) 0))
+(test (not (string-greaterp 'peace 'war)))
+(test (not (string-greaterp 'love 'love)))
+(test (not (string-greaterp #\a #\a)))
+(test (not (string-greaterp #\a #\b)))
+(test (= (string-greaterp #\z #\a) 0))
+
+
+(test (eql (string-not-greaterp "" "") 0))
+(test (eql (string-not-greaterp "dog" "dog") 3))
+(test (eql (string-not-greaterp " " " ") 1))
+(test (not (string-not-greaterp "abc" "")))
+(test (eql (string-not-greaterp "ab" "abc") 2))
+(test (eql (string-not-greaterp "aaa" "aba") 1))
+(test (not (string-not-greaterp "aba" "aaa")))
+(test (eql (string-not-greaterp "my cat food" "your dog food" :start1 6 :start2 8) 11))
+(test (eql (string-not-greaterp "cat food 2 dollars" "dog food 3 dollars"
+			  :start1 3 :end1 9 :start2 3 :end2 9) 9))
+(test (eql (string-not-greaterp "xyzabc" "abcd" :start1 3) 6))
+(test (eql (string-not-greaterp "abc" "abc" :end1 1) 1))
+(test (eql (string-not-greaterp "xyzabc" "abc" :start1 3 :end1 5) 5))
+(test (eql (string-not-greaterp "xyz" "abcxyzXYZ" :start2 3) 3))
+(test (eql (string-not-greaterp "abc" "abcxyz" :end2 3) 3))
+(test (eql (string-not-greaterp "xyz" "abcxyz" :end1 2 :start2 3) 2))
+(test (eql (string-not-greaterp "xyzabc" "abcdef" :start1 3 :end2 3) 6))
+(test (eql (string-not-greaterp "aaaa" "z") 0))
+(test (eql (string-not-greaterp "pppTTTaTTTqqq" "pTTTxTTT" :start1 3 :start2 1) 6))
+(test (eql (string-not-greaterp "pppTTTaTTTqqq" "pTTTxTTT"
+			  :start1 6 :end1 7
+			  :start2 4 :end2 5) 6))
 ;; (test (eql (string-not-greaterp (make-array 0 :element-type 'character)
 ;; 			  (make-array 0 :element-type 'base-char)) 0))
-;; (test (and (eql (string-not-greaterp "abc" "ABC") 3)
-;;      (eql (string-not-greaterp "ABC" "abc") 3)))
-;; (test (not (string-not-greaterp 'love 'hate)))
-;; (test (= (string-not-greaterp 'peace 'war) 0))
-;; (test (= (string-not-greaterp 'love 'love) 4))
-;; (test (= (string-not-greaterp #\a #\a) 1))
-;; (test (= (string-not-greaterp #\a #\b) 0))
-;; (test (not (string-not-greaterp #\z #\a)))
-
-
-;; (test (eql (string-not-lessp "" "") 0))
-;; (test (eql (string-not-lessp "dog" "dog") 3))
-;; (test (eql (string-not-lessp " " " ") 1))
-;; (test (eql (string-not-lessp "abc" "") 0))
-;; (test (not (string-not-lessp "" "abc")))
-;; (test (not (string-not-lessp "ab" "abc")))
-;; (test (eql (string-not-lessp "abc" "ab") 2))
-;; (test (eql (string-not-lessp "aba" "aaa") 1))
-;; (test (not (string-not-lessp "aaa" "aba")))
-;; (test (eql (string-not-lessp "my cat food" "your dog food" :start1 6 :start2 8) 11))
-;; (test (eql (string-not-lessp "cat food 2 dollars" "dog food 3 dollars"
-;; 		       :start1 3 :end1 9 :start2 3 :end2 9) 9))
-;; (test (eql (string-not-lessp "xyzabcde" "abcd" :start1 3) 7))
-;; (test (not (string-not-lessp "abc" "abc" :end1 1)))
-;; (test (eql (string-not-lessp "xyzabc" "a" :start1 3 :end1 5) 4))
-;; (test (eql (string-not-lessp "xyzXYZ" "abcxyz" :start2 3) 3))
-;; (test (eql (string-not-lessp "abcxyz" "abcxyz" :end2 3) 3))
-;; (test (not (string-not-lessp "xyzXYZ" "abcxyz" :end1 2 :start2 3)))
-;; (test (eql (string-not-lessp "xyzabc" "abcdef" :start1 3 :end2 3) 6))
-;; (test (eql (string-not-lessp "z" "aaaa") 0))
-;; (test (eql (string-not-lessp "pTTTxTTTqqq" "pppTTTaTTT" :start1 1 :start2 3) 4))
-;; (test (eql (string-not-lessp "pppTTTxTTTqqq" "pTTTaTTT"
-;; 		       :start1 6 :end1 7
-;; 		       :start2 4 :end2 5) 6))
+(test (and (eql (string-not-greaterp "abc" "ABC") 3)
+     (eql (string-not-greaterp "ABC" "abc") 3)))
+(test (not (string-not-greaterp 'love 'hate)))
+(test (= (string-not-greaterp 'peace 'war) 0))
+(test (= (string-not-greaterp 'love 'love) 4))
+(test (= (string-not-greaterp #\a #\a) 1))
+(test (= (string-not-greaterp #\a #\b) 0))
+(test (not (string-not-greaterp #\z #\a)))
+
+
+(test (eql (string-not-lessp "" "") 0))
+(test (eql (string-not-lessp "dog" "dog") 3))
+(test (eql (string-not-lessp " " " ") 1))
+(test (eql (string-not-lessp "abc" "") 0))
+(test (not (string-not-lessp "" "abc")))
+(test (not (string-not-lessp "ab" "abc")))
+(test (eql (string-not-lessp "abc" "ab") 2))
+(test (eql (string-not-lessp "aba" "aaa") 1))
+(test (not (string-not-lessp "aaa" "aba")))
+(test (eql (string-not-lessp "my cat food" "your dog food" :start1 6 :start2 8) 11))
+(test (eql (string-not-lessp "cat food 2 dollars" "dog food 3 dollars"
+		       :start1 3 :end1 9 :start2 3 :end2 9) 9))
+(test (eql (string-not-lessp "xyzabcde" "abcd" :start1 3) 7))
+(test (not (string-not-lessp "abc" "abc" :end1 1)))
+(test (eql (string-not-lessp "xyzabc" "a" :start1 3 :end1 5) 4))
+(test (eql (string-not-lessp "xyzXYZ" "abcxyz" :start2 3) 3))
+(test (eql (string-not-lessp "abcxyz" "abcxyz" :end2 3) 3))
+(test (not (string-not-lessp "xyzXYZ" "abcxyz" :end1 2 :start2 3)))
+(test (eql (string-not-lessp "xyzabc" "abcdef" :start1 3 :end2 3) 6))
+(test (eql (string-not-lessp "z" "aaaa") 0))
+(test (eql (string-not-lessp "pTTTxTTTqqq" "pppTTTaTTT" :start1 1 :start2 3) 4))
+(test (eql (string-not-lessp "pppTTTxTTTqqq" "pTTTaTTT"
+		       :start1 6 :end1 7
+		       :start2 4 :end2 5) 6))
 ;; (test (eql (string-not-lessp (make-array 0 :element-type 'character)
 ;; 		       (make-array 0 :element-type 'base-char)) 0))
-;; (test (and (eql (string-not-lessp "abc" "ABC") 3)
-;;      (eql (string-not-lessp "ABC" "abc") 3)))
-;; (test (= (string-not-lessp 'love 'hate) 0))
-;; (test (not (string-not-lessp 'peace 'war)))
-;; (test (= (string-not-lessp 'love 'love) 4))
-;; (test (= (string-not-lessp #\a #\a) 1))
-;; (test (not (string-not-lessp #\a #\b)))
-;; (test (= (string-not-lessp #\z #\a) 0))
+(test (and (eql (string-not-lessp "abc" "ABC") 3)
+     (eql (string-not-lessp "ABC" "abc") 3)))
+(test (= (string-not-lessp 'love 'hate) 0))
+(test (not (string-not-lessp 'peace 'war)))
+(test (= (string-not-lessp 'love 'love) 4))
+(test (= (string-not-lessp #\a #\a) 1))
+(test (not (string-not-lessp #\a #\b)))
+(test (= (string-not-lessp #\z #\a) 0))
 
 
 
-- 
1.7.10.4