* tests/srfi-13.test: New file testing the SRFI string library.

diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog
index d9d83f8..619cf49 100644 (file)
--- 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 (file)
index 0000000..1c345c8
--- /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 #\!))))
+