1;;; 5-5.ms 2;;; Copyright 1984-2017 Cisco Systems, Inc. 3;;; 4;;; Licensed under the Apache License, Version 2.0 (the "License"); 5;;; you may not use this file except in compliance with the License. 6;;; You may obtain a copy of the License at 7;;; 8;;; http://www.apache.org/licenses/LICENSE-2.0 9;;; 10;;; Unless required by applicable law or agreed to in writing, software 11;;; distributed under the License is distributed on an "AS IS" BASIS, 12;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13;;; See the License for the specific language governing permissions and 14;;; limitations under the License. 15 16(mat string=?/string-ci=? 17 (error? (string=?)) 18 (error? (string=? 'a)) 19 (error? (string=? "hi" 'a)) 20 (error? (string=? "hi" 'a "ho")) 21 (error? (string=? 'a "hi" "ho")) 22 (error? (string=? "hi" "ho" 'a "he")) 23 (error? (string-ci=?)) 24 (error? (string-ci=? 'a)) 25 (error? (string-ci=? "hi" 'a)) 26 (error? (string-ci=? "hi" 'a "ho")) 27 (error? (string-ci=? 'a "hi" "ho")) 28 (error? (string-ci=? "hi" "ho" 'a "he")) 29 (string=? "abc" "abc") 30 (string-ci=? "abc" "abc") 31 (not (string=? "Abc" "abc")) 32 (string-ci=? "Abc" "abc") 33 (not (string=? "abc" "abc ")) 34 (not (string-ci=? "abc" "abc ")) 35 (not (string=? "abc " "abc")) 36 (not (string-ci=? "abc " "abc")) 37 (string=? "a") 38 (string=? "a" "a" "a") 39 (not (string=? "a" "b" "c")) 40 (not (string=? "c" "b" "a")) 41 (not (string=? "b" "c" "a")) 42 (not (string=? "A" "a" "A")) 43 (not (string=? "a" "B" "c")) 44 (not (string=? "C" "b" "A")) 45 (string-ci=? "a") 46 (string-ci=? "a" "a" "a") 47 (not (string-ci=? "a" "b" "c")) 48 (not (string-ci=? "c" "b" "a")) 49 (not (string-ci=? "b" "c" "a")) 50 (string-ci=? "A" "a" "A") 51 (not (string-ci=? "a" "B" "c")) 52 (not (string-ci=? "C" "b" "A")) 53 ) 54 55(mat string<?/string-ci<? 56 (error? (string<?)) 57 (error? (string<? 'a)) 58 (error? (string<? "hi" 'a)) 59 (error? (string<? "hi" 'a "ho")) 60 (error? (string<? 'a "hi" "ho")) 61 (error? (string<? "hi" "ho" 'a "he")) 62 (error? (string-ci<?)) 63 (error? (string-ci<? 'a)) 64 (error? (string-ci<? "hi" 'a)) 65 (error? (string-ci<? "hi" 'a "ho")) 66 (error? (string-ci<? 'a "hi" "ho")) 67 (error? (string-ci<? "hi" "ho" 'a "he")) 68 (not (string<? "abc" "abc")) 69 (not (string-ci<? "abc" "abc")) 70 (string<? "Abc" "abc") 71 (not (string-ci<? "aBc" "AbC")) 72 (string<? "abc" "abc ") 73 (string-ci<? "aBc" "AbC ") 74 (not (string<? "abc " "abc")) 75 (not (string-ci<? "aBc " "AbC")) 76 (string<? "a") 77 (not (string<? "a" "a" "a")) 78 (string<? "a" "b" "c") 79 (not (string<? "c" "b" "a")) 80 (not (string<? "b" "c" "a")) 81 (not (string<? "A" "a" "A")) 82 (not (string<? "a" "B" "c")) 83 (not (string<? "C" "b" "A")) 84 (string-ci<? "a") 85 (not (string-ci<? "a" "a" "a")) 86 (string-ci<? "a" "b" "c") 87 (not (string-ci<? "c" "b" "a")) 88 (not (string-ci<? "b" "c" "a")) 89 (not (string-ci<? "A" "a" "A")) 90 (string-ci<? "a" "B" "c") 91 (not (string-ci<? "C" "b" "A")) 92 ) 93 94(mat string>?/string-ci>? 95 (error? (string>?)) 96 (error? (string>? 'a)) 97 (error? (string>? "hi" 'a)) 98 (error? (string>? "hi" 'a "ho")) 99 (error? (string>? 'a "hi" "ho")) 100 (error? (string>? "hi" "ho" 'a "he")) 101 (error? (string-ci>?)) 102 (error? (string-ci>? 'a)) 103 (error? (string-ci>? "hi" 'a)) 104 (error? (string-ci>? "hi" 'a "ho")) 105 (error? (string-ci>? 'a "hi" "ho")) 106 (error? (string-ci>? "hi" "ho" 'a "he")) 107 (not (string>? "abc" "abc")) 108 (not (string-ci>? "abc" "abc")) 109 (string>? "abc" "Abc") 110 (not (string-ci>? "aBc" "AbC")) 111 (not (string>? "abc" "abc ")) 112 (not (string-ci>? "aBc" "AbC ")) 113 (string>? "abc " "abc") 114 (string-ci>? "aBc " "AbC") 115 (string>? "a") 116 (not (string>? "a" "a" "a")) 117 (not (string>? "a" "b" "c")) 118 (string>? "c" "b" "a") 119 (not (string>? "b" "c" "a")) 120 (not (string>? "A" "a" "A")) 121 (not (string>? "a" "B" "c")) 122 (not (string>? "C" "b" "A")) 123 (string-ci>? "a") 124 (not (string-ci>? "a" "a" "a")) 125 (not (string-ci>? "a" "b" "c")) 126 (string-ci>? "c" "b" "a") 127 (not (string-ci>? "b" "c" "a")) 128 (not (string-ci>? "A" "a" "A")) 129 (not (string-ci>? "a" "B" "c")) 130 (string-ci>? "C" "b" "A") 131 ) 132 133(mat string<=?/string-ci<=? 134 (error? (string<=?)) 135 (error? (string<=? 'a)) 136 (error? (string<=? "hi" 'a)) 137 (error? (string<=? "hi" 'a "ho")) 138 (error? (string<=? 'a "hi" "ho")) 139 (error? (string<=? "hi" "ho" 'a "he")) 140 (error? (string-ci<=?)) 141 (error? (string-ci<=? 'a)) 142 (error? (string-ci<=? "hi" 'a)) 143 (error? (string-ci<=? "hi" 'a "ho")) 144 (error? (string-ci<=? 'a "hi" "ho")) 145 (error? (string-ci<=? "hi" "ho" 'a "he")) 146 (string<=? "abc" "abc") 147 (string-ci<=? "abc" "abc") 148 (not (string<=? "abc" "Abc")) 149 (string-ci<=? "aBc" "AbC") 150 (string<=? "abc" "abc ") 151 (string-ci<=? "aBc" "AbC ") 152 (not (string<=? "abc " "abc")) 153 (not (string-ci<=? "aBc " "AbC")) 154 (string<=? "a") 155 (string<=? "a" "a" "a") 156 (string<=? "a" "b" "c") 157 (not (string<=? "c" "b" "a")) 158 (not (string<=? "b" "c" "a")) 159 (not (string<=? "A" "a" "A")) 160 (not (string<=? "a" "B" "c")) 161 (not (string<=? "C" "b" "A")) 162 (string-ci<=? "a") 163 (string-ci<=? "a" "a" "a") 164 (string-ci<=? "a" "b" "c") 165 (not (string-ci<=? "c" "b" "a")) 166 (not (string-ci<=? "b" "c" "a")) 167 (string-ci<=? "A" "a" "A") 168 (string-ci<=? "a" "B" "c") 169 (not (string-ci<=? "C" "b" "A")) 170 ) 171 172(mat string>=?/string-ci>=? 173 (error? (string>=?)) 174 (error? (string>=? 'a)) 175 (error? (string>=? "hi" 'a)) 176 (error? (string>=? "hi" 'a "ho")) 177 (error? (string>=? 'a "hi" "ho")) 178 (error? (string>=? "hi" "ho" 'a "he")) 179 (error? (string-ci>=?)) 180 (error? (string-ci>=? 'a)) 181 (error? (string-ci>=? "hi" 'a)) 182 (error? (string-ci>=? "hi" 'a "ho")) 183 (error? (string-ci>=? 'a "hi" "ho")) 184 (error? (string-ci>=? "hi" "ho" 'a "he")) 185 (string>=? "abc" "abc") 186 (string-ci>=? "abc" "abc") 187 (not (string>=? "Abc" "abc")) 188 (string-ci>=? "aBc" "AbC") 189 (not (string>=? "abc" "abc ")) 190 (not (string-ci>=? "aBc" "AbC ")) 191 (string>=? "abc " "abc") 192 (string-ci>=? "aBc " "AbC") 193 (string>=? "a") 194 (string>=? "a" "a" "a") 195 (not (string>=? "a" "b" "c")) 196 (string>=? "c" "b" "a") 197 (not (string>=? "b" "c" "a")) 198 (not (string>=? "A" "a" "A")) 199 (not (string>=? "a" "B" "c")) 200 (not (string>=? "C" "b" "A")) 201 (string-ci>=? "a") 202 (string-ci>=? "a" "a" "a") 203 (not (string-ci>=? "a" "b" "c")) 204 (string-ci>=? "c" "b" "a") 205 (not (string-ci>=? "b" "c" "a")) 206 (string-ci>=? "A" "a" "A") 207 (not (string-ci>=? "a" "B" "c")) 208 (string-ci>=? "C" "b" "A") 209 ) 210 211(mat r6rs:string=?/r6rs:string-ci=? 212 (error? (r6rs:string=?)) 213 (error? (r6rs:string=? 'a)) 214 (error? (r6rs:string=? "hi" 'a)) 215 (error? (r6rs:string=? "hi" 'a "ho")) 216 (error? (r6rs:string=? 'a "hi" "ho")) 217 (error? (r6rs:string=? "hi" "ho" 'a "he")) 218 (error? (r6rs:string-ci=?)) 219 (error? (r6rs:string-ci=? 'a)) 220 (error? (r6rs:string-ci=? "hi" 'a)) 221 (error? (r6rs:string-ci=? "hi" 'a "ho")) 222 (error? (r6rs:string-ci=? 'a "hi" "ho")) 223 (error? (r6rs:string-ci=? "hi" "ho" 'a "he")) 224 (r6rs:string=? "abc" "abc") 225 (r6rs:string-ci=? "abc" "abc") 226 (not (r6rs:string=? "Abc" "abc")) 227 (r6rs:string-ci=? "Abc" "abc") 228 (not (r6rs:string=? "abc" "abc ")) 229 (not (r6rs:string-ci=? "abc" "abc ")) 230 (not (r6rs:string=? "abc " "abc")) 231 (not (r6rs:string-ci=? "abc " "abc")) 232 (r6rs:string=? "a" "a" "a") 233 (not (r6rs:string=? "a" "b" "c")) 234 (not (r6rs:string=? "c" "b" "a")) 235 (not (r6rs:string=? "b" "c" "a")) 236 (not (r6rs:string=? "A" "a" "A")) 237 (not (r6rs:string=? "a" "B" "c")) 238 (not (r6rs:string=? "C" "b" "A")) 239 (r6rs:string-ci=? "a" "a" "a") 240 (not (r6rs:string-ci=? "a" "b" "c")) 241 (not (r6rs:string-ci=? "c" "b" "a")) 242 (not (r6rs:string-ci=? "b" "c" "a")) 243 (r6rs:string-ci=? "A" "a" "A") 244 (not (r6rs:string-ci=? "a" "B" "c")) 245 (not (r6rs:string-ci=? "C" "b" "A")) 246 ) 247 248(mat r6rs:string<?/r6rs:string-ci<? 249 (error? (r6rs:string<?)) 250 (error? (r6rs:string<? 'a)) 251 (error? (r6rs:string<? "hi" 'a)) 252 (error? (r6rs:string<? "hi" 'a "ho")) 253 (error? (r6rs:string<? 'a "hi" "ho")) 254 (error? (r6rs:string<? "hi" "ho" 'a "he")) 255 (error? (r6rs:string-ci<?)) 256 (error? (r6rs:string-ci<? 'a)) 257 (error? (r6rs:string-ci<? "hi" 'a)) 258 (error? (r6rs:string-ci<? "hi" 'a "ho")) 259 (error? (r6rs:string-ci<? 'a "hi" "ho")) 260 (error? (r6rs:string-ci<? "hi" "ho" 'a "he")) 261 (not (r6rs:string<? "abc" "abc")) 262 (not (r6rs:string-ci<? "abc" "abc")) 263 (r6rs:string<? "Abc" "abc") 264 (not (r6rs:string-ci<? "aBc" "AbC")) 265 (r6rs:string<? "abc" "abc ") 266 (r6rs:string-ci<? "aBc" "AbC ") 267 (not (r6rs:string<? "abc " "abc")) 268 (not (r6rs:string-ci<? "aBc " "AbC")) 269 (not (r6rs:string<? "a" "a" "a")) 270 (r6rs:string<? "a" "b" "c") 271 (not (r6rs:string<? "c" "b" "a")) 272 (not (r6rs:string<? "b" "c" "a")) 273 (not (r6rs:string<? "A" "a" "A")) 274 (not (r6rs:string<? "a" "B" "c")) 275 (not (r6rs:string<? "C" "b" "A")) 276 (not (r6rs:string-ci<? "a" "a" "a")) 277 (r6rs:string-ci<? "a" "b" "c") 278 (not (r6rs:string-ci<? "c" "b" "a")) 279 (not (r6rs:string-ci<? "b" "c" "a")) 280 (not (r6rs:string-ci<? "A" "a" "A")) 281 (r6rs:string-ci<? "a" "B" "c") 282 (not (r6rs:string-ci<? "C" "b" "A")) 283 ) 284 285(mat r6rs:string>?/r6rs:string-ci>? 286 (error? (r6rs:string>?)) 287 (error? (r6rs:string>? 'a)) 288 (error? (r6rs:string>? "hi" 'a)) 289 (error? (r6rs:string>? "hi" 'a "ho")) 290 (error? (r6rs:string>? 'a "hi" "ho")) 291 (error? (r6rs:string>? "hi" "ho" 'a "he")) 292 (error? (r6rs:string-ci>?)) 293 (error? (r6rs:string-ci>? 'a)) 294 (error? (r6rs:string-ci>? "hi" 'a)) 295 (error? (r6rs:string-ci>? "hi" 'a "ho")) 296 (error? (r6rs:string-ci>? 'a "hi" "ho")) 297 (error? (r6rs:string-ci>? "hi" "ho" 'a "he")) 298 (not (r6rs:string>? "abc" "abc")) 299 (not (r6rs:string-ci>? "abc" "abc")) 300 (r6rs:string>? "abc" "Abc") 301 (not (r6rs:string-ci>? "aBc" "AbC")) 302 (not (r6rs:string>? "abc" "abc ")) 303 (not (r6rs:string-ci>? "aBc" "AbC ")) 304 (r6rs:string>? "abc " "abc") 305 (r6rs:string-ci>? "aBc " "AbC") 306 (not (r6rs:string>? "a" "a" "a")) 307 (not (r6rs:string>? "a" "b" "c")) 308 (r6rs:string>? "c" "b" "a") 309 (not (r6rs:string>? "b" "c" "a")) 310 (not (r6rs:string>? "A" "a" "A")) 311 (not (r6rs:string>? "a" "B" "c")) 312 (not (r6rs:string>? "C" "b" "A")) 313 (not (r6rs:string-ci>? "a" "a" "a")) 314 (not (r6rs:string-ci>? "a" "b" "c")) 315 (r6rs:string-ci>? "c" "b" "a") 316 (not (r6rs:string-ci>? "b" "c" "a")) 317 (not (r6rs:string-ci>? "A" "a" "A")) 318 (not (r6rs:string-ci>? "a" "B" "c")) 319 (r6rs:string-ci>? "C" "b" "A") 320 ) 321 322(mat r6rs:string<=?/r6rs:string-ci<=? 323 (error? (r6rs:string<=?)) 324 (error? (r6rs:string<=? 'a)) 325 (error? (r6rs:string<=? "hi" 'a)) 326 (error? (r6rs:string<=? "hi" 'a "ho")) 327 (error? (r6rs:string<=? 'a "hi" "ho")) 328 (error? (r6rs:string<=? "hi" "ho" 'a "he")) 329 (error? (r6rs:string-ci<=?)) 330 (error? (r6rs:string-ci<=? 'a)) 331 (error? (r6rs:string-ci<=? "hi" 'a)) 332 (error? (r6rs:string-ci<=? "hi" 'a "ho")) 333 (error? (r6rs:string-ci<=? 'a "hi" "ho")) 334 (error? (r6rs:string-ci<=? "hi" "ho" 'a "he")) 335 (r6rs:string<=? "abc" "abc") 336 (r6rs:string-ci<=? "abc" "abc") 337 (not (r6rs:string<=? "abc" "Abc")) 338 (r6rs:string-ci<=? "aBc" "AbC") 339 (r6rs:string<=? "abc" "abc ") 340 (r6rs:string-ci<=? "aBc" "AbC ") 341 (not (r6rs:string<=? "abc " "abc")) 342 (not (r6rs:string-ci<=? "aBc " "AbC")) 343 (r6rs:string<=? "a" "a" "a") 344 (r6rs:string<=? "a" "b" "c") 345 (not (r6rs:string<=? "c" "b" "a")) 346 (not (r6rs:string<=? "b" "c" "a")) 347 (not (r6rs:string<=? "A" "a" "A")) 348 (not (r6rs:string<=? "a" "B" "c")) 349 (not (r6rs:string<=? "C" "b" "A")) 350 (r6rs:string-ci<=? "a" "a" "a") 351 (r6rs:string-ci<=? "a" "b" "c") 352 (not (r6rs:string-ci<=? "c" "b" "a")) 353 (not (r6rs:string-ci<=? "b" "c" "a")) 354 (r6rs:string-ci<=? "A" "a" "A") 355 (r6rs:string-ci<=? "a" "B" "c") 356 (not (r6rs:string-ci<=? "C" "b" "A")) 357 ) 358 359(mat r6rs:string>=?/r6rs:string-ci>=? 360 (error? (r6rs:string>=?)) 361 (error? (r6rs:string>=? 'a)) 362 (error? (r6rs:string>=? "hi" 'a)) 363 (error? (r6rs:string>=? "hi" 'a "ho")) 364 (error? (r6rs:string>=? 'a "hi" "ho")) 365 (error? (r6rs:string>=? "hi" "ho" 'a "he")) 366 (error? (r6rs:string-ci>=?)) 367 (error? (r6rs:string-ci>=? 'a)) 368 (error? (r6rs:string-ci>=? "hi" 'a)) 369 (error? (r6rs:string-ci>=? "hi" 'a "ho")) 370 (error? (r6rs:string-ci>=? 'a "hi" "ho")) 371 (error? (r6rs:string-ci>=? "hi" "ho" 'a "he")) 372 (r6rs:string>=? "abc" "abc") 373 (r6rs:string-ci>=? "abc" "abc") 374 (not (r6rs:string>=? "Abc" "abc")) 375 (r6rs:string-ci>=? "aBc" "AbC") 376 (not (r6rs:string>=? "abc" "abc ")) 377 (not (r6rs:string-ci>=? "aBc" "AbC ")) 378 (r6rs:string>=? "abc " "abc") 379 (r6rs:string-ci>=? "aBc " "AbC") 380 (r6rs:string>=? "a" "a" "a") 381 (not (r6rs:string>=? "a" "b" "c")) 382 (r6rs:string>=? "c" "b" "a") 383 (not (r6rs:string>=? "b" "c" "a")) 384 (not (r6rs:string>=? "A" "a" "A")) 385 (not (r6rs:string>=? "a" "B" "c")) 386 (not (r6rs:string>=? "C" "b" "A")) 387 (r6rs:string-ci>=? "a" "a" "a") 388 (not (r6rs:string-ci>=? "a" "b" "c")) 389 (r6rs:string-ci>=? "c" "b" "a") 390 (not (r6rs:string-ci>=? "b" "c" "a")) 391 (r6rs:string-ci>=? "A" "a" "A") 392 (not (r6rs:string-ci>=? "a" "B" "c")) 393 (r6rs:string-ci>=? "C" "b" "A") 394 ) 395 396(mat string 397 (error? (string 'a)) 398 (error? (string #\a 'a)) 399 (error? (string #\a #\b 'a)) 400 (equal? (string #\a #\b #\c) "abc") 401 (equal? (string #\a (string-ref "b" 0) #\c) "abc") 402 (equal? (let ([x #\a]) (string x (string-ref "b" 0) #\c)) "abc") 403 (eq? (string) "") 404 ) 405 406(mat make-string 407 (error? (make-string)) 408 (error? (make-string 2 #\a #\b)) 409 (error? (make-string 3 'a)) 410 (error? (make-string 'a 3)) 411 (eqv? (make-string 0) "") 412 (eqv? (make-string (- 4 4)) (string)) 413 (eqv? (string-length (make-string 3)) 3) 414 (eqv? (string-length (make-string (+ 3 4))) 7) 415 (eqv? (string-length (make-string 1000)) 1000) 416 (string=? (make-string 10 #\a) "aaaaaaaaaa") 417 (string=? (make-string (- 4 1) #\a) "aaa") 418 (string=? (make-string (- 4 1) (string-ref "b" 0)) "bbb") 419 (andmap char? (string->list (make-string 20))) 420 ) 421 422(mat string-length 423 (error? (string-length)) 424 (error? (string-length "hi" "there")) 425 (error? (string-length 'a)) 426 (eqv? (string-length "abc") 3) 427 (eqv? (string-length "") 0) 428 ) 429 430(mat $string-ref-check? 431 (let ([s (make-string 3)] [imm-s (string->immutable-string (make-string 3))] [not-s (make-vector 3)]) 432 (let ([i-1 -1] [i0 0] [i1 1] [i2 2] [i3 3] [ifalse #f] [ibig (+ (most-positive-fixnum) 1)]) 433 (and 434 (not (#%$string-ref-check? not-s i0)) 435 (not (#%$string-ref-check? s ifalse)) 436 (not (#%$string-ref-check? s i-1)) 437 (not (#%$string-ref-check? imm-s i-1)) 438 (#%$string-ref-check? s 0) 439 (#%$string-ref-check? s 1) 440 (#%$string-ref-check? s 2) 441 (#%$string-ref-check? imm-s 0) 442 (#%$string-ref-check? imm-s 1) 443 (#%$string-ref-check? imm-s 2) 444 (#%$string-ref-check? s i0) 445 (#%$string-ref-check? s i1) 446 (#%$string-ref-check? s i2) 447 (#%$string-ref-check? imm-s i0) 448 (#%$string-ref-check? imm-s i1) 449 (#%$string-ref-check? imm-s i2) 450 (not (#%$string-ref-check? s 3)) 451 (not (#%$string-ref-check? s i3)) 452 (not (#%$string-ref-check? s ibig)) 453 (not (#%$string-ref-check? imm-s 3)) 454 (not (#%$string-ref-check? imm-s i3)) 455 (not (#%$string-ref-check? imm-s ibig))))) 456 ) 457 458(mat string-ref 459 (error? (string-ref)) 460 (error? (string-ref "hi")) 461 (error? (string-ref "hi" 3 4)) 462 (error? (string-ref 'a 3)) 463 (error? (string-ref "hi" 'a)) 464 (error? (string-ref "hi" -1)) 465 (error? (string-ref "hi" 2)) 466 (eqv? (string-ref "abc" 0) #\a) 467 (eqv? (string-ref "abc" 1) #\b) 468 (eqv? (string-ref "abc" 2) #\c) 469 ) 470 471(mat string-set! 472 (error? (string-set!)) 473 (error? (string-set! "hi")) 474 (error? (string-set! "hi" 1)) 475 (error? (string-set! "hi" 3 #\a #\b)) 476 (error? (string-set! 'a 3 #\a)) 477 (error? (string-set! "hi" 'a #\a)) 478 (error? (string-set! "hi" 3 'a)) 479 (error? (string-set! "hi" -1 #\a)) 480 (error? (string-set! "hi" 2 #\a)) 481 (let ((s (string #\a #\b #\c))) 482 (and 483 (begin (string-set! s 0 #\x) (equal? s "xbc")) 484 (begin (string-set! s 1 #\y) (equal? s "xyc")) 485 (begin (string-set! s 2 #\z) (equal? s "xyz")))) 486 ) 487 488(mat string-copy 489 ; incorrect argument count 490 (error? (string-copy)) 491 (error? (string-copy "hi" "there")) 492 493 ; not a string 494 (error? (string-copy 'a)) 495 (error? (if (string-copy '(a b c)) #f #t)) 496 497 (equal? (string-copy "") "") 498 (equal? (string-copy "abc") "abc") 499 (let* ((x1 (string #\1 #\2 #\3)) (x2 (string-copy x1))) 500 (and (equal? x2 x1) (not (eq? x2 x1)))) 501) 502 503(mat string-copy! 504 (begin 505 (define $s1 (string #\1 #\2 #\3 #\4)) 506 (define $s2 (string #\a #\b #\c #\d #\e #\f #\g #\h #\i)) 507 (and (string? $s1) 508 (string? $s2) 509 (eqv? (string-length $s1) 4) 510 (eqv? (string-length $s2) 9))) 511 512 ; wrong number of arguments 513 (error? (string-copy!)) 514 (error? (string-copy! $s2)) 515 (error? (string-copy! $s2 3)) 516 (error? (string-copy! $s2 3 $s1)) 517 (error? (string-copy! $s2 3 $s1 1)) 518 (error? (if (string-copy! $s2 3 $s1 1 2 3) #f #t)) 519 520 ; not string 521 (error? (string-copy! 0 0 $s2 0 0)) 522 (error? (if (string-copy! $s1 0 (bytevector 1 2 3) 0 0) #f #t)) 523 524 ; bad index 525 (error? (string-copy! $s1 -1 $s2 0 0)) 526 (error? (string-copy! $s1 0 $s2 -1 0)) 527 (error? (string-copy! $s1 'a $s2 0 0)) 528 (error? (string-copy! $s1 0 $s2 0.0 0)) 529 (error? (string-copy! $s1 (+ (most-positive-fixnum) 1) $s2 0 0)) 530 (error? (if (string-copy! $s1 0 $s2 (+ (most-positive-fixnum) 1) 0) #f #t)) 531 532 ; bad count 533 (error? (string-copy! $s1 0 $s2 0 -1)) 534 (error? (string-copy! $s1 0 $s2 0 (+ (most-positive-fixnum) 1))) 535 (error? (if (string-copy! $s1 0 $s2 0 'a) #f #t)) 536 537 ; beyond end 538 (error? (string-copy! $s1 0 $s2 0 5)) 539 (error? (string-copy! $s2 0 $s1 0 5)) 540 (error? (string-copy! $s1 1 $s2 0 4)) 541 (error? (string-copy! $s2 0 $s1 1 4)) 542 (error? (string-copy! $s1 2 $s2 0 3)) 543 (error? (string-copy! $s2 0 $s1 2 3)) 544 (error? (string-copy! $s1 3 $s2 0 2)) 545 (error? (string-copy! $s2 0 $s1 3 2)) 546 (error? (string-copy! $s1 4 $s2 0 1)) 547 (error? (string-copy! $s2 0 $s1 4 1)) 548 (error? (string-copy! $s2 0 $s1 0 500)) 549 (error? (if (string-copy! $s2 500 $s1 0 0) #f #t)) 550 551 ; make sure no damage done 552 (and (string? $s1) 553 (string? $s2) 554 (equal? $s1 "1234") 555 (equal? $s2 "abcdefghi")) 556 557 (begin 558 (string-copy! $s2 3 $s1 1 2) 559 (and (equal? $s1 "1de4") 560 (equal? $s2 "abcdefghi"))) 561 (begin 562 (string-copy! $s2 6 $s1 2 2) 563 (and (equal? $s1 "1dgh") 564 (equal? $s2 "abcdefghi"))) 565 (begin 566 (string-copy! $s2 0 $s1 4 0) 567 (and (equal? $s1 "1dgh") 568 (equal? $s2 "abcdefghi"))) 569 (begin 570 (string-copy! $s2 3 $s1 4 0) 571 (and (equal? $s1 "1dgh") 572 (equal? $s2 "abcdefghi"))) 573 (begin 574 (string-copy! $s2 3 $s2 4 0) 575 (and (equal? $s1 "1dgh") 576 (equal? $s2 "abcdefghi"))) 577 (begin 578 (string-copy! $s2 2 $s1 1 3) 579 (and (equal? $s1 "1cde") 580 (equal? $s2 "abcdefghi"))) 581 (begin 582 (string-copy! $s1 0 $s2 3 4) 583 (and (equal? $s1 "1cde") 584 (equal? $s2 "abc1cdehi"))) 585 (begin 586 (string-copy! $s2 0 $s2 3 5) 587 (and (equal? $s1 "1cde") 588 (equal? $s2 "abcabc1ci"))) 589 (begin 590 (string-copy! $s2 4 $s2 2 5) 591 (and (equal? $s1 "1cde") 592 (equal? $s2 "abbc1cici"))) 593 (begin 594 (string-copy! $s2 1 $s2 1 7) 595 (and (equal? $s1 "1cde") 596 (equal? $s2 "abbc1cici"))) 597) 598 599(mat string-truncate! 600 (begin 601 (define $s (string #\a #\b #\c #\d #\e #\f #\g #\h #\i)) 602 (and (string? $s) 603 (fx= (string-length $s) 9) 604 (string=? $s "abcdefghi"))) 605 606 ; wrong number of arguments 607 (error? (string-truncate!)) 608 (error? (string-truncate! $s)) 609 (error? (string-truncate! $s 3 15)) 610 611 ; not string 612 (error? (string-truncate! 0 0)) 613 (error? (if (string-truncate! (bytevector 1 2 3) 2) #f #t)) 614 615 ; bad length 616 (error? (string-truncate! $s -1)) 617 (error? (string-truncate! $s 10)) 618 (error? (string-truncate! $s 1000)) 619 (error? (string-truncate! $s (+ (most-positive-fixnum) 1))) 620 (error? (string-truncate! $s 'a)) 621 622 (begin 623 (string-truncate! $s 9) 624 (and (string? $s) 625 (fx= (string-length $s) 9) 626 (string=? $s "abcdefghi"))) 627 628 (begin 629 (string-truncate! $s 8) 630 (and (string? $s) 631 (fx= (string-length $s) 8) 632 (string=? $s "abcdefgh"))) 633 634 (begin 635 (string-truncate! $s 6) 636 (and (string? $s) 637 (fx= (string-length $s) 6) 638 (string=? $s "abcdef"))) 639 640 (begin 641 (string-truncate! $s 3) 642 (and (string? $s) 643 (fx= (string-length $s) 3) 644 (string=? $s "abc"))) 645 646 (begin 647 (define $s2 (string-truncate! $s 0)) 648 (and (eqv? $s2 "") 649 (string? $s) 650 (fx= (string-length $s) 3) 651 (string=? $s "abc"))) 652) 653 654(mat string-append 655 (error? (string-append 'a)) 656 (error? (string-append "hi" 'b)) 657 (error? (string-append "hi" 'b "there")) 658 (error? (string-copy 'a)) 659 (eqv? (string-append) "") 660 (let ([x (make-string 10 #\space)]) 661 (and (equal? x " ") 662 (not (eq? x (string-append x))))) 663 (equal? (string-append "abc") "abc") 664 (not (immutable-string? (string-append (string->immutable-string "abc")))) 665 (equal? (string-append "abc" "xyz") "abcxyz") 666 (equal? (string-append "hi " "there " "mom") "hi there mom") 667 (not (immutable-string? (string-append "hi " "there " "mom"))) 668 (equal? (string-append "" "there") "there") 669 (equal? (string-append "hi " "") "hi ") 670 (eqv? (string-append "" "") "") 671 ) 672 673(mat string-append-immutable 674 (error? (string-append-immutable 'a)) 675 (error? (string-append-immutable "hi" 'b)) 676 (error? (string-append-immutable "hi" 'b "there")) 677 (eqv? (string-append-immutable) (string->immutable-string "")) 678 (equal? (string-append-immutable "abc") "abc") 679 (immutable-string? (string-append-immutable "abc")) 680 (equal? (string-append-immutable "abc" "xyz") "abcxyz") 681 (equal? (string-append-immutable "hi " "there " "mom") "hi there mom") 682 (immutable-string? (string-append-immutable "hi " "there " "mom")) 683 (equal? (string-append-immutable "" "there") "there") 684 (equal? (string-append-immutable "hi " "") "hi ") 685 (eqv? (string-append-immutable "" "") (string->immutable-string "")) 686 ) 687 688(mat substring 689 (error? (substring)) 690 (error? (substring "hi")) 691 (error? (substring "hi" 0)) 692 (error? (substring "hi" 0 2 3)) 693 (error? (substring "hi" 0 3)) 694 (error? (substring "hi" -1 2)) 695 (error? (substring "hi" 'a 2)) 696 (error? (substring 'a 0 1)) 697 (error? (substring "hi" 0 'a)) 698 (error? (substring "hi" 1 0)) 699 (equal? (substring "hi there" 0 1) "h") 700 (equal? (substring "hi there" 3 6) "the") 701 (equal? (substring "hi there" 5 5) "") 702 (equal? (substring "hi there" 0 8) "hi there") 703 (eqv? (substring "" 0 0) "") 704 ) 705 706(mat string-fill! 707 (error? (string-fill!)) 708 (error? (string-fill! "hi")) 709 (error? (string-fill! "hi" #\a #\b)) 710 (error? (string-fill! "hi" 'a)) 711 (error? (string-fill! 'a #\a)) 712 (let ([s (string #\a #\b #\c)]) 713 (and (equal? s "abc") 714 (begin (string-fill! s #\*) (equal? s "***")))) 715 ; test for bug filling beyond the end of the string 716 (eqv? (let* ((s1 (make-string 3 #\a)) 717 (s2 (make-string 3 #\b))) 718 (string-fill! s1 #\*) 719 (string-ref s2 0)) 720 #\b) 721 ) 722 723(mat substring-fill! 724 (error? (substring-fill!)) 725 (error? (substring-fill! "hi")) 726 (error? (substring-fill! "hi" 0)) 727 (error? (substring-fill! "hi" 0 2)) 728 (error? (substring-fill! "hi" 0 3 #\a)) 729 (error? (substring-fill! "hi" -1 3 #\a)) 730 (error? (substring-fill! 'a 0 1 #\a)) 731 (error? (substring-fill! "hi" 0 'a #\a)) 732 (error? (substring-fill! "hi" 1 0 #\a)) 733 (let ([s (string-copy "hitme!")]) 734 (substring-fill! s 0 5 #\a) 735 (equal? s "aaaaa!")) 736 (let ([s ""]) 737 (substring-fill! s 0 0 #\a) 738 (eqv? s "")) 739 (let ([s (string-copy "ABCDE")]) 740 (and (begin 741 (substring-fill! s 0 0 #\$) 742 (equal? s "ABCDE")) 743 (begin 744 (substring-fill! s 2 5 #\$) 745 (equal? s "AB$$$")) 746 (begin 747 (substring-fill! s 0 3 #\&) 748 (equal? s "&&&$$")))) 749 ) 750 751(mat list->string 752 (error? (list->string)) 753 (error? (list->string '(#\a #\b) '(#\c #\d))) 754 (error? (list->string 'a)) 755 (error? (list->string '(a b))) 756 (error? (list->string '(#\a #\b . #\c))) 757 (error? (list->string (let ([ls (list #\a #\b #\c)]) (set-cdr! (cddr ls) (cdr ls)) ls))) 758 (equal? (list->string '(#\a #\b #\c)) "abc") 759 (equal? (list->string '()) "") 760 ) 761 762(mat string->list 763 (error? (string->list)) 764 (error? (string->list "ab" "cd")) 765 (error? (string->list 'a)) 766 (equal? (string->list "abc") '(#\a #\b #\c)) 767 (equal? (string->list "") '()) 768 ) 769 770(mat string->immutable-string 771 (begin 772 (define immutable-abc-string 773 (string->immutable-string (string #\a #\b #\c))) 774 #t) 775 776 (immutable-string? immutable-abc-string) 777 (not (mutable-string? immutable-abc-string)) 778 779 (equal? "abc" immutable-abc-string) 780 (eq? immutable-abc-string 781 (string->immutable-string immutable-abc-string)) 782 783 (not (immutable-string? (make-string 5))) 784 (mutable-string? (make-string 5)) 785 786 (immutable-string? (string->immutable-string (string))) 787 (not (mutable-string? (string->immutable-string (string)))) 788 (not (immutable-string? (string))) 789 (mutable-string? (string)) 790 791 (not (immutable-string? (string-copy immutable-abc-string))) 792 793 (error? (string-set! immutable-abc-string 0 #\a)) 794 (error? (string-fill! immutable-abc-string #\a)) 795 (error? (substring-fill! immutable-abc-string 0 1 #\a)) 796 (error? (string-copy! "xyz" 0 immutable-abc-string 0 3)) 797 (error? (string-truncate! immutable-abc-string 1)) 798) 799