From: Ken Harris <kengruven@gmail.com>
Date: Thu, 13 Jun 2013 16:05:02 +0000 (-0700)
Subject: STRING<=
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=ba8e96ec1d0ab80c668fda471f2acb6ef55c5e61;p=jscl.git

STRING<=
---

diff --git a/src/string.lisp b/src/string.lisp
index c9267f0..ecfa070 100644
--- a/src/string.lisp
+++ b/src/string.lisp
@@ -96,9 +96,25 @@
                (when (and (= i (1- len-2)) (> len-1 len-2))  ;; ran off the end of s2
                  (return-from string> (+ start1 i 1))))))))
 
-;; TODO: string<=, string>=
-;; - mostly like string< / string>
-;; - if we run off the end of s1 and s2 at the same time, then it's =, so return len.
+(defun string<= (s1 s2 &key (start1 0) end1 (start2 0) end2)
+  (let* ((s1 (string s1))
+         (s2 (string s2))
+	 (end1 (or end1 (length s1)))
+	 (end2 (or end2 (length s2)))
+	 (len-1 (- end1 start1))
+	 (len-2 (- end2 start2)))
+    (dotimes (i len-1 end1)
+      (when (= i len-2)  ;; ran off the end of s2
+	(return-from string<= nil))
+      (when (char/= (char s1 (+ start1 i)) (char s2 (+ start2 i)))  ;; found a difference
+	(return-from string<=
+		     (if (char< (char s1 (+ start1 i)) (char s2 (+ start2 i)))
+			 (+ start1 i)
+		       nil)))
+      (when (and (= i (1- len-1)) (> len-2 len-1))  ;; ran off the end of s1
+	(return-from string<= (+ start1 i 1))))))
+
+;; TODO: string>=
 
 (define-setf-expander char (string index)
   (let ((g!string (gensym))
diff --git a/tests/strings.lisp b/tests/strings.lisp
index 43f1337..fd4b56e 100644
--- a/tests/strings.lisp
+++ b/tests/strings.lisp
@@ -375,36 +375,36 @@
 (test (= (string> #\z #\a) 0))
 
 
-;; (test (eql (string<= "" "") 0))
-;; (test (eql (string<= "dog" "dog") 3))
-;; (test (eql (string<= " " " ") 1))
-;; (test (not (string<= "abc" "")))
-;; (test (eql (string<= "ab" "abc") 2))
-;; (test (eql (string<= "aaa" "aba") 1))
-;; (test (not (string<= "aba" "aaa")))
-;; (test (eql (string<= "my cat food" "your dog food" :start1 6 :start2 8) 11))
-;; (test (eql (string<= "cat food 2 dollars" "dog food 3 dollars"
-;; 	       :start1 3 :end1 9 :start2 3 :end2 9) 9))
-;; (test (eql (string<= "xyzabc" "abcd" :start1 3) 6))
-;; (test (eql (string<= "abc" "abc" :end1 1) 1))
-;; (test (eql (string<= "xyzabc" "abc" :start1 3 :end1 5) 5))
-;; (test (eql (string<= "xyz" "abcxyzXYZ" :start2 3) 3))
-;; (test (eql (string<= "abc" "abcxyz" :end2 3) 3))
-;; (test (eql (string<= "xyz" "abcxyz" :end1 2 :start2 3) 2))
-;; (test (eql (string<= "xyzabc" "abcdef" :start1 3 :end2 3) 6))
-;; (test (eql (string<= "aaaa" "z") 0))
-;; (test (eql (string<= "pppTTTaTTTqqq" "pTTTxTTT" :start1 3 :start2 1) 6))
-;; (test (eql (string<= "pppTTTaTTTqqq" "pTTTxTTT"
-;; 	       :start1 6 :end1 7
-;; 	       :start2 4 :end2 5) 6))
+(test (eql (string<= "" "") 0))
+(test (eql (string<= "dog" "dog") 3))
+(test (eql (string<= " " " ") 1))
+(test (not (string<= "abc" "")))
+(test (eql (string<= "ab" "abc") 2))
+(test (eql (string<= "aaa" "aba") 1))
+(test (not (string<= "aba" "aaa")))
+(test (eql (string<= "my cat food" "your dog food" :start1 6 :start2 8) 11))
+(test (eql (string<= "cat food 2 dollars" "dog food 3 dollars"
+	       :start1 3 :end1 9 :start2 3 :end2 9) 9))
+(test (eql (string<= "xyzabc" "abcd" :start1 3) 6))
+(test (eql (string<= "abc" "abc" :end1 1) 1))
+(test (eql (string<= "xyzabc" "abc" :start1 3 :end1 5) 5))
+(test (eql (string<= "xyz" "abcxyzXYZ" :start2 3) 3))
+(test (eql (string<= "abc" "abcxyz" :end2 3) 3))
+(test (eql (string<= "xyz" "abcxyz" :end1 2 :start2 3) 2))
+(test (eql (string<= "xyzabc" "abcdef" :start1 3 :end2 3) 6))
+(test (eql (string<= "aaaa" "z") 0))
+(test (eql (string<= "pppTTTaTTTqqq" "pTTTxTTT" :start1 3 :start2 1) 6))
+(test (eql (string<= "pppTTTaTTTqqq" "pTTTxTTT"
+	       :start1 6 :end1 7
+	       :start2 4 :end2 5) 6))
 ;; (test (eql (string<= (make-array 0 :element-type 'character)
 ;; 	       (make-array 0 :element-type 'base-char)) 0))
-;; (test (not (string<= 'love 'hate)))
-;; (test (= (string<= 'peace 'war) 0))
-;; (test (= (string<= 'love 'love) 4))
-;; (test (= (string<= #\a #\a) 1))
-;; (test (= (string<= #\a #\b) 0))
-;; (test (not (string<= #\z #\a)))
+(test (not (string<= 'love 'hate)))
+(test (= (string<= 'peace 'war) 0))
+(test (= (string<= 'love 'love) 4))
+(test (= (string<= #\a #\a) 1))
+(test (= (string<= #\a #\b) 0))
+(test (not (string<= #\z #\a)))
 
 
 ;; (test (eql (string>= "" "") 0))