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