From 6122ae3ff7d0c631e7c20d6fcaf08749e3a83e32 Mon Sep 17 00:00:00 2001 From: Alex Shinn Date: Mon, 16 Apr 2012 23:18:22 +0900 Subject: [PATCH] adding (chibi strings) tests and bugfixes --- lib/chibi/strings.scm | 71 ++++++++++++++++++++++---------------- lib/chibi/strings.sld | 2 +- tests/string-tests.scm | 77 ++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 119 insertions(+), 31 deletions(-) create mode 100644 tests/string-tests.scm diff --git a/lib/chibi/strings.scm b/lib/chibi/strings.scm index b157ea3f..340a5d3c 100644 --- a/lib/chibi/strings.scm +++ b/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))) - (if (string-cursor>=? i end) - #t - (and (pred (string-cursor-ref str i)) - (lp (string-cursor-next str i))))))) + (and (string-cursor>? end (string-cursor-start str)) + (let lp ((i (string-cursor-start str))) + (let ((i2 (string-cursor-next str i)) + (ch (string-cursor-ref str i))) + (if (string-cursor>=? i2 end) + (pred ch) ;; tail call + (or (pred ch) (lp i2)))))))) -(define (string-any x str) - (not (string-every (complement (make-char-predicate x)) str))) +(define (string-every 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) - (car o) - (string-cursor-prev str (string-cursor-end str))))) - (cond ((string-cursor=? start end) + (list "") + (let lp ((i start) (n 1) (res '())) + (cond + ((>= n limit) + (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) " ")))) - (string-trim-right (string-trim-left str pred) pred))) + (let ((pred (make-char-predicate (if (pair? o) (car o) #\space)))) + (substring-cursor str + (string-skip str pred) + (string-skip-right str pred)))) (define (string-mismatch prefix str) (let ((end1 (string-cursor-end prefix)) diff --git a/lib/chibi/strings.sld b/lib/chibi/strings.sld index 86ea900e..890fc9fb 100644 --- a/lib/chibi/strings.sld +++ b/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)) diff --git a/tests/string-tests.scm b/tests/string-tests.scm new file mode 100644 index 00000000..c07e44e5 --- /dev/null +++ b/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)