summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--test-suite/ChangeLog4
-rw-r--r--test-suite/tests/srfi-13.test332
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 #\!))))
+