~ chicken-core (master) /tests/unicode-tests.scm

  1;;; unicode tests, taken from Chibi
  2
  3(import (chicken port) (chicken sort))
  4(import (chicken string) (chicken io))
  5(import (chicken bytevector))
  6(import (only (scheme base) write-string))
  7
  8(include "test.scm")
  9                           
 10(test-begin "scheme")
 11
 12(test-equal #\Р (string-ref "Русский" 0))
 13(test-equal #\и (string-ref "Русский" 5))
 14(test-equal #\й (string-ref "Русский" 6))
 15
 16(test-equal 7 (string-length "Русский"))
 17
 18(test-equal #\日 (string-ref "日本語" 0))
 19(test-equal #\本 (string-ref "日本語" 1))
 20(test-equal #\語 (string-ref "日本語" 2))
 21
 22(test-equal 3 (string-length "日本語"))
 23
 24(test-equal '(#\日 #\本 #\語) (string->list "日本語"))
 25(test-equal "日本語" (list->string '(#\日 #\本 #\語)))
 26
 27(test-equal "日本" (substring "日本語" 0 2))
 28(test-equal "本語" (substring "日本語" 1 3))
 29
 30(test-equal "日-語"
 31      (let ((s (substring "日本語" 0 3)))
 32        (string-set! s 1 #\-)
 33        s))
 34
 35(test-equal "日本人"
 36      (let ((s (substring "日本語" 0 3)))
 37        (string-set! s 2 #\人)
 38        s))
 39
 40(test-equal "字字字" (make-string 3 #\字))
 41
 42(test-equal "字字字"
 43      (let ((s (make-string 3)))
 44        (string-fill! s #\字)
 45        s))
 46
 47; tests from the utf8 egg:
 48
 49(test-equal 2 (string-length "漢字"))
 50
 51(test-equal 28450 (char->integer (string-ref "漢字" 0)))
 52
 53(define str (string-copy "漢字"))
 54
 55(test-equal "赤字" (begin (string-set! str 0 (string-ref "赤" 0)) str))
 56
 57(test-equal "赤外" (begin (string-set! str 1 (string-ref "外" 0)) str))
 58
 59(test-equal "赤x" (begin (string-set! str 1 #\x) str))
 60
 61(test-equal "赤々" (begin (string-set! str 1 (string-ref "々" 0)) str))
 62
 63(test-equal "文字列" (substring "文字列" 0))
 64(test-equal "字列" (substring "文字列" 1))
 65(test-equal "列" (substring "文字列" 2))
 66(test-equal "文" (substring "文字列" 0 1))
 67(test-equal "字" (substring "文字列" 1 2))
 68(test-equal "文字" (substring "文字列" 0 2))
 69
 70(define *string* "文字列")
 71(define *list* '("文" "字" "列"))
 72(define *chars* '(25991 23383 21015))
 73
 74(test-equal *chars* (map char->integer (string->list "文字列")))
 75
 76(test-equal *list* (map string (map integer->char *chars*)))
 77
 78(test-equal *string* (list->string (map integer->char '(25991 23383 21015))))
 79
 80(test-equal "列列列" (make-string 3 (string-ref "列" 0)))
 81
 82(test-equal "文文文" (let ((s (string-copy "abc"))) (string-fill! s (string-ref "文" 0)) s))
 83
 84(test-equal (string-ref "ﾊ" 0) (with-input-from-string "全角ﾊﾝｶｸ"
 85                           (lambda () (read-char) (read-char) (read-char))))
 86
 87(test-equal "個々" (with-output-to-string
 88              (lambda ()
 89                (write-char (string-ref "個" 0))
 90                (write-char (string-ref "々" 0)))))
 91
 92;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 93;; library
 94
 95(test-equal "出力改行\n" (with-output-to-string
 96                   (lambda () (print "出" (string-ref "力" 0) "改行"))))
 97
 98(test-equal "出力" (with-output-to-string
 99              (lambda () (print* "出" (string-ref "力" 0) ""))))
100
101(test-equal "逆リスト→文字列" (reverse-list->string
102                     (map (cut string-ref <> 0)
103                          '("列" "字" "文" "→" "ト" "ス" "リ" "逆"))))
104
105(test-error (utf8->string #u8(255 1 2)))
106(test-equal "BC" (utf8->string #u8(65 66 67) 1 3))
107(test-assert (bytes->string #u8(255 1 2)))
108(test-equal (string-length (bytes->string #u8(255 1 2))) 3)
109
110;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
111;; extras
112
113(test-equal "这是" (with-input-from-string "这是中文" (cut read-string 2)))
114
115(define s "abcdef")
116(call-with-input-string "这是中文" (cut read-string! 2 s <> 2))
117(test-equal "ab这是ef" s)
118       
119(define s "这是中文")
120(call-with-input-string "abcd" (cut read-string! 1 s <> 2))
121(test-equal "这是a文" s)
122       
123(test-equal "这是" (with-output-to-string (cut write-string "这是中文" (current-output-port) 0 2)))
124
125(test-equal "我爱她" (conc (with-input-from-string "我爱你"
126                      (cut read-token (lambda (c)
127                                        (memv c (map (cut string-ref <> 0)
128                                                     '("爱" "您" "我"))))))
129                        "她"))
130
131(test-equal '("第一" "第二" "第三") (string-chop "第一第二第三" 2))
132
133(test-equal '("第一" "第二" "第三" "…") (string-chop "第一第二第三…" 2))
134
135(test-equal '("a" "bc" "第" "f几") (string-split "a,bc、第,f几" ",、"))
136
137(test-equal "THE QUICK BROWN FOX JUMPED OVER THE LAZY SLEEPING DOG"
138    (string-translate "the quick brown fox jumped over the lazy sleeping dog"
139                      "abcdefghijklmnopqrstuvwxyz"
140                      "ABCDEFGHIJKLMNOPQRSTUVWXYZ"))
141(test-equal ":foo:bar:baz" (string-translate "/foo/bar/baz" "/" ":"))
142(test-equal "你爱我" (string-translate "我爱你" "我你" "你我"))
143(test-equal "你爱我" (string-translate "我爱你" '(#\我 #\你) '(#\你 #\我)))
144(test-equal "我你" (string-translate "我爱你" "爱"))
145(test-equal "我你" (string-translate "我爱你" #\爱))
146
147(test-assert (substring=? "日本語" "日本語"))
148(test-assert (substring=? "日本語" "日本"))
149(test-assert (substring=? "日本" "日本語"))
150(test-assert (substring=? "日本語" "本語" 1))
151(test-assert (substring=? "日本語" "本" 1 0 1))
152(test-assert (substring=? "听说上海的东西很贵" "上海的东西很便宜" 2 0 5))
153
154(test-equal 2 (substring-index "上海" "听说上海的东西很贵"))
155
156;; case folding
157
158(test-assert (string-ci=? "abc" "ABC"))
159(test-assert (string-ci=? "Xῌηιx" "xηιῌX"))
160(test-assert (string-ci=? "αβξ" "αβξ"))
161(test-assert (string-ci=? "αβξ" "ΑΒΞ"))
162
163;; Contributed by Anton Idukov:
164
165(import (scheme char))
166
167(test-equal "ru_RU(съешь ещё этих мягких французских булок, да выпей чаю.)"
168            (utf8->string
169              (string->utf8 "ru_RU(съешь ещё этих мягких французских булок, да выпей чаю.)")))
170
171
172(test-equal "Привет, МИР!"
173            (list->string (map integer->char (map char->integer (string->list "Привет, МИР!")))))
174
175
176(test-equal "ПРИВЕТ, МИР!"
177            (symbol->string
178              (string->symbol
179                (list->string
180                  (map char-upcase (string->list "Привет, МИР!"))))))
181
182
183(test-equal "DZIŚ JEST BARDZO GORĄCY DZIEŃ"
184            (list->string
185              (map char-upcase
186                   (string->list
187                     (list->string
188                       (map char-downcase
189                            (string->list "DZIŚ JEST BARDZO GORĄCY DZIEŃ")))))))
190
191
192(test-equal 7
193            (apply + (map digit-value
194                '(#\3 #\x0664 #\x0AE6))))
195
196
197(test-equal "ru_RU(съешь ещё этих мягких французских булок, да выпей чаю.)"
198            (list->string
199              (reverse
200                (string->list
201                  (list->string
202                    (reverse
203                      (string->list "ru_RU(съешь ещё этих мягких французских булок, да выпей чаю.)")))))))
204
205(test-equal #t (string<? "ABCD" "ABCd" "ABcd"))
206(test-equal #f (string-ci<? "ABCD" "ABCd" "ABcd"))
207
208(test-equal #t (string<? "АБВГ" "АБВг" "АБвг"))
209(test-equal #f (string-ci<? "АБВГ" "АБВг" "АБвг"))
210
211(test-equal #t (string>? "АБвг" "АБВг" "АБВГ"))
212(test-equal #f (string-ci>? "АБвг" "АБВг" "АБВГ"))
213
214(test-equal #t (string<=? "ПРИВЕТ" "ПРИВЕТ" "ПРИвет"))
215(test-equal #t (string-ci<=? "ПРИВЕТ" "ПРИВЕТ" "ПРИвет"))
216
217(test-equal #t (string>=? "АБвг" "АБвг" "АБВг"))
218(test-equal #t (string-ci>=? "АБвг" "АБвг" "АБВг"))
219
220(test-equal '("ЭЭЭЭЭЭЭЭ" 8)
221            (let ((s (make-string 8 #\newline)))
222              (string-fill! s #\Э)
223              (list s (string-length s))))
224
225
226(test-error (string-fill "Hello" 4 #\x))
227
228(test-end)
229
230(test-exit)