From f764e6d10d8b52c4febdfd866fe2b27c943ec1d6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Martin=20Grabm=C3=BCller?= Date: Thu, 10 May 2001 13:52:27 +0000 Subject: [PATCH] * tests/srfi-10.test: New file. * tests/srfi-9.test: New file. * tests/srfi-13.test: Added some more tests. --- test-suite/ChangeLog | 8 ++ test-suite/tests/srfi-10.test | 30 ++++ test-suite/tests/srfi-13.test | 256 +++++++++++++++++++++++++++++++++- test-suite/tests/srfi-9.test | 42 ++++++ 4 files changed, 335 insertions(+), 1 deletion(-) create mode 100644 test-suite/tests/srfi-10.test create mode 100644 test-suite/tests/srfi-9.test diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog index 78a12684b..d588caf13 100644 --- a/test-suite/ChangeLog +++ b/test-suite/ChangeLog @@ -1,3 +1,11 @@ +2001-05-10 Martin Grabmueller + + * tests/srfi-10.test: New file. + + * tests/srfi-9.test: New file. + + * tests/srfi-13.test: Added some more tests. + 2001-05-09 Thien-Thi Nguyen * tests/eval.test: ("evaluator" "memoization"): New test diff --git a/test-suite/tests/srfi-10.test b/test-suite/tests/srfi-10.test new file mode 100644 index 000000000..28caf3ad3 --- /dev/null +++ b/test-suite/tests/srfi-10.test @@ -0,0 +1,30 @@ +;;;; srfi-10.test --- Test suite for Guile's SRFI-10 functions. -*- scheme -*- +;;;; Martin Grabmueller, 2001-05-10 +;;;; +;;;; Copyright (C) 2001 Free Software Foundation, Inc. +;;;; +;;;; This program is free software; you can redistribute it and/or modify +;;;; it under the terms of the GNU General Public License as published by +;;;; the Free Software Foundation; either version 2, or (at your option) +;;;; any later version. +;;;; +;;;; This program is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;;; GNU General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU General Public License +;;;; along with this software; see the file COPYING. If not, write to +;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330, +;;;; Boston, MA 02111-1307 USA + +(use-modules (srfi srfi-10)) + +(define-reader-ctor 'rx make-regexp) + +(with-test-prefix "hash-comma read extension" + + (pass-if "basic feature" + (let* ((rx #,(rx "^foo$"))) + (and (->bool (regexp-exec rx "foo")) + (not (regexp-exec rx "bar foo frob")))))) diff --git a/test-suite/tests/srfi-13.test b/test-suite/tests/srfi-13.test index 2cc0295a5..ec60836cd 100644 --- a/test-suite/tests/srfi-13.test +++ b/test-suite/tests/srfi-13.test @@ -18,7 +18,7 @@ ;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330, ;;;; Boston, MA 02111-1307 USA -(use-modules (srfi srfi-13)) +(use-modules (srfi srfi-13) (srfi srfi-14)) ;;; This kludge is needed, because SRFI-13 redefines some bindings in ;;; the core. @@ -95,6 +95,7 @@ (string=? (string-tabulate (lambda (idx) (integer->char (+ idx 32))) 10) " !\"#$%&'()"))) +;; Get the procedure from the library. (define string->list (module-peek '(srfi srfi-13) 'string->list)) (with-test-prefix "string->list" @@ -200,6 +201,7 @@ (string=? "foo|delim|bar|delim|" (string-join '("foo" "bar") "|delim|" 'suffix)))) +;; Get the procedure from the library. (define string-copy (module-peek '(srfi srfi-13) 'string-copy)) (with-test-prefix "string-copy" @@ -333,3 +335,255 @@ (pass-if "freestyle 2" (string=? "532!" (string-pad-right (number->string 532) 4 #\!)))) +(with-test-prefix "string-trim" + + (pass-if "empty string" + (string=? "" (string-trim ""))) + + (pass-if "no char/pred" + (string=? "foo " (string-trim " \tfoo "))) + + (pass-if "start index, pred" + (string=? "foo " (string-trim " \tfoo " char-whitespace? 1))) + + (pass-if "start and end index, pred" + (string=? "f" (string-trim " \tfoo " char-whitespace? 1 3))) + + (pass-if "start index, char" + (string=? "\tfoo " (string-trim " \tfoo " #\space 1))) + + (pass-if "start and end index, char" + (string=? "\tf" (string-trim " \tfoo " #\space 1 3))) + + (pass-if "start index, charset" + (string=? "foo " (string-trim " \tfoo " char-set:whitespace 1))) + + (pass-if "start and end index, charset" + (string=? "f" (string-trim " \tfoo " char-set:whitespace 1 3)))) + +(with-test-prefix "string-trim-right" + + (pass-if "empty string" + (string=? "" (string-trim-right ""))) + + (pass-if "no char/pred" + (string=? " \tfoo" (string-trim-right " \tfoo "))) + + (pass-if "start index, pred" + (string=? "\tfoo" (string-trim-right " \tfoo " char-whitespace? 1))) + + (pass-if "start and end index, pred" + (string=? "\tf" (string-trim-right " \tfoo " char-whitespace? 1 3))) + + (pass-if "start index, char" + (string=? "\tfoo" (string-trim-right " \tfoo " #\space 1))) + + (pass-if "start and end index, char" + (string=? "\tf" (string-trim-right " \tfoo " #\space 1 3))) + + (pass-if "start index, charset" + (string=? "\tfoo" (string-trim-right " \tfoo " char-set:whitespace 1))) + + (pass-if "start and end index, charset" + (string=? "\tf" (string-trim-right " \tfoo " char-set:whitespace 1 3)))) + +(with-test-prefix "string-trim-both" + + (pass-if "empty string" + (string=? "" (string-trim-both ""))) + + (pass-if "no char/pred" + (string=? "foo" (string-trim-both " \tfoo "))) + + (pass-if "start index, pred" + (string=? "foo" (string-trim-both " \tfoo " char-whitespace? 1))) + + (pass-if "start and end index, pred" + (string=? "f" (string-trim-both " \tfoo " char-whitespace? 1 3))) + + (pass-if "start index, char" + (string=? "\tfoo" (string-trim-both " \tfoo " #\space 1))) + + (pass-if "start and end index, char" + (string=? "\tf" (string-trim-both " \tfoo " #\space 1 3))) + + (pass-if "start index, charset" + (string=? "foo" (string-trim-both " \tfoo " char-set:whitespace 1))) + + (pass-if "start and end index, charset" + (string=? "f" (string-trim-both " \tfoo " char-set:whitespace 1 3)))) + +;; Get the procedure from the library. +(define string-fill! (module-peek '(srfi srfi-13) 'string-fill!)) + +(define s0 (make-string 200 #\!)) +(define s1 (make-string 0 #\!)) + +(with-test-prefix "string-fill!" + + (pass-if "empty string, no indices" + (string-fill! s1 #\*) + (= (string-length s1) 0)) + + (pass-if "empty string, start index" + (string-fill! s1 #\* 0) + (= (string-length s1) 0)) + + (pass-if "empty string, start and end index" + (string-fill! s1 #\* 0 0) + (= (string-length s1) 0)) + + (pass-if "no indices" + (string-fill! s0 #\*) + (char=? (string-ref s0 0) #\*)) + + (pass-if "start index" + (string-fill! s0 #\+ 10) + (char=? (string-ref s0 11) #\+)) + + (pass-if "start and end index" + (string-fill! s0 #\| 12 20) + (char=? (string-ref s0 13) #\|))) + +(with-test-prefix "string-replace" + + (pass-if "empty string(s), no indices" + (string=? "" (string-replace "" ""))) + + (pass-if "empty string(s), 1 index" + (string=? "" (string-replace "" "" 0))) + + (pass-if "empty string(s), 2 indices" + (string=? "" (string-replace "" "" 0 0))) + + (pass-if "empty string(s), 3 indices" + (string=? "" (string-replace "" "" 0 0 0))) + + (pass-if "empty string(s), 4 indices" + (string=? "" (string-replace "" "" 0 0 0 0))) + + (pass-if "no indices" + (string=? "uu" (string-replace "foo bar" "uu"))) + + (pass-if "one index" + (string=? "fuu" (string-replace "foo bar" "uu" 1))) + + (pass-if "two indices" + (string=? "fuuar" (string-replace "foo bar" "uu" 1 5))) + + (pass-if "three indices" + (string=? "fuar" (string-replace "foo bar" "uu" 1 5 1))) + + (pass-if "four indices" + (string=? "fuar" (string-replace "foo bar" "uu" 1 5 1 2)))) + +(with-test-prefix "string-tokenize" + + (pass-if "empty string, no char/pred" + (zero? (length (string-tokenize "")))) + + (pass-if "empty string, char" + (zero? (length (string-tokenize "" #\.)))) + + (pass-if "empty string, charset" + (zero? (length (string-tokenize "" char-set:punctuation)))) + + (pass-if "no char/pred" + (equal? '("foo" "bar" "!a") (string-tokenize "foo\tbar !a"))) + + (pass-if "char" + (equal? '("foo:bar" "!a") (string-tokenize "foo:bar.!a" #\.))) + + (pass-if "charset" + (equal? '("foo" "bar" "a") (string-tokenize "foo:bar.!a" + char-set:punctuation))) + + (pass-if "char, start index" + (equal? '("oo:bar" "!a") (string-tokenize "foo:bar.!a" #\. 1))) + + (pass-if "charset, start index" + (equal? '("oo" "bar" "a") (string-tokenize "foo:bar.!a" + char-set:punctuation 1))) + + (pass-if "char, start and end index" + (equal? '("oo:bar" "!") (string-tokenize "foo:bar.!a" #\. 1 9))) + + (pass-if "charset, start and end index" + (equal? '("oo" "bar") (string-tokenize "foo:bar.!a" + char-set:punctuation 1 9)))) + +(with-test-prefix "string-filter" + + (pass-if "empty string, char" + (string=? "" (string-filter "" #\.))) + + (pass-if "empty string, charset" + (string=? "" (string-filter "" char-set:punctuation))) + + (pass-if "empty string, pred" + (string=? "" (string-filter "" char-alphabetic?))) + + (pass-if "char" + (string=? "..." (string-filter ".foo.bar." #\.))) + + (pass-if "charset" + (string=? "..." (string-filter ".foo.bar." char-set:punctuation))) + + (pass-if "pred" + (string=? "foobar" (string-filter ".foo.bar." char-alphabetic?))) + + (pass-if "char, start index" + (string=? ".." (string-filter ".foo.bar." #\. 2))) + + (pass-if "charset, start index" + (string=? ".." (string-filter ".foo.bar." char-set:punctuation 2))) + + (pass-if "pred, start index" + (string=? "oobar" (string-filter ".foo.bar." char-alphabetic? 2))) + + (pass-if "char, start and end index" + (string=? "" (string-filter ".foo.bar." #\. 2 4))) + + (pass-if "charset, start and end index" + (string=? "" (string-filter ".foo.bar." char-set:punctuation 2 4))) + + (pass-if "pred, start and end index" + (string=? "oo" (string-filter ".foo.bar." char-alphabetic? 2 4)))) + +(with-test-prefix "string-delete" + + (pass-if "empty string, char" + (string=? "" (string-delete "" #\.))) + + (pass-if "empty string, charset" + (string=? "" (string-delete "" char-set:punctuation))) + + (pass-if "empty string, pred" + (string=? "" (string-delete "" char-alphabetic?))) + + (pass-if "char" + (string=? "foobar" (string-delete ".foo.bar." #\.))) + + (pass-if "charset" + (string=? "foobar" (string-delete ".foo.bar." char-set:punctuation))) + + (pass-if "pred" + (string=? "..." (string-delete ".foo.bar." char-alphabetic?))) + + (pass-if "char, start index" + (string=? "oobar" (string-delete ".foo.bar." #\. 2))) + + (pass-if "charset, start index" + (string=? "oobar" (string-delete ".foo.bar." char-set:punctuation 2))) + + (pass-if "pred, start index" + (string=? ".." (string-delete ".foo.bar." char-alphabetic? 2))) + + (pass-if "char, start and end index" + (string=? "oo" (string-delete ".foo.bar." #\. 2 4))) + + (pass-if "charset, start and end index" + (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)))) diff --git a/test-suite/tests/srfi-9.test b/test-suite/tests/srfi-9.test new file mode 100644 index 000000000..da33d5488 --- /dev/null +++ b/test-suite/tests/srfi-9.test @@ -0,0 +1,42 @@ +;;;; srfi-9.test --- Test suite for Guile's SRFI-9 functions. -*- scheme -*- +;;;; Martin Grabmueller, 2001-05-10 +;;;; +;;;; Copyright (C) 2001 Free Software Foundation, Inc. +;;;; +;;;; This program is free software; you can redistribute it and/or modify +;;;; it under the terms of the GNU General Public License as published by +;;;; the Free Software Foundation; either version 2, or (at your option) +;;;; any later version. +;;;; +;;;; This program is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;;; GNU General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU General Public License +;;;; along with this software; see the file COPYING. If not, write to +;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330, +;;;; Boston, MA 02111-1307 USA + +(use-modules (srfi srfi-9)) + +(define-record-type :foo (make-foo x) foo? + (x get-x) (y get-y set-y!)) + +(define f (make-foo 1)) +(set-y! f 2) + +(with-test-prefix "record procedures" + + (pass-if "predicate" + (foo? f)) + + (pass-if "accessor 1" + (= 1 (get-x f))) + + (pass-if "accessor 2" + (= 2 (get-y f))) + + (pass-if "modifier" + (set-y! f #t) + (eq? #t (get-y f))))