From 685788d0234d2c1e50b620772eadfaaafcbf413b Mon Sep 17 00:00:00 2001 From: Kevin Ryde Date: Sat, 6 Aug 2005 01:48:37 +0000 Subject: [PATCH] (string-every, string-tabulate, string-trim, string-trim-right, string-trim-both, string-index, string-index-right, string-skip, string-skip-right, string-count, string-filter, string-delete, string-map, string-map!, string-for-each, string-for-each-index): Further tests, mainly to exercise new trampolines for proc calls. --- test-suite/tests/srfi-13.test | 261 +++++++++++++++++++++++++++++++++- 1 file changed, 255 insertions(+), 6 deletions(-) diff --git a/test-suite/tests/srfi-13.test b/test-suite/tests/srfi-13.test index f815ed8af..f0dd00f99 100644 --- a/test-suite/tests/srfi-13.test +++ b/test-suite/tests/srfi-13.test @@ -164,6 +164,14 @@ (with-test-prefix "string-every" + (with-test-prefix "bad char_pred" + + (pass-if-exception "integer" exception:wrong-type-arg + (string-every 123 "abcde")) + + (pass-if-exception "string" exception:wrong-type-arg + (string-every "zzz" "abcde"))) + (with-test-prefix "char" (pass-if "empty string" @@ -272,6 +280,14 @@ (with-test-prefix "string-tabulate" + (with-test-prefix "bad proc" + + (pass-if-exception "integer" exception:wrong-type-arg + (string-tabulate 123 10)) + + (pass-if-exception "string" exception:wrong-type-arg + (string-tabulate "zzz" 10))) + (pass-if "static fill-char" (string=? (string-tabulate (lambda (idx) #\!) 10) "!!!!!!!!!!")) @@ -515,6 +531,14 @@ (with-test-prefix "string-trim" + (with-test-prefix "bad char_pred" + + (pass-if-exception "integer" exception:wrong-type-arg + (string-trim "abcde" 123)) + + (pass-if-exception "string" exception:wrong-type-arg + (string-trim "abcde" "zzz"))) + (pass-if "empty string" (string=? "" (string-trim ""))) @@ -541,6 +565,14 @@ (with-test-prefix "string-trim-right" + (with-test-prefix "bad char_pred" + + (pass-if-exception "integer" exception:wrong-type-arg + (string-trim-right "abcde" 123)) + + (pass-if-exception "string" exception:wrong-type-arg + (string-trim-right "abcde" "zzz"))) + (pass-if "empty string" (string=? "" (string-trim-right ""))) @@ -567,6 +599,14 @@ (with-test-prefix "string-trim-both" + (with-test-prefix "bad char_pred" + + (pass-if-exception "integer" exception:wrong-type-arg + (string-trim-both "abcde" 123)) + + (pass-if-exception "string" exception:wrong-type-arg + (string-trim-both "abcde" "zzz"))) + (pass-if "empty string" (string=? "" (string-trim-both ""))) @@ -710,6 +750,14 @@ (with-test-prefix "string-index" + (with-test-prefix "bad char_pred" + + (pass-if-exception "integer" exception:wrong-type-arg + (string-index "abcde" 123)) + + (pass-if-exception "string" exception:wrong-type-arg + (string-index "abcde" "zzz"))) + (pass-if "empty string - char" (not (string-index "" #\a))) @@ -801,6 +849,14 @@ (with-test-prefix "string-index-right" + (with-test-prefix "bad char_pred" + + (pass-if-exception "integer" exception:wrong-type-arg + (string-index-right "abcde" 123)) + + (pass-if-exception "string" exception:wrong-type-arg + (string-index-right "abcde" "zzz"))) + (pass-if "empty string - char" (not (string-index-right "" #\a))) @@ -884,6 +940,14 @@ (with-test-prefix "string-skip" + (with-test-prefix "bad char_pred" + + (pass-if-exception "integer" exception:wrong-type-arg + (string-skip "abcde" 123)) + + (pass-if-exception "string" exception:wrong-type-arg + (string-skip "abcde" "zzz"))) + (pass-if "empty string - char" (not (string-skip "" #\a))) @@ -967,6 +1031,14 @@ (with-test-prefix "string-skip-right" + (with-test-prefix "bad char_pred" + + (pass-if-exception "integer" exception:wrong-type-arg + (string-skip-right "abcde" 123)) + + (pass-if-exception "string" exception:wrong-type-arg + (string-skip-right "abcde" "zzz"))) + (pass-if "empty string - char" (not (string-skip-right "" #\a))) @@ -1048,6 +1120,75 @@ (pass-if "non-empty - pred - no match - start and end index" (= 4 (string-skip-right "frobnicate" char-numeric? 2 5)))) +;; +;; string-count +;; + +(with-test-prefix "string-count" + + (with-test-prefix "bad char_pred" + + (pass-if-exception "integer" exception:wrong-type-arg + (string-count "abcde" 123)) + + (pass-if-exception "string" exception:wrong-type-arg + (string-count "abcde" "zzz"))) + + (with-test-prefix "char" + + (pass-if (eqv? 0 (string-count "" #\a))) + (pass-if (eqv? 0 (string-count "-" #\a))) + (pass-if (eqv? 1 (string-count "a" #\a))) + (pass-if (eqv? 0 (string-count "--" #\a))) + (pass-if (eqv? 1 (string-count "a-" #\a))) + (pass-if (eqv? 1 (string-count "-a" #\a))) + (pass-if (eqv? 2 (string-count "aa" #\a))) + (pass-if (eqv? 0 (string-count "---" #\a))) + (pass-if (eqv? 1 (string-count "-a-" #\a))) + (pass-if (eqv? 1 (string-count "a--" #\a))) + (pass-if (eqv? 2 (string-count "aa-" #\a))) + (pass-if (eqv? 2 (string-count "a-a" #\a))) + (pass-if (eqv? 3 (string-count "aaa" #\a))) + (pass-if (eqv? 1 (string-count "--a" #\a))) + (pass-if (eqv? 2 (string-count "-aa" #\a)))) + + (with-test-prefix "charset" + + (pass-if (eqv? 0 (string-count "" char-set:letter))) + (pass-if (eqv? 0 (string-count "-" char-set:letter))) + (pass-if (eqv? 1 (string-count "a" char-set:letter))) + (pass-if (eqv? 0 (string-count "--" char-set:letter))) + (pass-if (eqv? 1 (string-count "a-" char-set:letter))) + (pass-if (eqv? 1 (string-count "-a" char-set:letter))) + (pass-if (eqv? 2 (string-count "aa" char-set:letter))) + (pass-if (eqv? 0 (string-count "---" char-set:letter))) + (pass-if (eqv? 1 (string-count "-a-" char-set:letter))) + (pass-if (eqv? 1 (string-count "a--" char-set:letter))) + (pass-if (eqv? 2 (string-count "aa-" char-set:letter))) + (pass-if (eqv? 2 (string-count "a-a" char-set:letter))) + (pass-if (eqv? 3 (string-count "aaa" char-set:letter))) + (pass-if (eqv? 1 (string-count "--a" char-set:letter))) + (pass-if (eqv? 2 (string-count "-aa" char-set:letter)))) + + (with-test-prefix "proc" + + (pass-if (eqv? 0 (string-count "" char-alphabetic?))) + (pass-if (eqv? 0 (string-count "-" char-alphabetic?))) + (pass-if (eqv? 1 (string-count "a" char-alphabetic?))) + (pass-if (eqv? 0 (string-count "--" char-alphabetic?))) + (pass-if (eqv? 1 (string-count "a-" char-alphabetic?))) + (pass-if (eqv? 1 (string-count "-a" char-alphabetic?))) + (pass-if (eqv? 2 (string-count "aa" char-alphabetic?))) + (pass-if (eqv? 0 (string-count "---" char-alphabetic?))) + (pass-if (eqv? 1 (string-count "-a-" char-alphabetic?))) + (pass-if (eqv? 1 (string-count "a--" char-alphabetic?))) + (pass-if (eqv? 2 (string-count "aa-" char-alphabetic?))) + (pass-if (eqv? 2 (string-count "a-a" char-alphabetic?))) + (pass-if (eqv? 3 (string-count "aaa" char-alphabetic?))) + (pass-if (eqv? 1 (string-count "--a" char-alphabetic?))) + (pass-if (eqv? 2 (string-count "-aa" char-alphabetic?))))) + + (with-test-prefix "string-replace" (pass-if "empty string(s), no indices" @@ -1111,10 +1252,10 @@ (with-test-prefix "bad char_pred" (pass-if-exception "integer" exception:wrong-type-arg - (string-filter 123 "abcde")) + (string-filter "abcde" 123)) (pass-if-exception "string" exception:wrong-type-arg - (string-filter "zzz" "abcde"))) + (string-filter "abcde" "zzz"))) (pass-if "empty string, char" (string=? "" (string-filter "" #\.))) @@ -1163,7 +1304,19 @@ (pass-if (equal? "xx" (string-filter "xxx" #\x 1))) (pass-if (equal? "xx" (string-filter "xxx" #\x 0 2))) (pass-if (equal? "x" (string-filter "xyx" #\x 1))) - (pass-if (equal? "x" (string-filter "yxx" #\x 0 2)))) + (pass-if (equal? "x" (string-filter "yxx" #\x 0 2))) + + ;; leading and trailing removals + (pass-if (string=? "" (string-filter "." #\x))) + (pass-if (string=? "" (string-filter ".." #\x))) + (pass-if (string=? "" (string-filter "..." #\x))) + (pass-if (string=? "x" (string-filter ".x" #\x))) + (pass-if (string=? "x" (string-filter "..x" #\x))) + (pass-if (string=? "x" (string-filter "...x" #\x))) + (pass-if (string=? "x" (string-filter "x." #\x))) + (pass-if (string=? "x" (string-filter "x.." #\x))) + (pass-if (string=? "x" (string-filter "x..." #\x))) + (pass-if (string=? "x" (string-filter "...x..." #\x)))) (with-test-prefix "charset" @@ -1177,7 +1330,19 @@ (pass-if (equal? "yx" (string-filter "xyx" charset 1))) (pass-if (equal? "xy" (string-filter "xyx" charset 0 2))) (pass-if (equal? "x" (string-filter "xax" charset 1))) - (pass-if (equal? "x" (string-filter "axx" charset 0 2)))))) + (pass-if (equal? "x" (string-filter "axx" charset 0 2)))) + + ;; leading and trailing removals + (pass-if (string=? "" (string-filter "." char-set:letter))) + (pass-if (string=? "" (string-filter ".." char-set:letter))) + (pass-if (string=? "" (string-filter "..." char-set:letter))) + (pass-if (string=? "x" (string-filter ".x" char-set:letter))) + (pass-if (string=? "x" (string-filter "..x" char-set:letter))) + (pass-if (string=? "x" (string-filter "...x" char-set:letter))) + (pass-if (string=? "x" (string-filter "x." char-set:letter))) + (pass-if (string=? "x" (string-filter "x.." char-set:letter))) + (pass-if (string=? "x" (string-filter "x..." char-set:letter))) + (pass-if (string=? "x" (string-filter "...x..." char-set:letter))))) ;;; ;;; string-delete @@ -1185,6 +1350,14 @@ (with-test-prefix "string-delete" + (with-test-prefix "bad char_pred" + + (pass-if-exception "integer" exception:wrong-type-arg + (string-delete "abcde" 123)) + + (pass-if-exception "string" exception:wrong-type-arg + (string-delete "abcde" "zzz"))) + (pass-if "empty string, char" (string=? "" (string-delete "" #\.))) @@ -1219,10 +1392,43 @@ (string=? "oo" (string-delete ".foo.bar." char-set:punctuation 2 4))) (pass-if "pred, start and end index" - (string=? "" (string-delete ".foo.bar." char-alphabetic? 2 4)))) + (string=? "" (string-delete ".foo.bar." char-alphabetic? 2 4))) + + ;; leading and trailing removals + (pass-if (string=? "" (string-delete "." #\.))) + (pass-if (string=? "" (string-delete ".." #\.))) + (pass-if (string=? "" (string-delete "..." #\.))) + (pass-if (string=? "x" (string-delete ".x" #\.))) + (pass-if (string=? "x" (string-delete "..x" #\.))) + (pass-if (string=? "x" (string-delete "...x" #\.))) + (pass-if (string=? "x" (string-delete "x." #\.))) + (pass-if (string=? "x" (string-delete "x.." #\.))) + (pass-if (string=? "x" (string-delete "x..." #\.))) + (pass-if (string=? "x" (string-delete "...x..." #\.))) + + ;; leading and trailing removals + (pass-if (string=? "" (string-delete "." char-set:punctuation))) + (pass-if (string=? "" (string-delete ".." char-set:punctuation))) + (pass-if (string=? "" (string-delete "..." char-set:punctuation))) + (pass-if (string=? "x" (string-delete ".x" char-set:punctuation))) + (pass-if (string=? "x" (string-delete "..x" char-set:punctuation))) + (pass-if (string=? "x" (string-delete "...x" char-set:punctuation))) + (pass-if (string=? "x" (string-delete "x." char-set:punctuation))) + (pass-if (string=? "x" (string-delete "x.." char-set:punctuation))) + (pass-if (string=? "x" (string-delete "x..." char-set:punctuation))) + (pass-if (string=? "x" (string-delete "...x..." char-set:punctuation)))) + (with-test-prefix "string-map" + (with-test-prefix "bad proc" + + (pass-if-exception "integer" exception:wrong-type-arg + (string-map 123 "abcde")) + + (pass-if-exception "string" exception:wrong-type-arg + (string-map "zzz" "abcde"))) + (pass-if "constant" (string=? "xxx" (string-map (lambda (c) #\x) "foo"))) @@ -1232,15 +1438,58 @@ (pass-if "upcase" (string=? "FOO" (string-map char-upcase "foo")))) +(with-test-prefix "string-map!" + + (with-test-prefix "bad proc" + + (pass-if-exception "integer" exception:wrong-type-arg + (string-map 123 "abcde")) + + (pass-if-exception "string" exception:wrong-type-arg + (string-map "zzz" "abcde"))) + + (pass-if "constant" + (let ((str (string-copy "foo"))) + (string-map! (lambda (c) #\x) str) + (string=? str "xxx"))) + + (pass-if "identity" + (let ((str (string-copy "foo"))) + (string-map! identity str) + (string=? str "foo"))) + + (pass-if "upcase" + (let ((str (string-copy "foo"))) + (string-map! char-upcase str) + (string=? str "FOO")))) + (with-test-prefix "string-for-each" + (with-test-prefix "bad proc" + + (pass-if-exception "integer" exception:wrong-type-arg + (string-for-each 123 "abcde")) + + (pass-if-exception "string" exception:wrong-type-arg + (string-for-each "zzz" "abcde"))) + (pass-if "copy" (let* ((foo "foo") (bar (make-string (string-length foo))) (i 0)) (string-for-each (lambda (c) (string-set! bar i c) (set! i (1+ i))) foo) - (string=? foo bar))) + (string=? foo bar)))) + +(with-test-prefix "string-for-each-index" + + (with-test-prefix "bad proc" + + (pass-if-exception "integer" exception:wrong-type-arg + (string-for-each-index 123 "abcde")) + + (pass-if-exception "string" exception:wrong-type-arg + (string-for-each-index "zzz" "abcde"))) (pass-if "index" (let* ((foo "foo")