1#! /usr/bin/env sscm -C UTF-8
2
3;;  Filename : test-string-proc.scm
4;;  About    : unit test for R5RS string procedures
5;;
6;;  Copyright (c) 2007-2008 SigScheme Project <uim-en AT googlegroups.com>
7;;
8;;  All rights reserved.
9;;
10;;  Redistribution and use in source and binary forms, with or without
11;;  modification, are permitted provided that the following conditions
12;;  are met:
13;;
14;;  1. Redistributions of source code must retain the above copyright
15;;     notice, this list of conditions and the following disclaimer.
16;;  2. Redistributions in binary form must reproduce the above copyright
17;;     notice, this list of conditions and the following disclaimer in the
18;;     documentation and/or other materials provided with the distribution.
19;;  3. Neither the name of authors nor the names of its contributors
20;;     may be used to endorse or promote products derived from this software
21;;     without specific prior written permission.
22;;
23;;  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
24;;  IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
25;;  THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
26;;  PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
27;;  CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
28;;  EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
29;;  PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
30;;  PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
31;;  LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
32;;  NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
33;;  SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
34
35(require-extension (sscm-ext))
36
37(require-extension (unittest))
38
39(if (and sigscheme?
40         (not (symbol-bound? 'make-string)))
41    (test-skip "non-core string procedures of R5RS is not enabled"))
42
43(define tn test-name)
44(define cp string-copy)
45
46(define mutable?
47  (if sigscheme?
48      %%string-mutable?
49      (lambda (s) #t)))
50
51(define pair-mutable?
52  (if sigscheme?
53      %%pair-mutable?
54      (lambda (kons) #t)))
55
56;;
57;; All procedures that take a string as argument are tested with
58;; both immutable and mutable string.
59;;
60;; See "3.4 Storage model" of R5RS
61;;
62
63
64(tn "make-string invalid forms")
65(assert-error  (tn) (lambda () (make-string -2)))
66(assert-error  (tn) (lambda () (make-string -1)))
67(assert-error  (tn) (lambda () (make-string -2 #\a)))
68(assert-error  (tn) (lambda () (make-string -1 #\a)))
69(assert-error  (tn) (lambda () (make-string #\a)))
70(assert-error  (tn) (lambda () (make-string 1 32)))
71(tn "make-string")
72(assert-equal? (tn) ""         (make-string 0))
73(assert-equal? (tn) "?"        (make-string 1))
74(assert-equal? (tn) "??"       (make-string 2))
75(assert-equal? (tn) "???"      (make-string 3))
76(assert-equal? (tn) ""         (make-string 0 #\a))
77(assert-equal? (tn) "a"        (make-string 1 #\a))
78(assert-equal? (tn) "aa"       (make-string 2 #\a))
79(assert-equal? (tn) "aaa"      (make-string 3 #\a))
80(assert-equal? (tn) ""         (make-string 0 #\あ))
81(assert-equal? (tn) "あ"       (make-string 1 #\あ))
82(assert-equal? (tn) "ああ"     (make-string 2 #\あ))
83(assert-equal? (tn) "あああ"   (make-string 3 #\あ))
84(tn "make-string NUL filler")
85(assert-equal? (tn) ""         (make-string 0 #x00))
86(if (and sigscheme?
87         (not (provided? "null-capable-string")))
88    (begin
89      (assert-error  (tn) (lambda () (make-string 1 #x00)))
90      (assert-error  (tn) (lambda () (make-string 2 #x00)))
91      (assert-error  (tn) (lambda () (make-string 3 #x00)))))
92
93(tn "string invalid forms")
94(assert-error (tn) (lambda ()  (string #t)))
95(assert-error (tn) (lambda ()  (string "a")))
96(tn "string")
97(assert-equal? (tn) ""         (string))
98(assert-equal? (tn) "a"        (string #\a))
99(assert-equal? (tn) "ab"       (string #\a #\b))
100(assert-equal? (tn) "あ"       (string #\あ))
101(assert-equal? (tn) "あう"     (string #\あ #\う))
102(assert-equal? (tn) "aあb"     (string #\a #\あ #\b))
103(assert-equal? (tn) "あaう"    (string #\あ #\a #\う))
104(assert-equal? (tn) "aあbう"   (string #\a #\あ #\b #\う))
105(assert-equal? (tn) "あaうb"   (string #\あ #\a #\う #\b))
106(tn "string mutability")
107(assert-true   (tn) (mutable?  (string)))
108(assert-true   (tn) (mutable?  (string #\a)))
109(assert-true   (tn) (mutable?  (string #\a #\b)))
110(assert-true   (tn) (mutable?  (string #\あ)))
111(assert-true   (tn) (mutable?  (string #\あ #\う)))
112(assert-true   (tn) (mutable?  (string #\a #\あ #\b)))
113(assert-true   (tn) (mutable?  (string #\あ #\a #\う)))
114(assert-true   (tn) (mutable?  (string #\a #\あ #\b #\う)))
115(assert-true   (tn) (mutable?  (string #\あ #\a #\う #\b)))
116(tn "string with NUL args")
117(if (and sigscheme?
118         (not (provided? "null-capable-string")))
119    (begin
120      (assert-error (tn) (lambda () (string #x00)))
121      (assert-error (tn) (lambda () (string #\a #x00)))
122      (assert-error (tn) (lambda () (string #x00 #\a)))
123      (assert-error (tn) (lambda () (string #\a #x00 #\a)))))
124
125(tn "string-ref invalid forms")
126(assert-error  (tn) (lambda () (string-ref #\a 0)))
127(assert-error  (tn) (lambda () (string-ref "a" #\1)))
128(tn "string-ref immutable")
129(assert-error  (tn) (lambda () (string-ref "" -2)))
130(assert-error  (tn) (lambda () (string-ref "" -1)))
131(assert-error  (tn) (lambda () (string-ref "" 0)))
132(assert-error  (tn) (lambda () (string-ref "" 1)))
133(assert-error  (tn) (lambda () (string-ref "" 2)))
134(assert-error  (tn) (lambda () (string-ref "a" -2)))
135(assert-error  (tn) (lambda () (string-ref "a" -1)))
136(assert-equal? (tn) #\a        (string-ref "a" 0))
137(assert-error  (tn) (lambda () (string-ref "a" 1)))
138(assert-error  (tn) (lambda () (string-ref "a" 2)))
139(assert-error  (tn) (lambda () (string-ref "ab" -2)))
140(assert-error  (tn) (lambda () (string-ref "ab" -1)))
141(assert-equal? (tn) #\a        (string-ref "ab" 0))
142(assert-equal? (tn) #\b        (string-ref "ab" 1))
143(assert-error  (tn) (lambda () (string-ref "ab" 2)))
144(assert-error  (tn) (lambda () (string-ref "ab" 3)))
145(assert-error  (tn) (lambda () (string-ref "あ" -2)))
146(assert-error  (tn) (lambda () (string-ref "あ" -1)))
147(assert-equal? (tn) #\あ       (string-ref "あ" 0))
148(assert-error  (tn) (lambda () (string-ref "あ" 1)))
149(assert-error  (tn) (lambda () (string-ref "あ" 2)))
150(assert-error  (tn) (lambda () (string-ref "あう" -2)))
151(assert-error  (tn) (lambda () (string-ref "あう" -1)))
152(assert-equal? (tn) #\あ       (string-ref "あう" 0))
153(assert-equal? (tn) #\う       (string-ref "あう" 1))
154(assert-error  (tn) (lambda () (string-ref "あう" 2)))
155(assert-error  (tn) (lambda () (string-ref "あう" 3)))
156(assert-error  (tn) (lambda () (string-ref "aあb" -2)))
157(assert-error  (tn) (lambda () (string-ref "aあb" -1)))
158(assert-equal? (tn) #\a        (string-ref "aあb" 0))
159(assert-equal? (tn) #\あ       (string-ref "aあb" 1))
160(assert-equal? (tn) #\b        (string-ref "aあb" 2))
161(assert-error  (tn) (lambda () (string-ref "aあb" 3)))
162(assert-error  (tn) (lambda () (string-ref "aあb" 4)))
163(assert-error  (tn) (lambda () (string-ref "あaう" -2)))
164(assert-error  (tn) (lambda () (string-ref "あaう" -1)))
165(assert-equal? (tn) #\あ       (string-ref "あaう" 0))
166(assert-equal? (tn) #\a        (string-ref "あaう" 1))
167(assert-equal? (tn) #\う       (string-ref "あaう" 2))
168(assert-error  (tn) (lambda () (string-ref "あaう" 3)))
169(assert-error  (tn) (lambda () (string-ref "あaう" 4)))
170(assert-error  (tn) (lambda () (string-ref "aあbう" -2)))
171(assert-error  (tn) (lambda () (string-ref "aあbう" -1)))
172(assert-equal? (tn) #\a        (string-ref "aあbう" 0))
173(assert-equal? (tn) #\あ       (string-ref "aあbう" 1))
174(assert-equal? (tn) #\b        (string-ref "aあbう" 2))
175(assert-equal? (tn) #\う       (string-ref "aあbう" 3))
176(assert-error  (tn) (lambda () (string-ref "aあbう" 4)))
177(assert-error  (tn) (lambda () (string-ref "aあbう" 5)))
178(assert-error  (tn) (lambda () (string-ref "あaうb" -2)))
179(assert-error  (tn) (lambda () (string-ref "あaうb" -1)))
180(assert-equal? (tn) #\あ       (string-ref "あaうb" 0))
181(assert-equal? (tn) #\a        (string-ref "あaうb" 1))
182(assert-equal? (tn) #\う       (string-ref "あaうb" 2))
183(assert-equal? (tn) #\b        (string-ref "あaうb" 3))
184(assert-error  (tn) (lambda () (string-ref "あaうb" 4)))
185(assert-error  (tn) (lambda () (string-ref "あaうb" 5)))
186(tn "string-ref mutable")
187(assert-error  (tn) (lambda () (string-ref (cp "") -2)))
188(assert-error  (tn) (lambda () (string-ref (cp "") -1)))
189(assert-error  (tn) (lambda () (string-ref (cp "") 0)))
190(assert-error  (tn) (lambda () (string-ref (cp "") 1)))
191(assert-error  (tn) (lambda () (string-ref (cp "") 2)))
192(assert-error  (tn) (lambda () (string-ref (cp "a") -2)))
193(assert-error  (tn) (lambda () (string-ref (cp "a") -1)))
194(assert-equal? (tn) #\a        (string-ref (cp "a") 0))
195(assert-error  (tn) (lambda () (string-ref (cp "a") 1)))
196(assert-error  (tn) (lambda () (string-ref (cp "a") 2)))
197(assert-error  (tn) (lambda () (string-ref (cp "ab") -2)))
198(assert-error  (tn) (lambda () (string-ref (cp "ab") -1)))
199(assert-equal? (tn) #\a        (string-ref (cp "ab") 0))
200(assert-equal? (tn) #\b        (string-ref (cp "ab") 1))
201(assert-error  (tn) (lambda () (string-ref (cp "ab") 2)))
202(assert-error  (tn) (lambda () (string-ref (cp "ab") 3)))
203(assert-error  (tn) (lambda () (string-ref (cp "あ") -2)))
204(assert-error  (tn) (lambda () (string-ref (cp "あ") -1)))
205(assert-equal? (tn) #\あ       (string-ref (cp "あ") 0))
206(assert-error  (tn) (lambda () (string-ref (cp "あ") 1)))
207(assert-error  (tn) (lambda () (string-ref (cp "あ") 2)))
208(assert-error  (tn) (lambda () (string-ref (cp "あう") -2)))
209(assert-error  (tn) (lambda () (string-ref (cp "あう") -1)))
210(assert-equal? (tn) #\あ       (string-ref (cp "あう") 0))
211(assert-equal? (tn) #\う       (string-ref (cp "あう") 1))
212(assert-error  (tn) (lambda () (string-ref (cp "あう") 2)))
213(assert-error  (tn) (lambda () (string-ref (cp "あう") 3)))
214(assert-error  (tn) (lambda () (string-ref (cp "aあb") -2)))
215(assert-error  (tn) (lambda () (string-ref (cp "aあb") -1)))
216(assert-equal? (tn) #\a        (string-ref (cp "aあb") 0))
217(assert-equal? (tn) #\あ       (string-ref (cp "aあb") 1))
218(assert-equal? (tn) #\b        (string-ref (cp "aあb") 2))
219(assert-error  (tn) (lambda () (string-ref (cp "aあb") 3)))
220(assert-error  (tn) (lambda () (string-ref (cp "aあb") 4)))
221(assert-error  (tn) (lambda () (string-ref (cp "あaう") -2)))
222(assert-error  (tn) (lambda () (string-ref (cp "あaう") -1)))
223(assert-equal? (tn) #\あ       (string-ref (cp "あaう") 0))
224(assert-equal? (tn) #\a        (string-ref (cp "あaう") 1))
225(assert-equal? (tn) #\う       (string-ref (cp "あaう") 2))
226(assert-error  (tn) (lambda () (string-ref (cp "あaう") 3)))
227(assert-error  (tn) (lambda () (string-ref (cp "あaう") 4)))
228(assert-error  (tn) (lambda () (string-ref (cp "aあbう") -2)))
229(assert-error  (tn) (lambda () (string-ref (cp "aあbう") -1)))
230(assert-equal? (tn) #\a        (string-ref (cp "aあbう") 0))
231(assert-equal? (tn) #\あ       (string-ref (cp "aあbう") 1))
232(assert-equal? (tn) #\b        (string-ref (cp "aあbう") 2))
233(assert-equal? (tn) #\う       (string-ref (cp "aあbう") 3))
234(assert-error  (tn) (lambda () (string-ref (cp "aあbう") 4)))
235(assert-error  (tn) (lambda () (string-ref (cp "aあbう") 5)))
236(assert-error  (tn) (lambda () (string-ref (cp "あaうb") -2)))
237(assert-error  (tn) (lambda () (string-ref (cp "あaうb") -1)))
238(assert-equal? (tn) #\あ       (string-ref (cp "あaうb") 0))
239(assert-equal? (tn) #\a        (string-ref (cp "あaうb") 1))
240(assert-equal? (tn) #\う       (string-ref (cp "あaうb") 2))
241(assert-equal? (tn) #\b        (string-ref (cp "あaうb") 3))
242(assert-error  (tn) (lambda () (string-ref (cp "あaうb") 4)))
243(assert-error  (tn) (lambda () (string-ref (cp "あaうb") 5)))
244
245(tn "string-set! invalid forms")
246(assert-error  (tn) (lambda () (string-set! #\a 0 #\z)))
247(assert-error  (tn) (lambda () (string-set! (cp "a") #\1 #\z)))
248(assert-error  (tn) (lambda () (string-set! (cp "a") 0 #t)))
249(tn "string-set! immutable")
250(assert-error  (tn) (lambda () (string-set! "" -2 #\z)))
251(assert-error  (tn) (lambda () (string-set! "" -1 #\z)))
252(assert-error  (tn) (lambda () (string-set! "" 0 #\z)))
253(assert-error  (tn) (lambda () (string-set! "" 1 #\z)))
254(assert-error  (tn) (lambda () (string-set! "" 2 #\z)))
255(assert-error  (tn) (lambda () (string-set! "a" -2 #\z)))
256(assert-error  (tn) (lambda () (string-set! "a" -1 #\z)))
257(assert-error  (tn) (lambda () (string-set! "a" 0 #\z)))
258(assert-error  (tn) (lambda () (string-set! "a" 1 #\z)))
259(assert-error  (tn) (lambda () (string-set! "a" 2 #\z)))
260(assert-error  (tn) (lambda () (string-set! "ab" -2 #\z)))
261(assert-error  (tn) (lambda () (string-set! "ab" -1 #\z)))
262(assert-error  (tn) (lambda () (string-set! "ab" 0 #\z)))
263(assert-error  (tn) (lambda () (string-set! "ab" 1 #\z)))
264(assert-error  (tn) (lambda () (string-set! "ab" 2 #\z)))
265(assert-error  (tn) (lambda () (string-set! "ab" 3 #\z)))
266(assert-error  (tn) (lambda () (string-set! "あ" -2 #\z)))
267(assert-error  (tn) (lambda () (string-set! "あ" -1 #\z)))
268(assert-error  (tn) (lambda () (string-set! "あ" 0 #\z)))
269(assert-error  (tn) (lambda () (string-set! "あ" 1 #\z)))
270(assert-error  (tn) (lambda () (string-set! "あ" 2 #\z)))
271(assert-error  (tn) (lambda () (string-set! "あう" -2 #\z)))
272(assert-error  (tn) (lambda () (string-set! "あう" -1 #\z)))
273(assert-error  (tn) (lambda () (string-set! "あう" 0 #\z)))
274(assert-error  (tn) (lambda () (string-set! "あう" 1 #\z)))
275(assert-error  (tn) (lambda () (string-set! "あう" 2 #\z)))
276(assert-error  (tn) (lambda () (string-set! "あう" 3 #\z)))
277(assert-error  (tn) (lambda () (string-set! "aあb" -2 #\z)))
278(assert-error  (tn) (lambda () (string-set! "aあb" -1 #\z)))
279(assert-error  (tn) (lambda () (string-set! "aあb" 0 #\z)))
280(assert-error  (tn) (lambda () (string-set! "aあb" 1 #\z)))
281(assert-error  (tn) (lambda () (string-set! "aあb" 2 #\z)))
282(assert-error  (tn) (lambda () (string-set! "aあb" 3 #\z)))
283(assert-error  (tn) (lambda () (string-set! "aあb" 4 #\z)))
284(assert-error  (tn) (lambda () (string-set! "あaう" -2 #\z)))
285(assert-error  (tn) (lambda () (string-set! "あaう" -1 #\z)))
286(assert-error  (tn) (lambda () (string-set! "あaう" 0 #\z)))
287(assert-error  (tn) (lambda () (string-set! "あaう" 1 #\z)))
288(assert-error  (tn) (lambda () (string-set! "あaう" 2 #\z)))
289(assert-error  (tn) (lambda () (string-set! "あaう" 3 #\z)))
290(assert-error  (tn) (lambda () (string-set! "あaう" 4 #\z)))
291(assert-error  (tn) (lambda () (string-set! "aあbう" -2 #\z)))
292(assert-error  (tn) (lambda () (string-set! "aあbう" -1 #\z)))
293(assert-error  (tn) (lambda () (string-set! "aあbう" 0 #\z)))
294(assert-error  (tn) (lambda () (string-set! "aあbう" 1 #\z)))
295(assert-error  (tn) (lambda () (string-set! "aあbう" 2 #\z)))
296(assert-error  (tn) (lambda () (string-set! "aあbう" 3 #\z)))
297(assert-error  (tn) (lambda () (string-set! "aあbう" 4 #\z)))
298(assert-error  (tn) (lambda () (string-set! "aあbう" 5 #\z)))
299(assert-error  (tn) (lambda () (string-set! "あaうb" -2 #\z)))
300(assert-error  (tn) (lambda () (string-set! "あaうb" -1 #\z)))
301(assert-error  (tn) (lambda () (string-set! "あaうb" 0 #\z)))
302(assert-error  (tn) (lambda () (string-set! "あaうb" 1 #\z)))
303(assert-error  (tn) (lambda () (string-set! "あaうb" 2 #\z)))
304(assert-error  (tn) (lambda () (string-set! "あaうb" 3 #\z)))
305(assert-error  (tn) (lambda () (string-set! "あaうb" 4 #\z)))
306(assert-error  (tn) (lambda () (string-set! "あaうb" 5 #\z)))
307(tn "string-set! multibyte immutable")
308(assert-error  (tn) (lambda () (string-set! "" -2 #\ん)))
309(assert-error  (tn) (lambda () (string-set! "" -1 #\ん)))
310(assert-error  (tn) (lambda () (string-set! "" 0 #\ん)))
311(assert-error  (tn) (lambda () (string-set! "" 1 #\ん)))
312(assert-error  (tn) (lambda () (string-set! "" 2 #\ん)))
313(assert-error  (tn) (lambda () (string-set! "a" -2 #\ん)))
314(assert-error  (tn) (lambda () (string-set! "a" -1 #\ん)))
315(assert-error  (tn) (lambda () (string-set! "a" 0 #\ん)))
316(assert-error  (tn) (lambda () (string-set! "a" 1 #\ん)))
317(assert-error  (tn) (lambda () (string-set! "a" 2 #\ん)))
318(assert-error  (tn) (lambda () (string-set! "ab" -2 #\ん)))
319(assert-error  (tn) (lambda () (string-set! "ab" -1 #\ん)))
320(assert-error  (tn) (lambda () (string-set! "ab" 0 #\ん)))
321(assert-error  (tn) (lambda () (string-set! "ab" 1 #\ん)))
322(assert-error  (tn) (lambda () (string-set! "ab" 2 #\ん)))
323(assert-error  (tn) (lambda () (string-set! "ab" 3 #\ん)))
324(assert-error  (tn) (lambda () (string-set! "あ" -2 #\ん)))
325(assert-error  (tn) (lambda () (string-set! "あ" -1 #\ん)))
326(assert-error  (tn) (lambda () (string-set! "あ" 0 #\ん)))
327(assert-error  (tn) (lambda () (string-set! "あ" 1 #\ん)))
328(assert-error  (tn) (lambda () (string-set! "あ" 2 #\ん)))
329(assert-error  (tn) (lambda () (string-set! "あう" -2 #\ん)))
330(assert-error  (tn) (lambda () (string-set! "あう" -1 #\ん)))
331(assert-error  (tn) (lambda () (string-set! "あう" 0 #\ん)))
332(assert-error  (tn) (lambda () (string-set! "あう" 1 #\ん)))
333(assert-error  (tn) (lambda () (string-set! "あう" 2 #\ん)))
334(assert-error  (tn) (lambda () (string-set! "あう" 3 #\ん)))
335(assert-error  (tn) (lambda () (string-set! "aあb" -2 #\ん)))
336(assert-error  (tn) (lambda () (string-set! "aあb" -1 #\ん)))
337(assert-error  (tn) (lambda () (string-set! "aあb" 0 #\ん)))
338(assert-error  (tn) (lambda () (string-set! "aあb" 1 #\ん)))
339(assert-error  (tn) (lambda () (string-set! "aあb" 2 #\ん)))
340(assert-error  (tn) (lambda () (string-set! "aあb" 3 #\ん)))
341(assert-error  (tn) (lambda () (string-set! "aあb" 4 #\ん)))
342(assert-error  (tn) (lambda () (string-set! "あaう" -2 #\ん)))
343(assert-error  (tn) (lambda () (string-set! "あaう" -1 #\ん)))
344(assert-error  (tn) (lambda () (string-set! "あaう" 0 #\ん)))
345(assert-error  (tn) (lambda () (string-set! "あaう" 1 #\ん)))
346(assert-error  (tn) (lambda () (string-set! "あaう" 2 #\ん)))
347(assert-error  (tn) (lambda () (string-set! "あaう" 3 #\ん)))
348(assert-error  (tn) (lambda () (string-set! "あaう" 4 #\ん)))
349(assert-error  (tn) (lambda () (string-set! "aあbう" -2 #\ん)))
350(assert-error  (tn) (lambda () (string-set! "aあbう" -1 #\ん)))
351(assert-error  (tn) (lambda () (string-set! "aあbう" 0 #\ん)))
352(assert-error  (tn) (lambda () (string-set! "aあbう" 1 #\ん)))
353(assert-error  (tn) (lambda () (string-set! "aあbう" 2 #\ん)))
354(assert-error  (tn) (lambda () (string-set! "aあbう" 3 #\ん)))
355(assert-error  (tn) (lambda () (string-set! "aあbう" 4 #\ん)))
356(assert-error  (tn) (lambda () (string-set! "aあbう" 5 #\ん)))
357(assert-error  (tn) (lambda () (string-set! "あaうb" -2 #\ん)))
358(assert-error  (tn) (lambda () (string-set! "あaうb" -1 #\ん)))
359(assert-error  (tn) (lambda () (string-set! "あaうb" 0 #\ん)))
360(assert-error  (tn) (lambda () (string-set! "あaうb" 1 #\ん)))
361(assert-error  (tn) (lambda () (string-set! "あaうb" 2 #\ん)))
362(assert-error  (tn) (lambda () (string-set! "あaうb" 3 #\ん)))
363(assert-error  (tn) (lambda () (string-set! "あaうb" 4 #\ん)))
364(assert-error  (tn) (lambda () (string-set! "あaうb" 5 #\ん)))
365
366(define my-string-set!
367  (lambda (str k ch)
368    (string-set! str k ch)
369    str))
370(tn "string-set! mutable")
371(assert-equal? (tn) (undef)    (string-set! (cp "a") 0 #\z))
372(assert-error  (tn) (lambda () (my-string-set! (cp "") -2 #\z)))
373(assert-error  (tn) (lambda () (my-string-set! (cp "") -1 #\z)))
374(assert-error  (tn) (lambda () (my-string-set! (cp "") 0 #\z)))
375(assert-error  (tn) (lambda () (my-string-set! (cp "") 1 #\z)))
376(assert-error  (tn) (lambda () (my-string-set! (cp "") 2 #\z)))
377(assert-error  (tn) (lambda () (my-string-set! (cp "a") -2 #\z)))
378(assert-error  (tn) (lambda () (my-string-set! (cp "a") -1 #\z)))
379(assert-equal? (tn) "z"        (my-string-set! (cp "a") 0 #\z))
380(assert-error  (tn) (lambda () (my-string-set! (cp "a") 1 #\z)))
381(assert-error  (tn) (lambda () (my-string-set! (cp "a") 2 #\z)))
382(assert-error  (tn) (lambda () (my-string-set! (cp "ab") -2 #\z)))
383(assert-error  (tn) (lambda () (my-string-set! (cp "ab") -1 #\z)))
384(assert-equal? (tn) "zb"       (my-string-set! (cp "ab") 0 #\z))
385(assert-equal? (tn) "az"       (my-string-set! (cp "ab") 1 #\z))
386(assert-error  (tn) (lambda () (my-string-set! (cp "ab") 2 #\z)))
387(assert-error  (tn) (lambda () (my-string-set! (cp "ab") 3 #\z)))
388(assert-error  (tn) (lambda () (my-string-set! (cp "あ") -2 #\z)))
389(assert-error  (tn) (lambda () (my-string-set! (cp "あ") -1 #\z)))
390(assert-equal? (tn) "z"        (my-string-set! (cp "あ") 0 #\z))
391(assert-error  (tn) (lambda () (my-string-set! (cp "あ") 1 #\z)))
392(assert-error  (tn) (lambda () (my-string-set! (cp "あ") 2 #\z)))
393(assert-error  (tn) (lambda () (my-string-set! (cp "あう") -2 #\z)))
394(assert-error  (tn) (lambda () (my-string-set! (cp "あう") -1 #\z)))
395(assert-equal? (tn) "zう"      (my-string-set! (cp "あう") 0 #\z))
396(assert-equal? (tn) "あz"      (my-string-set! (cp "あう") 1 #\z))
397(assert-error  (tn) (lambda () (my-string-set! (cp "あう") 2 #\z)))
398(assert-error  (tn) (lambda () (my-string-set! (cp "あう") 3 #\z)))
399(assert-error  (tn) (lambda () (my-string-set! (cp "aあb") -2 #\z)))
400(assert-error  (tn) (lambda () (my-string-set! (cp "aあb") -1 #\z)))
401(assert-equal? (tn) "zあb"     (my-string-set! (cp "aあb") 0 #\z))
402(assert-equal? (tn) "azb"      (my-string-set! (cp "aあb") 1 #\z))
403(assert-equal? (tn) "aあz"     (my-string-set! (cp "aあb") 2 #\z))
404(assert-error  (tn) (lambda () (my-string-set! (cp "aあb") 3 #\z)))
405(assert-error  (tn) (lambda () (my-string-set! (cp "aあb") 4 #\z)))
406(assert-error  (tn) (lambda () (my-string-set! (cp "あaう") -2 #\z)))
407(assert-error  (tn) (lambda () (my-string-set! (cp "あaう") -1 #\z)))
408(assert-equal? (tn) "zaう"     (my-string-set! (cp "あaう") 0 #\z))
409(assert-equal? (tn) "あzう"    (my-string-set! (cp "あaう") 1 #\z))
410(assert-equal? (tn) "あaz"     (my-string-set! (cp "あaう") 2 #\z))
411(assert-error  (tn) (lambda () (my-string-set! (cp "あaう") 3 #\z)))
412(assert-error  (tn) (lambda () (my-string-set! (cp "あaう") 4 #\z)))
413(assert-error  (tn) (lambda () (my-string-set! (cp "aあbう") -2 #\z)))
414(assert-error  (tn) (lambda () (my-string-set! (cp "aあbう") -1 #\z)))
415(assert-equal? (tn) "zあbう"   (my-string-set! (cp "aあbう") 0 #\z))
416(assert-equal? (tn) "azbう"    (my-string-set! (cp "aあbう") 1 #\z))
417(assert-equal? (tn) "aあzう"   (my-string-set! (cp "aあbう") 2 #\z))
418(assert-equal? (tn) "aあbz"    (my-string-set! (cp "aあbう") 3 #\z))
419(assert-error  (tn) (lambda () (my-string-set! (cp "aあbう") 4 #\z)))
420(assert-error  (tn) (lambda () (my-string-set! (cp "aあbう") 5 #\z)))
421(assert-error  (tn) (lambda () (my-string-set! (cp "あaうb") -2 #\z)))
422(assert-error  (tn) (lambda () (my-string-set! (cp "あaうb") -1 #\z)))
423(assert-equal? (tn) "zaうb"    (my-string-set! (cp "あaうb") 0 #\z))
424(assert-equal? (tn) "あzうb"   (my-string-set! (cp "あaうb") 1 #\z))
425(assert-equal? (tn) "あazb"    (my-string-set! (cp "あaうb") 2 #\z))
426(assert-equal? (tn) "あaうz"   (my-string-set! (cp "あaうb") 3 #\z))
427(assert-error  (tn) (lambda () (my-string-set! (cp "あaうb") 4 #\z)))
428(assert-error  (tn) (lambda () (my-string-set! (cp "あaうb") 5 #\z)))
429(tn "string-set! multibyte mutable")
430(assert-error  (tn) (lambda () (my-string-set! (cp "") -2 #\ん)))
431(assert-error  (tn) (lambda () (my-string-set! (cp "") -1 #\ん)))
432(assert-error  (tn) (lambda () (my-string-set! (cp "") 0 #\ん)))
433(assert-error  (tn) (lambda () (my-string-set! (cp "") 1 #\ん)))
434(assert-error  (tn) (lambda () (my-string-set! (cp "") 2 #\ん)))
435(assert-error  (tn) (lambda () (my-string-set! (cp "a") -2 #\ん)))
436(assert-error  (tn) (lambda () (my-string-set! (cp "a") -1 #\ん)))
437(assert-equal? (tn) "ん"       (my-string-set! (cp "a") 0 #\ん))
438(assert-error  (tn) (lambda () (my-string-set! (cp "a") 1 #\ん)))
439(assert-error  (tn) (lambda () (my-string-set! (cp "a") 2 #\ん)))
440(assert-error  (tn) (lambda () (my-string-set! (cp "ab") -2 #\ん)))
441(assert-error  (tn) (lambda () (my-string-set! (cp "ab") -1 #\ん)))
442(assert-equal? (tn) "んb"      (my-string-set! (cp "ab") 0 #\ん))
443(assert-equal? (tn) "aん"      (my-string-set! (cp "ab") 1 #\ん))
444(assert-error  (tn) (lambda () (my-string-set! (cp "ab") 2 #\ん)))
445(assert-error  (tn) (lambda () (my-string-set! (cp "ab") 3 #\ん)))
446(assert-error  (tn) (lambda () (my-string-set! (cp "あ") -2 #\ん)))
447(assert-error  (tn) (lambda () (my-string-set! (cp "あ") -1 #\ん)))
448(assert-equal? (tn) "ん"       (my-string-set! (cp "あ") 0 #\ん))
449(assert-error  (tn) (lambda () (my-string-set! (cp "あ") 1 #\ん)))
450(assert-error  (tn) (lambda () (my-string-set! (cp "あ") 2 #\ん)))
451(assert-error  (tn) (lambda () (my-string-set! (cp "あう") -2 #\ん)))
452(assert-error  (tn) (lambda () (my-string-set! (cp "あう") -1 #\ん)))
453(assert-equal? (tn) "んう"     (my-string-set! (cp "あう") 0 #\ん))
454(assert-equal? (tn) "あん"     (my-string-set! (cp "あう") 1 #\ん))
455(assert-error  (tn) (lambda () (my-string-set! (cp "あう") 2 #\ん)))
456(assert-error  (tn) (lambda () (my-string-set! (cp "あう") 3 #\ん)))
457(assert-error  (tn) (lambda () (my-string-set! (cp "aあb") -2 #\ん)))
458(assert-error  (tn) (lambda () (my-string-set! (cp "aあb") -1 #\ん)))
459(assert-equal? (tn) "んあb"    (my-string-set! (cp "aあb") 0 #\ん))
460(assert-equal? (tn) "aんb"     (my-string-set! (cp "aあb") 1 #\ん))
461(assert-equal? (tn) "aあん"    (my-string-set! (cp "aあb") 2 #\ん))
462(assert-error  (tn) (lambda () (my-string-set! (cp "aあb") 3 #\ん)))
463(assert-error  (tn) (lambda () (my-string-set! (cp "aあb") 4 #\ん)))
464(assert-error  (tn) (lambda () (my-string-set! (cp "あaう") -2 #\ん)))
465(assert-error  (tn) (lambda () (my-string-set! (cp "あaう") -1 #\ん)))
466(assert-equal? (tn) "んaう"    (my-string-set! (cp "あaう") 0 #\ん))
467(assert-equal? (tn) "あんう"   (my-string-set! (cp "あaう") 1 #\ん))
468(assert-equal? (tn) "あaん"    (my-string-set! (cp "あaう") 2 #\ん))
469(assert-error  (tn) (lambda () (my-string-set! (cp "あaう") 3 #\ん)))
470(assert-error  (tn) (lambda () (my-string-set! (cp "あaう") 4 #\ん)))
471(assert-error  (tn) (lambda () (my-string-set! (cp "aあbう") -2 #\ん)))
472(assert-error  (tn) (lambda () (my-string-set! (cp "aあbう") -1 #\ん)))
473(assert-equal? (tn) "んあbう"  (my-string-set! (cp "aあbう") 0 #\ん))
474(assert-equal? (tn) "aんbう"   (my-string-set! (cp "aあbう") 1 #\ん))
475(assert-equal? (tn) "aあんう"  (my-string-set! (cp "aあbう") 2 #\ん))
476(assert-equal? (tn) "aあbん"   (my-string-set! (cp "aあbう") 3 #\ん))
477(assert-error  (tn) (lambda () (my-string-set! (cp "aあbう") 4 #\ん)))
478(assert-error  (tn) (lambda () (my-string-set! (cp "aあbう") 5 #\ん)))
479(assert-error  (tn) (lambda () (my-string-set! (cp "あaうb") -2 #\ん)))
480(assert-error  (tn) (lambda () (my-string-set! (cp "あaうb") -1 #\ん)))
481(assert-equal? (tn) "んaうb"   (my-string-set! (cp "あaうb") 0 #\ん))
482(assert-equal? (tn) "あんうb"  (my-string-set! (cp "あaうb") 1 #\ん))
483(assert-equal? (tn) "あaんb"   (my-string-set! (cp "あaうb") 2 #\ん))
484(assert-equal? (tn) "あaうん"  (my-string-set! (cp "あaうb") 3 #\ん))
485(assert-error  (tn) (lambda () (my-string-set! (cp "あaうb") 4 #\ん)))
486(assert-error  (tn) (lambda () (my-string-set! (cp "あaうb") 5 #\ん)))
487(tn "string-set! NUL mutable")
488(if (and sigscheme?
489         (not (provided? "null-capable-string")))
490    (begin
491      (assert-error  (tn) (lambda () (string-set! (cp "") -2 #x00)))
492      (assert-error  (tn) (lambda () (string-set! (cp "") -1 #x00)))
493      (assert-error  (tn) (lambda () (string-set! (cp "") 0 #x00)))
494      (assert-error  (tn) (lambda () (string-set! (cp "") 1 #x00)))
495      (assert-error  (tn) (lambda () (string-set! (cp "") 2 #x00)))
496      (assert-error  (tn) (lambda () (string-set! (cp "a") -2 #x00)))
497      (assert-error  (tn) (lambda () (string-set! (cp "a") -1 #x00)))
498      (assert-error  (tn) (lambda () (string-set! (cp "a") 0 #x00)))
499      (assert-error  (tn) (lambda () (string-set! (cp "a") 1 #x00)))
500      (assert-error  (tn) (lambda () (string-set! (cp "a") 2 #x00)))
501      (assert-error  (tn) (lambda () (string-set! (cp "ab") -2 #x00)))
502      (assert-error  (tn) (lambda () (string-set! (cp "ab") -1 #x00)))
503      (assert-error  (tn) (lambda () (string-set! (cp "ab") 0 #x00)))
504      (assert-error  (tn) (lambda () (string-set! (cp "ab") 1 #x00)))
505      (assert-error  (tn) (lambda () (string-set! (cp "ab") 2 #x00)))
506      (assert-error  (tn) (lambda () (string-set! (cp "ab") 3 #x00)))
507      (assert-error  (tn) (lambda () (string-set! (cp "あ") -2 #x00)))
508      (assert-error  (tn) (lambda () (string-set! (cp "あ") -1 #x00)))
509      (assert-error  (tn) (lambda () (string-set! (cp "あ") 0 #x00)))
510      (assert-error  (tn) (lambda () (string-set! (cp "あ") 1 #x00)))
511      (assert-error  (tn) (lambda () (string-set! (cp "あ") 2 #x00)))
512      (assert-error  (tn) (lambda () (string-set! (cp "あう") -2 #x00)))
513      (assert-error  (tn) (lambda () (string-set! (cp "あう") -1 #x00)))
514      (assert-error  (tn) (lambda () (string-set! (cp "あう") 0 #x00)))
515      (assert-error  (tn) (lambda () (string-set! (cp "あう") 1 #x00)))
516      (assert-error  (tn) (lambda () (string-set! (cp "あう") 2 #x00)))
517      (assert-error  (tn) (lambda () (string-set! (cp "あう") 3 #x00)))
518      (assert-error  (tn) (lambda () (string-set! (cp "aあb") -2 #x00)))
519      (assert-error  (tn) (lambda () (string-set! (cp "aあb") -1 #x00)))
520      (assert-error  (tn) (lambda () (string-set! (cp "aあb") 0 #x00)))
521      (assert-error  (tn) (lambda () (string-set! (cp "aあb") 1 #x00)))
522      (assert-error  (tn) (lambda () (string-set! (cp "aあb") 2 #x00)))
523      (assert-error  (tn) (lambda () (string-set! (cp "aあb") 3 #x00)))
524      (assert-error  (tn) (lambda () (string-set! (cp "aあb") 4 #x00)))
525      (assert-error  (tn) (lambda () (string-set! (cp "あaう") -2 #x00)))
526      (assert-error  (tn) (lambda () (string-set! (cp "あaう") -1 #x00)))
527      (assert-error  (tn) (lambda () (string-set! (cp "あaう") 0 #x00)))
528      (assert-error  (tn) (lambda () (string-set! (cp "あaう") 1 #x00)))
529      (assert-error  (tn) (lambda () (string-set! (cp "あaう") 2 #x00)))
530      (assert-error  (tn) (lambda () (string-set! (cp "あaう") 3 #x00)))
531      (assert-error  (tn) (lambda () (string-set! (cp "あaう") 4 #x00)))
532      (assert-error  (tn) (lambda () (string-set! (cp "aあbう") -2 #x00)))
533      (assert-error  (tn) (lambda () (string-set! (cp "aあbう") -1 #x00)))
534      (assert-error  (tn) (lambda () (string-set! (cp "aあbう") 0 #x00)))
535      (assert-error  (tn) (lambda () (string-set! (cp "aあbう") 1 #x00)))
536      (assert-error  (tn) (lambda () (string-set! (cp "aあbう") 2 #x00)))
537      (assert-error  (tn) (lambda () (string-set! (cp "aあbう") 3 #x00)))
538      (assert-error  (tn) (lambda () (string-set! (cp "aあbう") 4 #x00)))
539      (assert-error  (tn) (lambda () (string-set! (cp "aあbう") 5 #x00)))
540      (assert-error  (tn) (lambda () (string-set! (cp "あaうb") -2 #x00)))
541      (assert-error  (tn) (lambda () (string-set! (cp "あaうb") -1 #x00)))
542      (assert-error  (tn) (lambda () (string-set! (cp "あaうb") 0 #x00)))
543      (assert-error  (tn) (lambda () (string-set! (cp "あaうb") 1 #x00)))
544      (assert-error  (tn) (lambda () (string-set! (cp "あaうb") 2 #x00)))
545      (assert-error  (tn) (lambda () (string-set! (cp "あaうb") 3 #x00)))
546      (assert-error  (tn) (lambda () (string-set! (cp "あaうb") 4 #x00)))
547      (assert-error  (tn) (lambda () (string-set! (cp "あaうb") 5 #x00)))))
548;; Tests for the bug fixed in r5040
549(tn "string-set! multibyte char modification")
550(assert-equal? (tn) "Aabcde" (my-string-set! (cp "あabcde") 0 #\A))
551(assert-equal? (tn) "Aaう"   (my-string-set! (cp "あaう")   0 #\A))
552(assert-equal? (tn) "Aaうb"  (my-string-set! (cp "あaうb")  0 #\A))
553
554(tn "substring invalid forms")
555(assert-error  (tn) (lambda () (substring #\a 0 0)))
556(assert-error  (tn) (lambda () (substring "" #\0 0)))
557(assert-error  (tn) (lambda () (substring "" 0 #\0)))
558(tn "substring length 0 immutable")
559(assert-error  (tn) (lambda () (substring "" -1 -2)))
560(assert-error  (tn) (lambda () (substring "" -1 -1)))
561(assert-error  (tn) (lambda () (substring "" -1 0)))
562(assert-error  (tn) (lambda () (substring "" -1 1)))
563(assert-error  (tn) (lambda () (substring "" 0 -1)))
564(assert-equal? (tn) ""         (substring "" 0 0))
565(assert-error  (tn) (lambda () (substring "" 0 1)))
566(assert-error  (tn) (lambda () (substring "" 1 -1)))
567(assert-error  (tn) (lambda () (substring "" 1 0)))
568(assert-error  (tn) (lambda () (substring "" 1 1)))
569(assert-error  (tn) (lambda () (substring "" 1 2)))
570(assert-error  (tn) (lambda () (substring "" 2 -1)))
571(assert-error  (tn) (lambda () (substring "" 2 0)))
572(assert-error  (tn) (lambda () (substring "" 2 1)))
573(assert-error  (tn) (lambda () (substring "" 2 2)))
574(assert-error  (tn) (lambda () (substring "" 2 3)))
575(tn "substring length 1 immutable")
576(assert-error  (tn) (lambda () (substring "a" -1 -2)))
577(assert-error  (tn) (lambda () (substring "a" -1 -1)))
578(assert-error  (tn) (lambda () (substring "a" -1 0)))
579(assert-error  (tn) (lambda () (substring "a" -1 1)))
580(assert-error  (tn) (lambda () (substring "a" 0 -1)))
581(assert-equal? (tn) ""         (substring "a" 0 0))
582(assert-equal? (tn) "a"        (substring "a" 0 1))
583(assert-error  (tn) (lambda () (substring "a" 0 2)))
584(assert-error  (tn) (lambda () (substring "a" 1 -1)))
585(assert-error  (tn) (lambda () (substring "a" 1 0)))
586(assert-equal? (tn) ""         (substring "a" 1 1))
587(assert-error  (tn) (lambda () (substring "a" 1 2)))
588(assert-error  (tn) (lambda () (substring "a" 2 -1)))
589(assert-error  (tn) (lambda () (substring "a" 2 0)))
590(assert-error  (tn) (lambda () (substring "a" 2 1)))
591(assert-error  (tn) (lambda () (substring "a" 2 2)))
592(assert-error  (tn) (lambda () (substring "a" 2 3)))
593(tn "substring length 2 immutable")
594(assert-error  (tn) (lambda () (substring "ab" -1 -2)))
595(assert-error  (tn) (lambda () (substring "ab" -1 -1)))
596(assert-error  (tn) (lambda () (substring "ab" -1 0)))
597(assert-error  (tn) (lambda () (substring "ab" -1 1)))
598(assert-error  (tn) (lambda () (substring "ab" 0 -1)))
599(assert-equal? (tn) ""         (substring "ab" 0 0))
600(assert-equal? (tn) "a"        (substring "ab" 0 1))
601(assert-equal? (tn) "ab"       (substring "ab" 0 2))
602(assert-error  (tn) (lambda () (substring "ab" 0 3)))
603(assert-error  (tn) (lambda () (substring "ab" 1 -1)))
604(assert-error  (tn) (lambda () (substring "ab" 1 0)))
605(assert-equal? (tn) ""         (substring "ab" 1 1))
606(assert-equal? (tn) "b"        (substring "ab" 1 2))
607(assert-error  (tn) (lambda () (substring "ab" 1 3)))
608(assert-error  (tn) (lambda () (substring "ab" 2 -1)))
609(assert-error  (tn) (lambda () (substring "ab" 2 0)))
610(assert-error  (tn) (lambda () (substring "ab" 2 1)))
611(assert-equal? (tn) ""         (substring "ab" 2 2))
612(assert-error  (tn) (lambda () (substring "ab" 2 3)))
613(assert-error  (tn) (lambda () (substring "ab" 3 -1)))
614(assert-error  (tn) (lambda () (substring "ab" 3 0)))
615(assert-error  (tn) (lambda () (substring "ab" 3 1)))
616(assert-error  (tn) (lambda () (substring "ab" 3 2)))
617(assert-error  (tn) (lambda () (substring "ab" 3 3)))
618(assert-error  (tn) (lambda () (substring "ab" 3 4)))
619(tn "substring length 3 immutable")
620(assert-error  (tn) (lambda () (substring "abc" -1 -2)))
621(assert-error  (tn) (lambda () (substring "abc" -1 -1)))
622(assert-error  (tn) (lambda () (substring "abc" -1 0)))
623(assert-error  (tn) (lambda () (substring "abc" -1 1)))
624(assert-error  (tn) (lambda () (substring "abc" 0 -1)))
625(assert-equal? (tn) ""         (substring "abc" 0 0))
626(assert-equal? (tn) "a"        (substring "abc" 0 1))
627(assert-equal? (tn) "ab"       (substring "abc" 0 2))
628(assert-equal? (tn) "abc"      (substring "abc" 0 3))
629(assert-error  (tn) (lambda () (substring "abc" 0 4)))
630(assert-error  (tn) (lambda () (substring "abc" 1 -1)))
631(assert-error  (tn) (lambda () (substring "abc" 1 0)))
632(assert-equal? (tn) ""         (substring "abc" 1 1))
633(assert-equal? (tn) "b"        (substring "abc" 1 2))
634(assert-equal? (tn) "bc"       (substring "abc" 1 3))
635(assert-error  (tn) (lambda () (substring "abc" 1 4)))
636(assert-error  (tn) (lambda () (substring "abc" 2 -1)))
637(assert-error  (tn) (lambda () (substring "abc" 2 0)))
638(assert-error  (tn) (lambda () (substring "abc" 2 1)))
639(assert-equal? (tn) ""         (substring "abc" 2 2))
640(assert-equal? (tn) "c"        (substring "abc" 2 3))
641(assert-error  (tn) (lambda () (substring "abc" 2 4)))
642(assert-error  (tn) (lambda () (substring "abc" 3 -1)))
643(assert-error  (tn) (lambda () (substring "abc" 3 0)))
644(assert-error  (tn) (lambda () (substring "abc" 3 1)))
645(assert-error  (tn) (lambda () (substring "abc" 3 2)))
646(assert-equal? (tn) ""         (substring "abc" 3 3))
647(assert-error  (tn) (lambda () (substring "abc" 3 4)))
648(assert-error  (tn) (lambda () (substring "abc" 4 -1)))
649(assert-error  (tn) (lambda () (substring "abc" 4 0)))
650(assert-error  (tn) (lambda () (substring "abc" 4 1)))
651(assert-error  (tn) (lambda () (substring "abc" 4 2)))
652(assert-error  (tn) (lambda () (substring "abc" 4 3)))
653(assert-error  (tn) (lambda () (substring "abc" 4 4)))
654(assert-error  (tn) (lambda () (substring "abc" 4 5)))
655(tn "substring length 4 immutable")
656(assert-error  (tn) (lambda () (substring "abcd" -1 -2)))
657(assert-error  (tn) (lambda () (substring "abcd" -1 -1)))
658(assert-error  (tn) (lambda () (substring "abcd" -1 0)))
659(assert-error  (tn) (lambda () (substring "abcd" -1 1)))
660(assert-error  (tn) (lambda () (substring "abcd" 0 -1)))
661(assert-equal? (tn) ""         (substring "abcd" 0 0))
662(assert-equal? (tn) "a"        (substring "abcd" 0 1))
663(assert-equal? (tn) "ab"       (substring "abcd" 0 2))
664(assert-equal? (tn) "abc"      (substring "abcd" 0 3))
665(assert-equal? (tn) "abcd"     (substring "abcd" 0 4))
666(assert-error  (tn) (lambda () (substring "abcd" 0 5)))
667(assert-error  (tn) (lambda () (substring "abcd" 1 -1)))
668(assert-error  (tn) (lambda () (substring "abcd" 1 0)))
669(assert-equal? (tn) ""         (substring "abcd" 1 1))
670(assert-equal? (tn) "b"        (substring "abcd" 1 2))
671(assert-equal? (tn) "bc"       (substring "abcd" 1 3))
672(assert-equal? (tn) "bcd"      (substring "abcd" 1 4))
673(assert-error  (tn) (lambda () (substring "abcd" 1 5)))
674(assert-error  (tn) (lambda () (substring "abcd" 2 -1)))
675(assert-error  (tn) (lambda () (substring "abcd" 2 0)))
676(assert-error  (tn) (lambda () (substring "abcd" 2 1)))
677(assert-equal? (tn) ""         (substring "abcd" 2 2))
678(assert-equal? (tn) "c"        (substring "abcd" 2 3))
679(assert-equal? (tn) "cd"       (substring "abcd" 2 4))
680(assert-error  (tn) (lambda () (substring "abcd" 2 5)))
681(assert-error  (tn) (lambda () (substring "abcd" 3 -1)))
682(assert-error  (tn) (lambda () (substring "abcd" 3 0)))
683(assert-error  (tn) (lambda () (substring "abcd" 3 1)))
684(assert-error  (tn) (lambda () (substring "abcd" 3 2)))
685(assert-equal? (tn) ""         (substring "abcd" 3 3))
686(assert-equal? (tn) "d"        (substring "abcd" 3 4))
687(assert-error  (tn) (lambda () (substring "abcd" 3 5)))
688(assert-error  (tn) (lambda () (substring "abcd" 4 -1)))
689(assert-error  (tn) (lambda () (substring "abcd" 4 0)))
690(assert-error  (tn) (lambda () (substring "abcd" 4 1)))
691(assert-error  (tn) (lambda () (substring "abcd" 4 2)))
692(assert-error  (tn) (lambda () (substring "abcd" 4 3)))
693(assert-equal? (tn) ""         (substring "abcd" 4 4))
694(assert-error  (tn) (lambda () (substring "abcd" 4 5)))
695(assert-error  (tn) (lambda () (substring "abcd" 5 -1)))
696(assert-error  (tn) (lambda () (substring "abcd" 5 0)))
697(assert-error  (tn) (lambda () (substring "abcd" 5 1)))
698(assert-error  (tn) (lambda () (substring "abcd" 5 2)))
699(assert-error  (tn) (lambda () (substring "abcd" 5 3)))
700(assert-error  (tn) (lambda () (substring "abcd" 5 4)))
701(assert-error  (tn) (lambda () (substring "abcd" 5 5)))
702(assert-error  (tn) (lambda () (substring "abcd" 5 6)))
703
704(tn "substring multibyte length 1 immutable")
705(assert-error  (tn) (lambda () (substring "あ" -1 -2)))
706(assert-error  (tn) (lambda () (substring "あ" -1 -1)))
707(assert-error  (tn) (lambda () (substring "あ" -1 0)))
708(assert-error  (tn) (lambda () (substring "あ" -1 1)))
709(assert-error  (tn) (lambda () (substring "あ" 0 -1)))
710(assert-equal? (tn) ""         (substring "あ" 0 0))
711(assert-equal? (tn) "あ"       (substring "あ" 0 1))
712(assert-error  (tn) (lambda () (substring "あ" 0 2)))
713(assert-error  (tn) (lambda () (substring "あ" 1 -1)))
714(assert-error  (tn) (lambda () (substring "あ" 1 0)))
715(assert-equal? (tn) ""         (substring "あ" 1 1))
716(assert-error  (tn) (lambda () (substring "あ" 1 2)))
717(assert-error  (tn) (lambda () (substring "あ" 2 -1)))
718(assert-error  (tn) (lambda () (substring "あ" 2 0)))
719(assert-error  (tn) (lambda () (substring "あ" 2 1)))
720(assert-error  (tn) (lambda () (substring "あ" 2 2)))
721(assert-error  (tn) (lambda () (substring "あ" 2 3)))
722(tn "substring multibyte length 2 immutable")
723(assert-error  (tn) (lambda () (substring "あい" -1 -2)))
724(assert-error  (tn) (lambda () (substring "あい" -1 -1)))
725(assert-error  (tn) (lambda () (substring "あい" -1 0)))
726(assert-error  (tn) (lambda () (substring "あい" -1 1)))
727(assert-error  (tn) (lambda () (substring "あい" 0 -1)))
728(assert-equal? (tn) ""         (substring "あい" 0 0))
729(assert-equal? (tn) "あ"       (substring "あい" 0 1))
730(assert-equal? (tn) "あい"     (substring "あい" 0 2))
731(assert-error  (tn) (lambda () (substring "あい" 0 3)))
732(assert-error  (tn) (lambda () (substring "あい" 1 -1)))
733(assert-error  (tn) (lambda () (substring "あい" 1 0)))
734(assert-equal? (tn) ""         (substring "あい" 1 1))
735(assert-equal? (tn) "い"       (substring "あい" 1 2))
736(assert-error  (tn) (lambda () (substring "あい" 1 3)))
737(assert-error  (tn) (lambda () (substring "あい" 2 -1)))
738(assert-error  (tn) (lambda () (substring "あい" 2 0)))
739(assert-error  (tn) (lambda () (substring "あい" 2 1)))
740(assert-equal? (tn) ""         (substring "あい" 2 2))
741(assert-error  (tn) (lambda () (substring "あい" 2 3)))
742(assert-error  (tn) (lambda () (substring "あい" 3 -1)))
743(assert-error  (tn) (lambda () (substring "あい" 3 0)))
744(assert-error  (tn) (lambda () (substring "あい" 3 1)))
745(assert-error  (tn) (lambda () (substring "あい" 3 2)))
746(assert-error  (tn) (lambda () (substring "あい" 3 3)))
747(assert-error  (tn) (lambda () (substring "あい" 3 4)))
748(tn "substring multibyte length 3 immutable")
749(assert-error  (tn) (lambda () (substring "あいう" -1 -2)))
750(assert-error  (tn) (lambda () (substring "あいう" -1 -1)))
751(assert-error  (tn) (lambda () (substring "あいう" -1 0)))
752(assert-error  (tn) (lambda () (substring "あいう" -1 1)))
753(assert-error  (tn) (lambda () (substring "あいう" 0 -1)))
754(assert-equal? (tn) ""         (substring "あいう" 0 0))
755(assert-equal? (tn) "あ"       (substring "あいう" 0 1))
756(assert-equal? (tn) "あい"     (substring "あいう" 0 2))
757(assert-equal? (tn) "あいう"   (substring "あいう" 0 3))
758(assert-error  (tn) (lambda () (substring "あいう" 0 4)))
759(assert-error  (tn) (lambda () (substring "あいう" 1 -1)))
760(assert-error  (tn) (lambda () (substring "あいう" 1 0)))
761(assert-equal? (tn) ""         (substring "あいう" 1 1))
762(assert-equal? (tn) "い"       (substring "あいう" 1 2))
763(assert-equal? (tn) "いう"     (substring "あいう" 1 3))
764(assert-error  (tn) (lambda () (substring "あいう" 1 4)))
765(assert-error  (tn) (lambda () (substring "あいう" 2 -1)))
766(assert-error  (tn) (lambda () (substring "あいう" 2 0)))
767(assert-error  (tn) (lambda () (substring "あいう" 2 1)))
768(assert-equal? (tn) ""         (substring "あいう" 2 2))
769(assert-equal? (tn) "う"       (substring "あいう" 2 3))
770(assert-error  (tn) (lambda () (substring "あいう" 2 4)))
771(assert-error  (tn) (lambda () (substring "あいう" 3 -1)))
772(assert-error  (tn) (lambda () (substring "あいう" 3 0)))
773(assert-error  (tn) (lambda () (substring "あいう" 3 1)))
774(assert-error  (tn) (lambda () (substring "あいう" 3 2)))
775(assert-equal? (tn) ""         (substring "あいう" 3 3))
776(assert-error  (tn) (lambda () (substring "あいう" 3 4)))
777(assert-error  (tn) (lambda () (substring "あいう" 4 -1)))
778(assert-error  (tn) (lambda () (substring "あいう" 4 0)))
779(assert-error  (tn) (lambda () (substring "あいう" 4 1)))
780(assert-error  (tn) (lambda () (substring "あいう" 4 2)))
781(assert-error  (tn) (lambda () (substring "あいう" 4 3)))
782(assert-error  (tn) (lambda () (substring "あいう" 4 4)))
783(assert-error  (tn) (lambda () (substring "あいう" 4 5)))
784(tn "substring multibyte length 4 immutable")
785(assert-error  (tn) (lambda () (substring "あいうえ" -1 -2)))
786(assert-error  (tn) (lambda () (substring "あいうえ" -1 -1)))
787(assert-error  (tn) (lambda () (substring "あいうえ" -1 0)))
788(assert-error  (tn) (lambda () (substring "あいうえ" -1 1)))
789(assert-error  (tn) (lambda () (substring "あいうえ" 0 -1)))
790(assert-equal? (tn) ""         (substring "あいうえ" 0 0))
791(assert-equal? (tn) "あ"       (substring "あいうえ" 0 1))
792(assert-equal? (tn) "あい"     (substring "あいうえ" 0 2))
793(assert-equal? (tn) "あいう"   (substring "あいうえ" 0 3))
794(assert-equal? (tn) "あいうえ" (substring "あいうえ" 0 4))
795(assert-error  (tn) (lambda () (substring "あいうえ" 0 5)))
796(assert-error  (tn) (lambda () (substring "あいうえ" 1 -1)))
797(assert-error  (tn) (lambda () (substring "あいうえ" 1 0)))
798(assert-equal? (tn) ""         (substring "あいうえ" 1 1))
799(assert-equal? (tn) "い"       (substring "あいうえ" 1 2))
800(assert-equal? (tn) "いう"     (substring "あいうえ" 1 3))
801(assert-equal? (tn) "いうえ"   (substring "あいうえ" 1 4))
802(assert-error  (tn) (lambda () (substring "あいうえ" 1 5)))
803(assert-error  (tn) (lambda () (substring "あいうえ" 2 -1)))
804(assert-error  (tn) (lambda () (substring "あいうえ" 2 0)))
805(assert-error  (tn) (lambda () (substring "あいうえ" 2 1)))
806(assert-equal? (tn) ""         (substring "あいうえ" 2 2))
807(assert-equal? (tn) "う"       (substring "あいうえ" 2 3))
808(assert-equal? (tn) "うえ"     (substring "あいうえ" 2 4))
809(assert-error  (tn) (lambda () (substring "あいうえ" 2 5)))
810(assert-error  (tn) (lambda () (substring "あいうえ" 3 -1)))
811(assert-error  (tn) (lambda () (substring "あいうえ" 3 0)))
812(assert-error  (tn) (lambda () (substring "あいうえ" 3 1)))
813(assert-error  (tn) (lambda () (substring "あいうえ" 3 2)))
814(assert-equal? (tn) ""         (substring "あいうえ" 3 3))
815(assert-equal? (tn) "え"       (substring "あいうえ" 3 4))
816(assert-error  (tn) (lambda () (substring "あいうえ" 3 5)))
817(assert-error  (tn) (lambda () (substring "あいうえ" 4 -1)))
818(assert-error  (tn) (lambda () (substring "あいうえ" 4 0)))
819(assert-error  (tn) (lambda () (substring "あいうえ" 4 1)))
820(assert-error  (tn) (lambda () (substring "あいうえ" 4 2)))
821(assert-error  (tn) (lambda () (substring "あいうえ" 4 3)))
822(assert-equal? (tn) ""         (substring "あいうえ" 4 4))
823(assert-error  (tn) (lambda () (substring "あいうえ" 4 5)))
824(assert-error  (tn) (lambda () (substring "あいうえ" 5 -1)))
825(assert-error  (tn) (lambda () (substring "あいうえ" 5 0)))
826(assert-error  (tn) (lambda () (substring "あいうえ" 5 1)))
827(assert-error  (tn) (lambda () (substring "あいうえ" 5 2)))
828(assert-error  (tn) (lambda () (substring "あいうえ" 5 3)))
829(assert-error  (tn) (lambda () (substring "あいうえ" 5 4)))
830(assert-error  (tn) (lambda () (substring "あいうえ" 5 5)))
831(assert-error  (tn) (lambda () (substring "あいうえ" 5 6)))
832
833(tn "substring mixed multibyte and singlebyte immutable")
834(assert-error  (tn) (lambda () (substring "aいuえ" -1 -2)))
835(assert-error  (tn) (lambda () (substring "aいuえ" -1 -1)))
836(assert-error  (tn) (lambda () (substring "aいuえ" -1 0)))
837(assert-error  (tn) (lambda () (substring "aいuえ" -1 1)))
838(assert-error  (tn) (lambda () (substring "aいuえ" 0 -1)))
839(assert-equal? (tn) ""         (substring "aいuえ" 0 0))
840(assert-equal? (tn) "a"        (substring "aいuえ" 0 1))
841(assert-equal? (tn) "aい"      (substring "aいuえ" 0 2))
842(assert-equal? (tn) "aいu"     (substring "aいuえ" 0 3))
843(assert-equal? (tn) "aいuえ"   (substring "aいuえ" 0 4))
844(assert-error  (tn) (lambda () (substring "aいuえ" 0 5)))
845(assert-error  (tn) (lambda () (substring "aいuえ" 1 -1)))
846(assert-error  (tn) (lambda () (substring "aいuえ" 1 0)))
847(assert-equal? (tn) ""         (substring "aいuえ" 1 1))
848(assert-equal? (tn) "い"       (substring "aいuえ" 1 2))
849(assert-equal? (tn) "いu"      (substring "aいuえ" 1 3))
850(assert-equal? (tn) "いuえ"    (substring "aいuえ" 1 4))
851(assert-error  (tn) (lambda () (substring "aいuえ" 1 5)))
852(assert-error  (tn) (lambda () (substring "aいuえ" 2 -1)))
853(assert-error  (tn) (lambda () (substring "aいuえ" 2 0)))
854(assert-error  (tn) (lambda () (substring "aいuえ" 2 1)))
855(assert-equal? (tn) ""         (substring "aいuえ" 2 2))
856(assert-equal? (tn) "u"        (substring "aいuえ" 2 3))
857(assert-equal? (tn) "uえ"      (substring "aいuえ" 2 4))
858(assert-error  (tn) (lambda () (substring "aいuえ" 2 5)))
859(assert-error  (tn) (lambda () (substring "aいuえ" 3 -1)))
860(assert-error  (tn) (lambda () (substring "aいuえ" 3 0)))
861(assert-error  (tn) (lambda () (substring "aいuえ" 3 1)))
862(assert-error  (tn) (lambda () (substring "aいuえ" 3 2)))
863(assert-equal? (tn) ""         (substring "aいuえ" 3 3))
864(assert-equal? (tn) "え"       (substring "aいuえ" 3 4))
865(assert-error  (tn) (lambda () (substring "aいuえ" 3 5)))
866(assert-error  (tn) (lambda () (substring "aいuえ" 4 -1)))
867(assert-error  (tn) (lambda () (substring "aいuえ" 4 0)))
868(assert-error  (tn) (lambda () (substring "aいuえ" 4 1)))
869(assert-error  (tn) (lambda () (substring "aいuえ" 4 2)))
870(assert-error  (tn) (lambda () (substring "aいuえ" 4 3)))
871(assert-equal? (tn) ""         (substring "aいuえ" 4 4))
872(assert-error  (tn) (lambda () (substring "aいuえ" 4 5)))
873(assert-error  (tn) (lambda () (substring "aいuえ" 5 -1)))
874(assert-error  (tn) (lambda () (substring "aいuえ" 5 0)))
875(assert-error  (tn) (lambda () (substring "aいuえ" 5 1)))
876(assert-error  (tn) (lambda () (substring "aいuえ" 5 2)))
877(assert-error  (tn) (lambda () (substring "aいuえ" 5 3)))
878(assert-error  (tn) (lambda () (substring "aいuえ" 5 4)))
879(assert-error  (tn) (lambda () (substring "aいuえ" 5 5)))
880(assert-error  (tn) (lambda () (substring "aいuえ" 5 6)))
881
882(tn "substring mutable")
883(assert-equal? (tn) ""         (substring (cp "") 0 0))
884(assert-equal? (tn) "a"        (substring (cp "a") 0 1))
885(assert-equal? (tn) "あ"       (substring (cp "あ") 0 1))
886(assert-equal? (tn) "いuえ"    (substring (cp "aいuえ") 1 4))
887
888(tn "substring result mutability")
889(assert-true   (tn) (mutable?  (substring     ""        0 0)))
890(assert-true   (tn) (mutable?  (substring     "a"       0 1)))
891(assert-true   (tn) (mutable?  (substring     "あ"      0 1)))
892(assert-true   (tn) (mutable?  (substring     "aいuえ"  1 4)))
893(assert-true   (tn) (mutable?  (substring (cp "")       0 0)))
894(assert-true   (tn) (mutable?  (substring (cp "a")      0 1)))
895(assert-true   (tn) (mutable?  (substring (cp "あ")     0 1)))
896(assert-true   (tn) (mutable?  (substring (cp "aいuえ") 1 4)))
897
898
899(tn "string->list invalid forms")
900(assert-error  (tn) (lambda ()           (string->list '())))
901(assert-error  (tn) (lambda ()           (string->list '(#\a))))
902(assert-error  (tn) (lambda ()           (string->list #\a)))
903(tn "string->list immutable")
904(assert-equal? (tn) '()                  (string->list ""))
905(assert-equal? (tn) '(#\a)               (string->list "a"))
906(assert-equal? (tn) '(#\a #\b)           (string->list "ab"))
907(assert-equal? (tn) '(#\あ)              (string->list "あ"))
908(assert-equal? (tn) '(#\あ #\う)         (string->list "あう"))
909(assert-equal? (tn) '(#\a #\あ #\b)      (string->list "aあb"))
910(assert-equal? (tn) '(#\あ #\a #\う)     (string->list "あaう"))
911(assert-equal? (tn) '(#\a #\あ #\b #\う) (string->list "aあbう"))
912(assert-equal? (tn) '(#\あ #\a #\う #\b) (string->list "あaうb"))
913(tn "string->list mutable")
914(assert-equal? (tn) '()                  (string->list (cp "")))
915(assert-equal? (tn) '(#\a)               (string->list (cp "a")))
916(assert-equal? (tn) '(#\a #\b)           (string->list (cp "ab")))
917(assert-equal? (tn) '(#\あ)              (string->list (cp "あ")))
918(assert-equal? (tn) '(#\あ #\う)         (string->list (cp "あう")))
919(assert-equal? (tn) '(#\a #\あ #\b)      (string->list (cp "aあb")))
920(assert-equal? (tn) '(#\あ #\a #\う)     (string->list (cp "あaう")))
921(assert-equal? (tn) '(#\a #\あ #\b #\う) (string->list (cp "aあbう")))
922(assert-equal? (tn) '(#\あ #\a #\う #\b) (string->list (cp "あaうb")))
923(tn "string->list mutability")
924(assert-true   (tn) (pair-mutable?       (string->list "a")))
925(assert-true   (tn) (pair-mutable?       (string->list "ab")))
926(assert-true   (tn) (pair-mutable?       (string->list "あ")))
927(assert-true   (tn) (pair-mutable?       (string->list "あう")))
928(assert-true   (tn) (pair-mutable?       (string->list "aあb")))
929(assert-true   (tn) (pair-mutable?       (string->list "あaう")))
930(assert-true   (tn) (pair-mutable?       (string->list "aあbう")))
931(assert-true   (tn) (pair-mutable?       (string->list "あaうb")))
932
933(tn "list->string invalid forms")
934(assert-error (tn) (lambda ()  (list->string #t)))
935(assert-error (tn) (lambda ()  (list->string '(#t))))
936(assert-error (tn) (lambda ()  (list->string '(#\a . #t))))
937(tn "list->string")
938(assert-equal? (tn) ""         (list->string '()))
939(assert-equal? (tn) "a"        (list->string '(#\a)))
940(assert-equal? (tn) "ab"       (list->string '(#\a #\b)))
941(assert-equal? (tn) "あ"       (list->string '(#\あ)))
942(assert-equal? (tn) "あう"     (list->string '(#\あ #\う)))
943(assert-equal? (tn) "aあb"     (list->string '(#\a #\あ #\b)))
944(assert-equal? (tn) "あaう"    (list->string '(#\あ #\a #\う)))
945(assert-equal? (tn) "aあbう"   (list->string '(#\a #\あ #\b #\う)))
946(assert-equal? (tn) "あaうb"   (list->string '(#\あ #\a #\う #\b)))
947(tn "list->string mutability")
948(assert-true   (tn) (mutable?  (list->string '())))
949(assert-true   (tn) (mutable?  (list->string '(#\a))))
950(assert-true   (tn) (mutable?  (list->string '(#\a #\b))))
951(assert-true   (tn) (mutable?  (list->string '(#\あ))))
952(assert-true   (tn) (mutable?  (list->string '(#\あ #\う))))
953(assert-true   (tn) (mutable?  (list->string '(#\a #\あ #\b))))
954(assert-true   (tn) (mutable?  (list->string '(#\あ #\a #\う))))
955(assert-true   (tn) (mutable?  (list->string '(#\a #\あ #\b #\う))))
956(assert-true   (tn) (mutable?  (list->string '(#\あ #\a #\う #\b))))
957(tn "list->string with NUL args")
958(if (and sigscheme?
959         (not (provided? "null-capable-string")))
960    (begin
961      (assert-error (tn) (lambda () (list->string '(#x00))))
962      (assert-error (tn) (lambda () (list->string '(#\a #x00))))
963      (assert-error (tn) (lambda () (list->string '(#x00 #\a))))
964      (assert-error (tn) (lambda () (list->string '(#\a #x00 #\a))))))
965(tn "list->string improper lists")
966(assert-error (tn) (lambda () (list->string '(#\あ #\a #\う . #\b))))
967;; circular lists
968(define clst1 (list #\a))
969(set-cdr! clst1 clst1)
970(define clst2 (list #\a #\b))
971(set-cdr! (list-tail clst2 1) clst2)
972(define clst3 (list #\a #\b #\c))
973(set-cdr! (list-tail clst3 2) clst3)
974(define clst4 (list #\a #\b #\c #\d))
975(set-cdr! (list-tail clst4 3) clst4)
976(if (and sigscheme?
977         (provided? "strict-argcheck"))
978    (begin
979      (assert-error (tn) (lambda () (list->string clst1)))
980      (assert-error (tn) (lambda () (list->string clst2)))
981      (assert-error (tn) (lambda () (list->string clst3)))
982      (assert-error (tn) (lambda () (list->string clst4)))))
983
984(tn "string-fill! immutable")
985(assert-error  (tn) (lambda ()           (string-fill! "" #\z)))
986(assert-error  (tn) (lambda ()           (string-fill! "a" #\z)))
987(assert-error  (tn) (lambda ()           (string-fill! "ab" #\z)))
988(assert-error  (tn) (lambda ()           (string-fill! "あ" #\z)))
989(assert-error  (tn) (lambda ()           (string-fill! "あう" #\z)))
990(assert-error  (tn) (lambda ()           (string-fill! "aあb" #\z)))
991(assert-error  (tn) (lambda ()           (string-fill! "あaう" #\z)))
992(assert-error  (tn) (lambda ()           (string-fill! "aあbう" #\z)))
993(assert-error  (tn) (lambda ()           (string-fill! "あaうb" #\z)))
994(tn "string-fill! multibyte immutable")
995(assert-error  (tn) (lambda ()           (string-fill! "" #\ん)))
996(assert-error  (tn) (lambda ()           (string-fill! "a" #\ん)))
997(assert-error  (tn) (lambda ()           (string-fill! "ab" #\ん)))
998(assert-error  (tn) (lambda ()           (string-fill! "あ" #\ん)))
999(assert-error  (tn) (lambda ()           (string-fill! "あう" #\ん)))
1000(assert-error  (tn) (lambda ()           (string-fill! "aあb" #\ん)))
1001(assert-error  (tn) (lambda ()           (string-fill! "あaう" #\ん)))
1002(assert-error  (tn) (lambda ()           (string-fill! "aあbう" #\ん)))
1003(assert-error  (tn) (lambda ()           (string-fill! "あaうb" #\ん)))
1004
1005(define my-string-fill!
1006  (lambda (str ch)
1007    (string-fill! str ch)
1008    str))
1009(tn "string-fill! mutable")
1010(assert-equal? (tn) (undef)              (string-fill!    (cp "a") #\z))
1011(assert-equal? (tn) ""                   (my-string-fill! (cp "") #\z))
1012(assert-equal? (tn) "z"                  (my-string-fill! (cp "a") #\z))
1013(assert-equal? (tn) "zz"                 (my-string-fill! (cp "ab") #\z))
1014(assert-equal? (tn) "z"                  (my-string-fill! (cp "あ") #\z))
1015(assert-equal? (tn) "zz"                 (my-string-fill! (cp "あう") #\z))
1016(assert-equal? (tn) "zzz"                (my-string-fill! (cp "aあb") #\z))
1017(assert-equal? (tn) "zzz"                (my-string-fill! (cp "あaう") #\z))
1018(assert-equal? (tn) "zzzz"               (my-string-fill! (cp "aあbう") #\z))
1019(assert-equal? (tn) "zzzz"               (my-string-fill! (cp "あaうb") #\z))
1020(tn "string-fill! multibyte mutable")
1021(assert-equal? (tn) (undef)              (string-fill!    (cp "a") #\ん))
1022(assert-equal? (tn) ""                   (my-string-fill! (cp "") #\ん))
1023(assert-equal? (tn) "ん"                 (my-string-fill! (cp "a") #\ん))
1024(assert-equal? (tn) "んん"               (my-string-fill! (cp "ab") #\ん))
1025(assert-equal? (tn) "ん"                 (my-string-fill! (cp "あ") #\ん))
1026(assert-equal? (tn) "んん"               (my-string-fill! (cp "あう") #\ん))
1027(assert-equal? (tn) "んんん"             (my-string-fill! (cp "aあb") #\ん))
1028(assert-equal? (tn) "んんん"             (my-string-fill! (cp "あaう") #\ん))
1029(assert-equal? (tn) "んんんん"           (my-string-fill! (cp "aあbう") #\ん))
1030(assert-equal? (tn) "んんんん"           (my-string-fill! (cp "あaうb") #\ん))
1031(tn "string-fill! mutability")
1032(assert-true   (tn) (mutable?            (my-string-fill! (cp "") #\z)))
1033(assert-true   (tn) (mutable?            (my-string-fill! (cp "a") #\z)))
1034(assert-true   (tn) (mutable?            (my-string-fill! (cp "ab") #\z)))
1035(assert-true   (tn) (mutable?            (my-string-fill! (cp "あ") #\z)))
1036(assert-true   (tn) (mutable?            (my-string-fill! (cp "あう") #\z)))
1037(assert-true   (tn) (mutable?            (my-string-fill! (cp "aあb") #\z)))
1038(assert-true   (tn) (mutable?            (my-string-fill! (cp "あaう") #\z)))
1039(assert-true   (tn) (mutable?            (my-string-fill! (cp "aあbう") #\z)))
1040(assert-true   (tn) (mutable?            (my-string-fill! (cp "あaうb") #\z)))
1041
1042(tn "%%string-reconstruct!")
1043(assert-error  (tn) (lambda () (%%string-reconstruct! "")))
1044(assert-error  (tn) (lambda () (%%string-reconstruct! "const str")))
1045(assert-error  (tn) (lambda () (%%string-reconstruct! "あaう")))
1046(assert-equal? (tn) 0 (string-length (string-copy "")))
1047(assert-equal? (tn) 9 (string-length (string-copy "const str")))
1048(assert-equal? (tn) 3 (string-length (string-copy "あaう")))
1049(assert-equal? (tn) 0 (string-length (with-char-codec "ISO-8859-1"
1050                                       (lambda ()
1051                                         (%%string-reconstruct!
1052                                          (string-copy ""))))))
1053(assert-equal? (tn) 9 (string-length (with-char-codec "ISO-8859-1"
1054                                       (lambda ()
1055                                         (%%string-reconstruct!
1056                                          (string-copy "const str"))))))
1057(assert-equal? (tn) 7 (string-length (with-char-codec "ISO-8859-1"
1058                                       (lambda ()
1059                                         (%%string-reconstruct!
1060                                          (string-copy "あaう"))))))
1061(let ((byte-str (with-char-codec "ISO-8859-1"
1062                  (lambda ()
1063                    (%%string-reconstruct!
1064                     (string-copy "あaう"))))))
1065  (assert-equal? (tn) 7 (string-length byte-str))
1066  ;; reconstruct as UTF-8 string
1067  (assert-equal? (tn) 3 (string-length (%%string-reconstruct! byte-str))))
1068
1069(total-report)
1070