more srfi 130 tests and fixes

lib/srfi/130.scm

@@ -52,8 +52,10 @@
        (if (null? str-ls)
            (error "string-join 'strict-infix called on an empty list")
            (%string-join str-ls sep)))
-      ((prefix) (%string-join (cons "" str-ls) sep))
+      ((prefix)
-      ((suffix) (string-append (%string-join str-ls sep) sep))
+       (if (null? str-ls) "" (%string-join (cons "" str-ls) sep)))
+      ((suffix)
+       (if (null? str-ls) "" (string-append (%string-join str-ls sep) sep)))
       (else (error "unknown string-join grammar" grammar)))))
 
 (define (string-ref/cursor str x)
@@ -149,13 +151,16 @@
   (apply string-find-right str pred (cursor-args str o)))
 
 (define (string-contains s1 s2 . o)
-  (let ((start1 (if (pair? o) (car o) (string-cursor-start s1)))
+  (let ((start1 (cursor-arg s1 (if (pair? o) (car o) (string-cursor-start s1))))
-        (end1 (if (and (pair? o) (pair? (cdr o)))
+        (end1 (cursor-arg s1 (if (and (pair? o) (pair? (cdr o)))
                                  (cadr o)
-                  (string-cursor-end s1)))
+                                 (string-cursor-end s1))))
         (s2 (if (and (pair? o) (pair? (cdr o))) (string-arg s2 (cddr o)) s2)))
     (let ((res (%string-contains s1 s2 start1)))
-      (and res (string-cursor<=? res end1) res))))
+      (and res
+           (string-cursor<=? (string-cursor-forward s1 res (string-length s2))
+                             end1)
+           res))))
 
 (define (string-contains-right s1 s2 . o)
   (let* ((start1
@@ -241,28 +246,26 @@
   (let* ((delim-len (string-length delim))
          (grammar (if (pair? o) (car o) 'infix))
          (o (if (pair? o) (cdr o) '()))
-         (limit (and (pair? o) (cadr o)))
+         (limit (or (and (pair? o) (car o)) (string-length str)))
          (o (if (pair? o) (cdr o) '()))
-         (start (if (pair? o) (car o) (string-cursor-start str)))
+         (start (cursor-arg str
-         (end (if (and (pair? o) (pair? (cdr o)))
+                            (if (pair? o) (car o) (string-cursor-start str))))
+         (end (cursor-arg str (if (and (pair? o) (pair? (cdr o)))
                                   (cadr o)
-                  (string-cursor-end str))))
+                                  (string-cursor-end str)))))
-    (define (trim-for-grammar res for-grammer)
-      (if (and (eq? grammar for-grammer) (pair? res) (equal? "" (car res)))
-          (cdr res)
-          res))
     (if (and (eq? grammar 'strict-infix) (string-cursor>=? start end))
         (error "string-split 'strict-infix called on an empty string"))
-    (let lp ((sc start) (res '()))
+    (let lp ((sc start) (i 0) (res '()))
       (cond
        ((string-cursor>=? sc end)
-        (trim-for-grammar (reverse (trim-for-grammar res 'suffix)) 'prefix))
+        (reverse res))
-       ((string-contains str delim sc end)
+       ((and (< i limit) (string-contains str delim sc end))
         => (lambda (sc2)
              (lp (string-cursor-forward str sc2 delim-len)
+                 (+ i 1)
                  (cons (substring-cursor str sc sc2) res))))
        (else
-        (lp end (cons (substring-cursor str sc end) res)))))))
+        (lp end i (cons (substring-cursor str sc end) res)))))))
 
 (define (string-split-right str delim . o)
   #f)

lib/srfi/130/test.sld

@@ -4,6 +4,8 @@
           (chibi char-set) (chibi char-set full) (chibi test)
           (srfi 130))
   (begin
+    (define (sc str c)
+      (string-index->cursor str c))
     (define (string-index->index str pred . o)
       (string-cursor->index str (apply string-index str pred o)))
     (define (string-index-right->index str pred . o)
@@ -147,10 +149,17 @@
         (string-count "abc def\tghi jkl" char-whitespace? 4))
       (test "string-count #4" 1
         (string-count "abc def\tghi jkl" char-whitespace? 4 9))
+      (let ((s "Ma mere l'oye"))
         (test-assert "string-contains"
-        (string-contains "Ma mere l'oye" "mer"))
+          (string-contains s "mer"))
         (test "string-contains" #f
-        (string-contains "Ma mere l'oye" "Mer"))
+          (string-contains s "Mer"))
+        (test-assert "string-contains"
+          (string-contains s "mer" 1 8))
+        (test-not "string-contains"
+          (string-contains s "mer" 4 8))
+        (test-not "string-contains"
+          (string-contains s "mer" 1 5)))
       (let ((s "eek -- it's a geek."))
         (test 15 (string-cursor->index s (string-contains-right s "ee")))
         (test 15 (string-cursor->index s (string-contains-right s "ee" 12 18)))
@@ -332,6 +341,27 @@
       (test "string-remove" ""
         (string-remove (lambda (c) (char-lower-case? c)) ""))
 
+      (test "foo:bar:baz"
+          (string-join '("foo" "bar" "baz") ":"))
+      (test "foo:bar:baz:"
+          (string-join '("foo" "bar" "baz") ":" 'suffix))
+      (test "" (string-join '() ":"))
+      (test "" (string-join '("") ":"))
+      (test "" (string-join '() ":" 'suffix))
+      (test ":" (string-join '("") ":" 'suffix))
+
+      (test '("foo" "bar" "baz")
+          (string-split "foo:bar:baz" ":"))
+      (test '("foo" "bar" "baz")
+          (string-split "foo:bar:baz:" ":" 'suffix))
+      (test '("foo" "bar:baz:")
+          (string-split "foo:bar:baz:" ":" 'suffix 1))
+      (test '("foo" "bar" "baz:")
+          (string-split "foo:bar:baz:" ":" 'suffix 2))
+      (test '() (string-split "" ":"))
+      (test '() (string-split "" ":" 'suffix))
+      (test '("") (string-split ":" ":" 'suffix))
+
       ;;; Regression tests: check that reported bugs have been fixed
 
       ;; From: Matthias Radestock <matthias@sorted.org>