additional string-cursor fixes for snow

lib/chibi/snow/fort.scm

@@ -19,7 +19,7 @@
 
 (define (extract-snowball-package bv)
   (define (path-top path)
-    (substring path (string-cursor-start path) (string-find path #\/)))
+    (substring-cursor path (string-cursor-start path) (string-find path #\/)))
   (guard (exn
           (else
            (log-error "couldn't extract package.scm: " exn)

lib/chibi/string-test.sld

@@ -79,15 +79,15 @@
       (test "" (string-trim " "))
       (test "" (string-trim "  "))
 
-      ;; (test #t (string-prefix? "abc" "abc"))
+      (test #t (string-prefix? "abc" "abc"))
-      ;; (test #t (string-prefix? "abc" "abcde"))
+      (test #t (string-prefix? "abc" "abcde"))
-      ;; (test #f (string-prefix? "abcde" "abc"))
+      (test #f (string-prefix? "abcde" "abc"))
 
-      ;; (test #t (string-suffix? "abc" "abc"))
+      (test #t (string-suffix? "abc" "abc"))
-      ;; (test #f (string-suffix? "abc" "abcde"))
+      (test #f (string-suffix? "abc" "abcde"))
-      ;; (test #f (string-suffix? "abcde" "abc"))
+      (test #f (string-suffix? "abcde" "abc"))
-      ;; (test #f (string-suffix? "abcde" "cde"))
+      (test #f (string-suffix? "abcde" "cde"))
-      ;; (test #t (string-suffix? "cde" "abcde"))
+      (test #t (string-suffix? "cde" "abcde"))
 
       (test 3 (string-count "!a0 bc /.," char-alphabetic?))
 

lib/chibi/string.scm

@@ -198,11 +198,14 @@
 ;;> Returns true iff \var{suffix} is a suffix of \var{str}.
 
 (define (string-suffix? suffix str)
-  (string-cursor=? (string-cursor-prev suffix (string-cursor-start suffix))
+  (let ((diff (- (string-size str) (string-size suffix))))
-                   (string-cursor-back
+    (and (>= diff 0)
-                    str
+         (string-cursor=? (string-cursor-prev suffix
-                    (string-mismatch-right suffix str)
+                                              (string-cursor-start suffix))
-                    (- (string-size str) (string-size suffix)))))
+                          (string-cursor-back
+                           str
+                           (string-mismatch-right suffix str)
+                           diff)))))
 
 ;;> The fundamental string iterator.  Calls \var{kons} on each
 ;;> character of \var{str} and an accumulator, starting with
@@ -323,14 +326,14 @@
 ;;> the cursor \var{i}.
 
 (define (string-cursor-forward str cursor n)
-  (if (zero? n)
+  (if (positive? n)
-      cursor
+      (string-cursor-forward str (string-cursor-next str cursor) (- n 1))
-      (string-cursor-forward str (string-cursor-next str cursor) (- n 1))))
+      cursor))
 
 (define (string-cursor-back str cursor n)
-  (if (zero? n)
+  (if (positive? n)
-      cursor
+      (string-cursor-back str (string-cursor-prev str cursor) (- n 1))
-      (string-cursor-back str (string-cursor-prev str cursor) (- n 1))))
+      cursor))
 
 ;;> \procedure{(string-cursor<? i j)}
 ;;> \procedure{(string-cursor>? i j)}

lib/chibi/tar.scm

@@ -97,7 +97,7 @@
 ;; not a tar-bomb and no absolute paths
 (define (tar-safe? tarball)
   (define (path-top path)
-    (substring path 0 (string-find path #\/)))
+    (substring-cursor path (string-cursor-start path) (string-find path #\/)))
   (let ((files (map path-normalize (tar-files tarball))))
     (and (every path-relative? files)
          (or (< (length files) 2)

lib/chibi/uri.scm

@@ -350,7 +350,7 @@
             (uri-with-path
              (uri-with-fragment (uri-with-query uri #f) #f)
              (path-resolve path
-                           (if (string-suffix? (uri-path uri) "/")
+                           (if (string-suffix? "/" (uri-path uri))
                                (uri-path uri)
                                (path-directory (uri-path uri)))))
             (path-resolve path orig-uri)))))