mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-29 08:20:20 +02:00
Code Activity

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

Browse source
This commit is contained in:
Martin Grabmüller 2001-05-07 21:52:25 +00:00
parent 75141eb0c1
commit df937d20e0
2 changed files with 336 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

4
test-suite/ChangeLog
View file

@ -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

332
test-suite/tests/srfi-13.test Normal file
View file

@ -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 #\!))))