diff options
-rw-r--r-- | test-suite/ChangeLog | 4 | ||||
-rw-r--r-- | test-suite/tests/srfi-13.test | 332 |
2 files changed, 336 insertions, 0 deletions
diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog index d9d83f8a8..619cf4906 100644 --- a/test-suite/ChangeLog +++ b/test-suite/ChangeLog @@ -1,3 +1,7 @@ +2001-05-07 Martin Grabmueller <mgrabmue@cs.tu-berlin.de> + + * tests/srfi-13.test: New file testing the SRFI string library. + 2001-04-26 Gary Houston <ghouston@arglist.com> * tests/r4rs.test: delete files tmp1, tmp2, tmp3 after the tests diff --git a/test-suite/tests/srfi-13.test b/test-suite/tests/srfi-13.test new file mode 100644 index 000000000..1c345c8ff --- /dev/null +++ b/test-suite/tests/srfi-13.test @@ -0,0 +1,332 @@ +;;;; srfi-13.test --- Test suite for Guile's SRFI-13 functions. -*- scheme -*- +;;;; Martin Grabmueller, 2001-05-07 +;;;; +;;;; 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-13)) + +(define exception:strict-infix-grammar + (cons 'misc-error "^strict-infix")) + +(with-test-prefix "string-any" + + (pass-if "no match" + (not (string-any char-upper-case? "abcde"))) + + (pass-if "one match" + (string-any char-upper-case? "abCde")) + + (pass-if "more than one match" + (string-any char-upper-case? "abCDE")) + + (pass-if "no match, start index" + (not (string-any char-upper-case? "Abcde" 1))) + + (pass-if "one match, start index" + (string-any char-upper-case? "abCde" 1)) + + (pass-if "more than one match, start index" + (string-any char-upper-case? "abCDE" 1)) + + (pass-if "no match, start and end index" + (not (string-any char-upper-case? "AbcdE" 1 4))) + + (pass-if "one match, start and end index" + (string-any char-upper-case? "abCde" 1 4)) + + (pass-if "more than one match, start and end index" + (string-any char-upper-case? "abCDE" 1 4))) + +(with-test-prefix "string-every" + + (pass-if "no match at all" + (not (string-every char-upper-case? "abcde"))) + + (pass-if "not all match" + (not (string-every char-upper-case? "abCDE"))) + + (pass-if "all match" + (string-every char-upper-case? "ABCDE")) + + (pass-if "no match at all, start index" + (not (string-every char-upper-case? "Abcde" 1))) + + (pass-if "not all match, start index" + (not (string-every char-upper-case? "ABcde" 1))) + + (pass-if "all match, start index" + (string-every char-upper-case? "aBCDE" 1)) + + (pass-if "no match at all, start and end index" + (not (string-every char-upper-case? "AbcdE" 1 4))) + + (pass-if "not all match, start and end index" + (not (string-every char-upper-case? "ABcde" 1 4))) + + (pass-if "all match, start and end index" + (string-every char-upper-case? "aBCDe" 1 4))) + +(with-test-prefix "string-tabulate" + + (pass-if "static fill-char" + (string=? (string-tabulate (lambda (idx) #\!) 10) "!!!!!!!!!!")) + + (pass-if "variable fill-char" + (string=? (string-tabulate + (lambda (idx) (integer->char (+ idx 32))) 10) " !\"#$%&'()"))) + + +(with-test-prefix "string->list" + + (pass-if "empty" + (zero? (length (string->list "")))) + + (pass-if "nonempty" + (= (length (string->list "foo")) 3)) + +;;; FIXME: These do not work, because the standard definition is used, +;;; apparently. +; (pass-if "empty, start index" +; (zero? (length (string->list "foo" 3 3)))) + +; (pass-if "nonempty, start index" +; (= (length (string->list "foo" 2)) 1 3)) + ) + +(with-test-prefix "reverse-list->string" + + (pass-if "empty" + (string-null? (reverse-list->string '()))) + + (pass-if "nonempty" + (string=? "foo" (reverse-list->string '(#\o #\o #\f))))) + + +(with-test-prefix "string-join" + + (pass-if "empty list, no delimiter, implicit infix, empty 1" + (string=? "" (string-join '()))) + + (pass-if "empty string, no delimiter, implicit infix, empty 2" + (string=? "" (string-join '("")))) + + (pass-if "non-empty, no delimiter, implicit infix" + (string=? "bla" (string-join '("bla")))) + + (pass-if "empty list, implicit infix, empty 1" + (string=? "" (string-join '() "|delim|"))) + + (pass-if "empty string, implicit infix, empty 2" + (string=? "" (string-join '("") "|delim|"))) + + (pass-if "non-empty, implicit infix" + (string=? "bla" (string-join '("bla") "|delim|"))) + + (pass-if "non-empty, implicit infix" + (string=? "bla" (string-join '("bla") "|delim|"))) + + (pass-if "two strings, implicit infix" + (string=? "bla|delim|fasel" (string-join '("bla" "fasel") "|delim|"))) + + (pass-if "empty, explicit infix" + (string=? "" (string-join '("") "|delim|" 'infix))) + + (pass-if "empty list, explicit infix" + (string=? "" (string-join '() "|delim|" 'infix))) + + (pass-if "non-empty, explicit infix" + (string=? "bla" (string-join '("bla") "|delim|" 'infix))) + + (pass-if "two strings, explicit infix" + (string=? "bla|delim|fasel" (string-join '("bla" "fasel") "|delim|" + 'infix))) + + (pass-if-exception "empty list, strict infix" + exception:strict-infix-grammar + (string-join '() "|delim|" 'strict-infix)) + + (pass-if "empty, strict infix" + (string=? "" (string-join '("") "|delim|" 'strict-infix))) + + (pass-if "non-empty, strict infix" + (string=? "foo" (string-join '("foo") "|delim|" 'strict-infix))) + + (pass-if "two strings, strict infix" + (string=? "foo|delim|bar" (string-join '("foo" "bar") "|delim|" + 'strict-infix))) + + (pass-if "empty list, prefix" + (string=? "" (string-join '() "|delim|" 'prefix))) + + (pass-if "empty, prefix" + (string=? "|delim|" (string-join '("") "|delim|" 'prefix))) + + (pass-if "non-empty, prefix" + (string=? "|delim|foo" (string-join '("foo") "|delim|" 'prefix))) + + (pass-if "two strings, prefix" + (string=? "|delim|foo|delim|bar" (string-join '("foo" "bar") "|delim|" + 'prefix))) + + (pass-if "empty list, suffix" + (string=? "" (string-join '() "|delim|" 'suffix))) + + (pass-if "empty, suffix" + (string=? "|delim|" (string-join '("") "|delim|" 'suffix))) + + (pass-if "non-empty, suffix" + (string=? "foo|delim|" (string-join '("foo") "|delim|" 'suffix))) + + (pass-if "two strings, suffix" + (string=? "foo|delim|bar|delim|" (string-join '("foo" "bar") "|delim|" + 'suffix)))) + + +(with-test-prefix "string-copy" + + (pass-if "empty string" + (string=? "" (string-copy ""))) + + (pass-if "full string" + (string=? "foo-bar" (string-copy "foo-bar"))) + +;;; FIXME: These do not work, because the standard definition is used, +;;; apparently. +; (pass-if "start index" +; (string=? "o-bar" (string-copy "foo-bar" 2))) + +; (pass-if "start and end index" +; (string=? "o-ba" (string-copy "foo-bar" 2 6))) +) + +(with-test-prefix "substring/shared" + + (pass-if "empty string" + (eq? "" (substring/shared "" 0))) + + (pass-if "non-empty string" + (string=? "foo" (substring/shared "foo-bar" 0 3))) + + (pass-if "non-empty string, not eq?" + (string=? "foo-bar" (substring/shared "foo-bar" 0 7)))) + +(with-test-prefix "string-copy!" + + (pass-if "non-empty string" + (string=? "welld, oh yeah!" + (let* ((s "hello") + (t "world, oh yeah!")) + (string-copy! t 1 s 1 3) + t)))) + +(with-test-prefix "string-take" + + (pass-if "empty string" + (string=? "" (string-take "foo bar braz" 0))) + + (pass-if "non-empty string" + (string=? "foo " (string-take "foo bar braz" 4))) + + (pass-if "full string" + (string=? "foo bar braz" (string-take "foo bar braz" 12)))) + +(with-test-prefix "string-take-right" + + (pass-if "empty string" + (string=? "" (string-take-right "foo bar braz" 0))) + + (pass-if "non-empty string" + (string=? "braz" (string-take-right "foo bar braz" 4))) + + (pass-if "full string" + (string=? "foo bar braz" (string-take-right "foo bar braz" 12)))) + +(with-test-prefix "string-drop" + + (pass-if "empty string" + (string=? "" (string-drop "foo bar braz" 12))) + + (pass-if "non-empty string" + (string=? "braz" (string-drop "foo bar braz" 8))) + + (pass-if "full string" + (string=? "foo bar braz" (string-drop "foo bar braz" 0)))) + +(with-test-prefix "string-drop-right" + + (pass-if "empty string" + (string=? "" (string-drop-right "foo bar braz" 12))) + + (pass-if "non-empty string" + (string=? "foo " (string-drop-right "foo bar braz" 8))) + + (pass-if "full string" + (string=? "foo bar braz" (string-drop-right "foo bar braz" 0)))) + +(with-test-prefix "string-pad" + + (pass-if "empty string, zero pad" + (string=? "" (string-pad "" 0))) + + (pass-if "empty string, zero pad, pad char" + (string=? "" (string-pad "" 0))) + + (pass-if "empty pad string, 2 pad " + (string=? " " (string-pad "" 2))) + + (pass-if "empty pad string, 2 pad, pad char" + (string=? "!!" (string-pad "" 2 #\!))) + + (pass-if "empty pad string, 2 pad, pad char, start index" + (string=? "!c" (string-pad "abc" 2 #\! 2))) + + (pass-if "empty pad string, 2 pad, pad char, start and end index" + (string=? "!c" (string-pad "abcd" 2 #\! 2 3))) + + (pass-if "freestyle 1" + (string=? "32" (string-pad (number->string 532) 2 #\!))) + + (pass-if "freestyle 2" + (string=? "!532" (string-pad (number->string 532) 4 #\!)))) + +(with-test-prefix "string-pad-right" + + (pass-if "empty string, zero pad" + (string=? "" (string-pad-right "" 0))) + + (pass-if "empty string, zero pad, pad char" + (string=? "" (string-pad-right "" 0))) + + (pass-if "empty pad string, 2 pad " + (string=? " " (string-pad-right "" 2))) + + (pass-if "empty pad string, 2 pad, pad char" + (string=? "!!" (string-pad-right "" 2 #\!))) + + (pass-if "empty pad string, 2 pad, pad char, start index" + (string=? "c!" (string-pad-right "abc" 2 #\! 2))) + + (pass-if "empty pad string, 2 pad, pad char, start and end index" + (string=? "c!" (string-pad-right "abcd" 2 #\! 2 3))) + + (pass-if "freestyle 1" + (string=? "53" (string-pad-right (number->string 532) 2 #\!))) + + (pass-if "freestyle 2" + (string=? "532!" (string-pad-right (number->string 532) 4 #\!)))) + |