1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-10 14:00:21 +02:00

Some srfi-13 test with wide strings

* test-suite/tests/srfi-13.test: more tests
This commit is contained in:
Michael Gran 2009-08-19 23:21:18 -07:00
parent 1b9ac4580c
commit 1441e6dbd7

View file

@ -30,6 +30,9 @@
(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
@ -53,6 +56,12 @@
(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"))
@ -151,7 +160,9 @@
(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 "" "" "")))
@ -191,7 +202,10 @@
(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
@ -234,7 +248,10 @@
(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
@ -267,6 +284,9 @@
(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)))
@ -386,6 +406,9 @@
(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"
@ -394,8 +417,10 @@
(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"
@ -436,6 +461,11 @@
(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))
@ -484,9 +514,15 @@
(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)))
)
@ -519,6 +555,9 @@
(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))))
@ -530,6 +569,9 @@
(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))))
@ -541,6 +583,9 @@
(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))))
@ -552,6 +597,9 @@
(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))))