adding (chibi strings) tests and bugfixes

lib/chibi/strings.scm

@@ -13,67 +13,78 @@
 
 (define (complement pred) (lambda (x) (not (pred x))))
 
-(define (string-every x str)
+(define (string-any x str)
   (let ((pred (make-char-predicate x))
         (end (string-cursor-end str)))
-    (let lp ((i (string-cursor-start str)))
+    (and (string-cursor>? end (string-cursor-start str))
-      (if (string-cursor>=? i end)
+         (let lp ((i (string-cursor-start str)))
-          #t
+           (let ((i2 (string-cursor-next str i))
-          (and (pred (string-cursor-ref str i))
+                 (ch (string-cursor-ref str i)))
-               (lp (string-cursor-next str i)))))))
+             (if (string-cursor>=? i2 end)
+                 (pred ch)  ;; tail call
+                 (or (pred ch) (lp i2))))))))
 
-(define (string-any x str)
+(define (string-every x str)
-  (not (string-every (complement (make-char-predicate x)) str)))
+  (not (string-any (complement (make-char-predicate x)) str)))
 
-(define (string-index str x . o)
+(define (string-find str x . o)
   (let ((pred (make-char-predicate x))
         (end (string-cursor-end str)))
     (let lp ((i (if (pair? o) (car o) (string-cursor-start str))))
-      (cond ((string-cursor>=? i end) #f)
+      (cond ((string-cursor>=? i end) end)
             ((pred (string-ref str i)) i)
             (else (lp (string-cursor-next str i)))))))
 
-(define (string-index-right str x . o)
+(define (string-find-right str x . o)
   (let ((pred (make-char-predicate x))
         (end (string-cursor-start str)))
-    (let lp ((i (if (pair? o)
+    (let lp ((i (if (pair? o) (car o) (string-cursor-end str))))
-                    (car o)
+      (let ((i2 (string-cursor-prev str i)))
-                    (string-cursor-prev str (string-cursor-end str)))))
+        (cond ((string-cursor<? i2 end) end)
-      (cond ((string-cursor<? i end) #f)
+              ((pred (string-ref str i2)) i)
-            ((pred (string-ref str i)) i)
+              (else (lp i2)))))))
-            (else (lp (string-cursor-prev str i)))))))
 
 (define (string-skip str x . o)
-  (apply string-index (complement (make-char-predicate x)) o))
+  (apply string-find str (complement (make-char-predicate x)) o))
 
 (define (string-skip-right str x . o)
-  (apply string-index-right (complement (make-char-predicate x)) o))
+  (apply string-find-right str (complement (make-char-predicate x)) o))
 
 (define string-join string-concatenate)
 
 (define (string-split str . o)
-  (let ((pred (make-char-predicate (if (pair? o) (car o) " ")))
+  (let ((pred (make-char-predicate (if (pair? o) (car o) #\space)))
+        (limit (if (and (pair? o) (pair? (cdr o))) (cadr o) (string-size str)))
+        (start (string-cursor-start str))
         (end (string-cursor-end str)))
-    (let lp ((i (string-cursor-start str)) (res '()))
+    (if (string-cursor>=? start end)
-      (let ((j (string-index str pred i)))
+        (list "")
-        (if j
+        (let lp ((i start) (n 1) (res '()))
-            (lp (string-cursor-next str j)
+          (cond
-                (cons (substring-cursor str i j) res))
+           ((>= n limit)
-            (reverse (cons (substring-cursor str i end) res)))))))
+            (reverse (cons (substring-cursor str i) res)))
+           (else
+            (let* ((j (string-find str pred i))
+                   (res (cons (substring-cursor str i j) res)))
+              (if (string-cursor>=? j end)
+                  (reverse res)
+                  (lp (string-cursor-next str j) (+ n 1) res)))))))))
 
 (define (string-trim-left str . o)
-  (let ((pred (make-char-predicate (if (pair? o) (car o) " "))))
+  (let ((pred (make-char-predicate (if (pair? o) (car o) #\space))))
     (substring-cursor str (string-skip str pred))))
 
 (define (string-trim-right str . o)
-  (let ((pred (make-char-predicate (if (pair? o) (car o) " "))))
+  (let ((pred (make-char-predicate (if (pair? o) (car o) #\space))))
     (substring-cursor str
                       (string-cursor-start str)
                       (string-skip-right str pred))))
 
 (define (string-trim str . o)
-  (let ((pred (make-char-predicate (if (pair? o) (car o) " "))))
+  (let ((pred (make-char-predicate (if (pair? o) (car o) #\space))))
-    (string-trim-right (string-trim-left str pred) pred)))
+    (substring-cursor str
+                      (string-skip str pred)
+                      (string-skip-right str pred))))
 
 (define (string-mismatch prefix str)
   (let ((end1 (string-cursor-end prefix))

lib/chibi/strings.sld

@@ -8,7 +8,7 @@
    string-trim string-trim-left string-trim-right
    string-mismatch string-mismatch-right
    string-prefix? string-suffix?
-   string-index string-index-right string-skip string-skip-right
+   string-find string-find-right string-skip string-skip-right
    string-fold string-fold-right string-map string-for-each
    string-contains make-string-searcher)
   (import (scheme) (chibi ast))

tests/string-tests.scm

@@ -0,0 +1,77 @@
+
+(cond-expand
+ (modules (import (only (chibi test) test-begin test test-end)
+                  (chibi strings)))
+ (else #f))
+
+(test-begin "strings")
+
+(test #t (string-null? ""))
+(test #f (string-null? " "))
+
+(test #t (string-every char-alphabetic? "abc"))
+(test #f (string-every char-alphabetic? "abc0"))
+(test #f (string-every char-alphabetic? " abc"))
+(test #f (string-every char-alphabetic? "a.c"))
+
+(define (digit-value ch)
+  (case ch
+    ((#\0) 0) ((#\1) 1) ((#\2) 2) ((#\3) 3) ((#\4) 4)
+    ((#\5) 5) ((#\6) 6) ((#\7) 7) ((#\8) 8) ((#\9) 9) (else #f)))
+
+(test 3 (string-any digit-value "a3c"))
+(test #f (string-any digit-value "abc"))
+
+(test 0 (string-find "abc" char-alphabetic?))
+(test 3 (string-find "abc0" char-numeric?))
+(test 3 (string-find "abc" char-numeric?))
+
+(test 3 (string-find-right "abc" char-alphabetic?))
+(test 4 (string-find-right "abc0" char-numeric?))
+(test 0 (string-find-right "abc" char-numeric?))
+
+(test 0 (string-skip "abc" char-numeric?))
+(test 3 (string-skip "abc0" char-alphabetic?))
+(test 3 (string-skip "abc" char-alphabetic?))
+
+(test 3 (string-skip-right "abc" char-numeric?))
+(test 4 (string-skip-right "abc0" char-alphabetic?))
+(test 0 (string-skip-right "abc" char-alphabetic?))
+
+(test "foobarbaz" (string-join '("foo" "bar" "baz")))
+(test "foo bar baz" (string-join '("foo" "bar" "baz") " "))
+
+(test '("") (string-split ""))
+(test '("foo" "bar" "baz") (string-split "foo bar baz"))
+(test '("foo" "bar" "baz") (string-split "foo:bar:baz" #\:))
+(test '("" "foo" "bar" "baz") (string-split ":foo:bar:baz" #\:))
+(test '("foo" "bar" "baz" "") (string-split "foo:bar:baz:" #\:))
+(test '("foo" "bar:baz") (string-split "foo:bar:baz" #\: 2))
+
+(test "abc" (string-trim-left "  abc"))
+(test "abc  " (string-trim-left "abc  "))
+(test "abc  " (string-trim-left "  abc  "))
+
+(test "  abc" (string-trim-right "  abc"))
+(test "abc" (string-trim-right "abc  "))
+(test "  abc" (string-trim-right "  abc  "))
+
+(test "abc" (string-trim "  abc"))
+(test "abc" (string-trim "abc  "))
+(test "abc" (string-trim "  abc  "))
+
+(test #t (string-prefix? "abc" "abc"))
+(test #t (string-prefix? "abc" "abcde"))
+(test #f (string-prefix? "abcde" "abc"))
+
+(test #t (string-suffix? "abc" "abc"))
+(test #f (string-suffix? "abc" "abcde"))
+(test #f (string-suffix? "abcde" "abc"))
+(test #f (string-suffix? "abcde" "cde"))
+(test #t (string-suffix? "cde" "abcde"))
+
+(test 3 (string-count "!a0 bc /.," char-alphabetic?))
+
+(test "ABC" (string-map char-upcase "abc"))
+
+(test-end)