;;;; srfi-13.test --- Test suite for Guile's SRFI-13 functions. -*- scheme -*-
;;;; Martin Grabmueller, 2001-05-07
;;;;
-;;;; Copyright (C) 2001, 2004, 2005 Free Software Foundation, Inc.
+;;;; Copyright (C) 2001, 2004, 2005, 2006 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,
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;;
+;;;; This library 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., 51 Franklin Street, Fifth Floor,
-;;;; Boston, MA 02110-1301 USA
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (test-strings)
+ #:use-module (test-suite lib)
+ #:use-module (srfi srfi-13)
+ #:use-module (srfi srfi-14))
-(use-modules (srfi srfi-13) (srfi srfi-14) (test-suite lib))
(define exception:strict-infix-grammar
(cons 'misc-error "^strict-infix"))
+;; Create a string from integer char values, eg. (string-ints 65) => "A"
+(define (string-ints . args)
+ (apply string (map integer->char args)))
+
+;; Some abbreviations
+;; BMP - Basic Multilingual Plane (codepoints below U+FFFF)
+;; SMP - Suplementary Multilingual Plane (codebpoints from U+10000 to U+1FFFF)
+
;;;
;;; string-any
;;;
(with-test-prefix "string-any"
+ (pass-if "null string"
+ (not (string-any #\a "")))
+
+ (pass-if "start index == end index"
+ (not (string-any #\a "aaa" 1 1)))
+
(with-test-prefix "bad char_pred"
(pass-if-exception "integer" exception:wrong-type-arg
(pass-if "one match"
(string-any #\C "abCde"))
+ (pass-if "one match: BMP"
+ (string-any (integer->char #x0100) "ab\u0100de"))
+
+ (pass-if "one match: SMP"
+ (string-any (integer->char #x010300) "ab\U010300de"))
+
(pass-if "more than one match"
(string-any #\X "abXXX"))
(pass-if "more than one match, start and end index"
(string-any char-upper-case? "abCDE" 1 4))))
+;;;
+;;; string-titlecase
+;;;
+
+(with-test-prefix "string-titlecase"
+
+ (pass-if "all-lower"
+ (string=? "Foo" (string-titlecase "foo")))
+
+ (pass-if "all-upper"
+ (string=? "Foo" (string-titlecase "FOO")))
+
+ (pass-if "two-words"
+ (string=? "Hello, World!" (string-titlecase "hello, world!")))
+
+ (pass-if "titlecase-characters"
+ (string=? (list->string '(#\762))
+ (string-titlecase (list->string '(#\763))))))
+
;;;
;;; string-append/shared
;;;
(pass-if (string=? "" (string-append/shared "" "")))
(pass-if (string=? "xyz" (string-append/shared "xyz" "")))
(pass-if (string=? "xyz" (string-append/shared "" "xyz")))
- (pass-if (string=? "abcxyz" (string-append/shared "abc" "xyz"))))
+ (pass-if (string=? "abcxyz" (string-append/shared "abc" "xyz")))
+ (pass-if (string=? "abc\u0100\u0101"
+ (string-append/shared "abc" "\u0100\u0101"))))
(with-test-prefix "three args"
(pass-if (string=? "" (string-append/shared "" "" "")))
(pass-if-exception "improper 1" exception:wrong-type-arg
(string-concatenate '("a" . "b")))
- (pass-if (equal? "abc" (string-concatenate '("a" "b" "c")))))
+ (pass-if (equal? "abc" (string-concatenate '("a" "b" "c"))))
+
+ (pass-if "concatenate BMP"
+ (equal? "a\u0100" (string-concatenate '("a" "\u0100")))))
+
+;;
+;; string-compare
+;;
+
+(with-test-prefix "string-compare"
+
+ (pass-if "same as char<?"
+ (eq? (char<? (integer->char 0) (integer->char 255))
+ (string-compare (string-ints 0) (string-ints 255)
+ (lambda (pos) #t) ;; lt
+ (lambda (pos) #f) ;; eq
+ (lambda (pos) #f))))) ;; gt
+
+;;
+;; string-compare-ci
+;;
+
+(with-test-prefix "string-compare-ci"
+
+ (pass-if "same as char-ci<?"
+ (eq? (char-ci<? (integer->char 0) (integer->char 255))
+ (string-compare-ci (string-ints 0) (string-ints 255)
+ (lambda (pos) #t) ;; lt
+ (lambda (pos) #f) ;; eq
+ (lambda (pos) #f))))) ;; gt
;;;
;;; string-concatenate/shared
(pass-if-exception "improper 1" exception:wrong-type-arg
(string-concatenate/shared '("a" . "b")))
- (pass-if (equal? "abc" (string-concatenate/shared '("a" "b" "c")))))
+ (pass-if (equal? "abc" (string-concatenate/shared '("a" "b" "c"))))
+
+ (pass-if "BMP"
+ (equal? "a\u0100c" (string-concatenate/shared '("a" "\u0100" "c")))))
;;;
;;; string-every
(with-test-prefix "string-every"
+ (pass-if "null string"
+ (string-every #\a ""))
+
+ (pass-if "start index == end index"
+ (string-every #\a "bbb" 1 1))
+
(with-test-prefix "bad char_pred"
(pass-if-exception "integer" exception:wrong-type-arg
(pass-if "all match"
(string-every #\X "XXXXX"))
+ (pass-if "all match BMP"
+ (string-every #\200000 "\U010000\U010000"))
+
(pass-if "no match at all, start index"
(not (string-every #\X "Xbcde" 1)))
(pass-if "nonempty, start index"
(= (length (string->list "foo" 1 3)) 2))
+
+ (pass-if "nonempty, start index, BMP"
+ (= (length (string->list "\xff\u0100\u0300" 1 3)) 2))
)
(with-test-prefix "reverse-list->string"
(string-null? (reverse-list->string '())))
(pass-if "nonempty"
- (string=? "foo" (reverse-list->string '(#\o #\o #\f)))))
+ (string=? "foo" (reverse-list->string '(#\o #\o #\f))))
+ (pass-if "nonempty, BMP"
+ (string=? "\u0100\u0101\u0102" (reverse-list->string '(#\402 #\401 #\400)))))
(with-test-prefix "string-join"
(string=? "bla|delim|fasel" (string-join '("bla" "fasel") "|delim|"
'infix)))
+ (pass-if "two strings, explicit infix, BMP"
+ (string=? "\u0100\u0101::\u0102\u0103"
+ (string-join '("\u0100\u0101" "\u0102\u0103") "::"
+ 'infix)))
+
(pass-if-exception "empty list, strict infix"
exception:strict-infix-grammar
(string-join '() "|delim|" 'strict-infix))
(pass-if "full string"
(string=? "foo-bar" (string-copy "foo-bar")))
+ (pass-if "full string, BMP"
+ (string=? "foo-\u0100\u0101" (string-copy "foo-\u0100\u0101")))
+
(pass-if "start index"
(string=? "o-bar" (string-copy "foo-bar" 2)))
+ (pass-if "start index"
+ (string=? "o-bar" (string-copy "\u0100\u0101o-bar" 2)))
+
(pass-if "start and end index"
(string=? "o-ba" (string-copy "foo-bar" 2 6)))
)
(pass-if "non-empty string"
(string=? "foo " (string-take "foo bar braz" 4)))
+ (pass-if "non-empty string BMP"
+ (string=? "\u0100oo " (string-take "\u0100oo \u0101ar braz" 4)))
+
(pass-if "full string"
(string=? "foo bar braz" (string-take "foo bar braz" 12))))
(pass-if "non-empty string"
(string=? "braz" (string-take-right "foo bar braz" 4)))
+ (pass-if "non-empty string"
+ (string=? "braz" (string-take-right "foo ba\u0100 braz" 4)))
+
(pass-if "full string"
(string=? "foo bar braz" (string-take-right "foo bar braz" 12))))
(pass-if "non-empty string"
(string=? "braz" (string-drop "foo bar braz" 8)))
+ (pass-if "non-empty string BMP"
+ (string=? "braz" (string-drop "foo \u0100\u0101\u0102 braz" 8)))
+
(pass-if "full string"
(string=? "foo bar braz" (string-drop "foo bar braz" 0))))
(pass-if "non-empty string"
(string=? "foo " (string-drop-right "foo bar braz" 8)))
+ (pass-if "non-empty string BMP"
+ (string=? "foo " (string-drop-right "foo \u0100\u0101\u0102 braz" 8)))
+
(pass-if "full string"
(string=? "foo bar braz" (string-drop-right "foo bar braz" 0))))
HCoop / bpt / guile.git / blobdiff