Commit | Line | Data |
---|---|---|
9aa2c796 JB |
1 | ;;;; strings.test --- test suite for Guile's string functions -*- scheme -*- |
2 | ;;;; Jim Blandy <jimb@red-bean.com> --- August 1999 | |
3 | ;;;; | |
190d4b0d LC |
4 | ;;;; Copyright (C) 1999, 2001, 2004, 2005, 2006, 2008, 2009, 2010, |
5 | ;;;; 2011 Free Software Foundation, Inc. | |
6 | ;;;; | |
53befeb7 NJ |
7 | ;;;; This library is free software; you can redistribute it and/or |
8 | ;;;; modify it under the terms of the GNU Lesser General Public | |
9 | ;;;; License as published by the Free Software Foundation; either | |
10 | ;;;; version 3 of the License, or (at your option) any later version. | |
190d4b0d | 11 | ;;;; |
53befeb7 | 12 | ;;;; This library is distributed in the hope that it will be useful, |
9aa2c796 | 13 | ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
53befeb7 NJ |
14 | ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
15 | ;;;; Lesser General Public License for more details. | |
190d4b0d | 16 | ;;;; |
53befeb7 NJ |
17 | ;;;; You should have received a copy of the GNU Lesser General Public |
18 | ;;;; License along with this library; if not, write to the Free Software | |
19 | ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA | |
9aa2c796 | 20 | |
6e7d5622 | 21 | (define-module (test-strings) |
190d4b0d | 22 | #:use-module ((system base compile) #:select (compile)) |
2e85d145 | 23 | #:use-module (test-suite lib)) |
6e7d5622 | 24 | |
d7e4c2da MV |
25 | (define exception:read-only-string |
26 | (cons 'misc-error "^string is read-only")) | |
f5d7662f MG |
27 | (define exception:illegal-escape |
28 | (cons 'read-error "illegal character in escape sequence")) | |
2759c092 MG |
29 | ;; Wrong types may have either the 'wrong-type-arg key when |
30 | ;; interpreted or 'vm-error when compiled. This matches both. | |
31 | (define exception:wrong-type-arg | |
32 | (cons #t "Wrong type")) | |
548b9252 | 33 | |
6e7d5622 KR |
34 | ;; Create a string from integer char values, eg. (string-ints 65) => "A" |
35 | (define (string-ints . args) | |
36 | (apply string (map integer->char args))) | |
37 | ||
f5d7662f MG |
38 | ;; |
39 | ;; string internals | |
40 | ;; | |
41 | ||
42 | ;; Some abbreviations | |
43 | ;; BMP - Basic Multilingual Plane (codepoints below U+FFFF) | |
44 | ;; SMP - Suplementary Multilingual Plane (codebpoints from U+10000 to U+1FFFF) | |
45 | ||
46 | (with-test-prefix "string internals" | |
47 | ||
48 | (pass-if "new string starts at 1st char in stringbuf" | |
49 | (let ((s "abc")) | |
50 | (= 0 (assq-ref (%string-dump s) 'start)))) | |
51 | ||
52 | (pass-if "length of new string same as stringbuf" | |
53 | (let ((s "def")) | |
54 | (= (string-length s) (assq-ref (%string-dump s) 'stringbuf-length)))) | |
55 | ||
56 | (pass-if "contents of new string same as stringbuf" | |
57 | (let ((s "ghi")) | |
58 | (string=? s (assq-ref (%string-dump s) 'stringbuf-chars)))) | |
59 | ||
60 | (pass-if "writable strings are not read-only" | |
61 | (let ((s "zyx")) | |
62 | (not (assq-ref (%string-dump s) 'read-only)))) | |
63 | ||
64 | (pass-if "read-only strings are read-only" | |
65 | (let ((s (substring/read-only "zyx" 0))) | |
66 | (assq-ref (%string-dump s) 'read-only))) | |
67 | ||
f5d7662f MG |
68 | (pass-if "new Latin-1 encoded strings are not shared" |
69 | (let ((s "abc")) | |
70 | (not (assq-ref (%string-dump s) 'stringbuf-shared)))) | |
71 | ||
72 | (pass-if "new UCS-4 encoded strings are not shared" | |
73 | (let ((s "\u0100bc")) | |
74 | (not (assq-ref (%string-dump s) 'stringbuf-shared)))) | |
75 | ||
76 | ;; Should this be true? It isn't currently true. | |
77 | (pass-if "null shared substrings are shared" | |
78 | (let* ((s1 "") | |
79 | (s2 (substring/shared s1 0 0))) | |
80 | (throw 'untested) | |
81 | (eq? (assq-ref (%string-dump s2) 'shared) | |
82 | s1))) | |
83 | ||
84 | (pass-if "ASCII shared substrings are shared" | |
85 | (let* ((s1 "foobar") | |
86 | (s2 (substring/shared s1 0 3))) | |
87 | (eq? (assq-ref (%string-dump s2) 'shared) | |
88 | s1))) | |
89 | ||
90 | (pass-if "BMP shared substrings are shared" | |
91 | (let* ((s1 "\u0100\u0101\u0102\u0103\u0104\u0105") | |
92 | (s2 (substring/shared s1 0 3))) | |
93 | (eq? (assq-ref (%string-dump s2) 'shared) | |
94 | s1))) | |
95 | ||
96 | (pass-if "null substrings are not shared" | |
97 | (let* ((s1 "") | |
98 | (s2 (substring s1 0 0))) | |
99 | (not (eq? (assq-ref (%string-dump s2) 'shared) | |
100 | s1)))) | |
101 | ||
102 | (pass-if "ASCII substrings are not shared" | |
103 | (let* ((s1 "foobar") | |
104 | (s2 (substring s1 0 3))) | |
105 | (not (eq? (assq-ref (%string-dump s2) 'shared) | |
106 | s1)))) | |
107 | ||
108 | (pass-if "BMP substrings are not shared" | |
109 | (let* ((s1 "\u0100\u0101\u0102\u0103\u0104\u0105") | |
110 | (s2 (substring s1 0 3))) | |
111 | (not (eq? (assq-ref (%string-dump s2) 'shared) | |
112 | s1)))) | |
113 | ||
114 | (pass-if "ASCII substrings share stringbufs before copy-on-write" | |
115 | (let* ((s1 "foobar") | |
116 | (s2 (substring s1 0 3))) | |
117 | (assq-ref (%string-dump s1) 'stringbuf-shared))) | |
118 | ||
119 | (pass-if "BMP substrings share stringbufs before copy-on-write" | |
120 | (let* ((s1 "\u0100\u0101\u0102\u0103\u0104\u0105") | |
121 | (s2 (substring s1 0 3))) | |
122 | (assq-ref (%string-dump s1) 'stringbuf-shared))) | |
123 | ||
124 | (pass-if "ASCII substrings don't share stringbufs after copy-on-write" | |
125 | (let* ((s1 "foobar") | |
126 | (s2 (substring s1 0 3))) | |
127 | (string-set! s2 0 #\F) | |
128 | (not (assq-ref (%string-dump s2) 'stringbuf-shared)))) | |
129 | ||
130 | (pass-if "BMP substrings don't share stringbufs after copy-on-write" | |
131 | (let* ((s1 "\u0100\u0101\u0102\u0103\u0104\u0105") | |
132 | (s2 (substring s1 0 3))) | |
133 | (string-set! s2 0 #\F) | |
134 | (not (assq-ref (%string-dump s2) 'stringbuf-shared)))) | |
135 | ||
136 | (with-test-prefix "encodings" | |
137 | ||
138 | (pass-if "null strings are Latin-1 encoded" | |
139 | (let ((s "")) | |
140 | (not (assq-ref (%string-dump s) 'stringbuf-wide)))) | |
141 | ||
142 | (pass-if "ASCII strings are Latin-1 encoded" | |
143 | (let ((s "jkl")) | |
144 | (not (assq-ref (%string-dump s) 'stringbuf-wide)))) | |
145 | ||
146 | (pass-if "Latin-1 strings are Latin-1 encoded" | |
147 | (let ((s "\xC0\xC1\xC2")) | |
148 | (not (assq-ref (%string-dump s) 'stringbuf-wide)))) | |
149 | ||
150 | (pass-if "BMP strings are UCS-4 encoded" | |
151 | (let ((s "\u0100\u0101\x0102")) | |
152 | (assq-ref (%string-dump s) 'stringbuf-wide))) | |
153 | ||
154 | (pass-if "SMP strings are UCS-4 encoded" | |
155 | (let ((s "\U010300\u010301\x010302")) | |
156 | (assq-ref (%string-dump s) 'stringbuf-wide))) | |
157 | ||
158 | (pass-if "null list->string is Latin-1 encoded" | |
159 | (let ((s (string-ints))) | |
160 | (not (assq-ref (%string-dump s) 'stringbuf-wide)))) | |
161 | ||
162 | (pass-if "ASCII list->string is Latin-1 encoded" | |
163 | (let ((s (string-ints 65 66 67))) | |
164 | (not (assq-ref (%string-dump s) 'stringbuf-wide)))) | |
165 | ||
166 | (pass-if "Latin-1 list->string is Latin-1 encoded" | |
167 | (let ((s (string-ints #xc0 #xc1 #xc2))) | |
168 | (not (assq-ref (%string-dump s) 'stringbuf-wide)))) | |
169 | ||
170 | (pass-if "BMP list->string is UCS-4 encoded" | |
171 | (let ((s (string-ints #x0100 #x0101 #x0102))) | |
172 | (assq-ref (%string-dump s) 'stringbuf-wide))) | |
173 | ||
174 | (pass-if "SMP list->string is UCS-4 encoded" | |
175 | (let ((s (string-ints #x010300 #x010301 #x010302))) | |
176 | (assq-ref (%string-dump s) 'stringbuf-wide))) | |
177 | ||
178 | (pass-if "encoding of string not based on escape style" | |
179 | (let ((s "\U000040")) | |
180 | (not (assq-ref (%string-dump s) 'stringbuf-wide)))))) | |
181 | ||
fee95176 | 182 | (with-test-prefix "escapes" |
f5d7662f MG |
183 | |
184 | (pass-if-exception "non-hex char in two-digit hex-escape" | |
185 | exception:illegal-escape | |
186 | (with-input-from-string "\"\\x0g\"" read)) | |
187 | ||
188 | (pass-if-exception "non-hex char in four-digit hex-escape" | |
189 | exception:illegal-escape | |
190 | (with-input-from-string "\"\\u000g\"" read)) | |
191 | ||
192 | (pass-if-exception "non-hex char in six-digit hex-escape" | |
193 | exception:illegal-escape | |
194 | (with-input-from-string "\"\\U00000g\"" read)) | |
195 | ||
196 | (pass-if-exception "premature termination of two-digit hex-escape" | |
197 | exception:illegal-escape | |
198 | (with-input-from-string "\"\\x0\"" read)) | |
199 | ||
200 | (pass-if-exception "premature termination of four-digit hex-escape" | |
201 | exception:illegal-escape | |
202 | (with-input-from-string "\"\\u000\"" read)) | |
203 | ||
204 | (pass-if-exception "premature termination of six-digit hex-escape" | |
205 | exception:illegal-escape | |
206 | (with-input-from-string "\"\\U00000\"" read)) | |
207 | ||
208 | (pass-if "extra hex digits ignored for two-digit hex escape" | |
209 | (eqv? (string-ref "--\xfff--" 2) | |
210 | (integer->char #xff))) | |
211 | ||
212 | (pass-if "extra hex digits ignored for four-digit hex escape" | |
213 | (eqv? (string-ref "--\u0100f--" 2) | |
214 | (integer->char #x0100))) | |
215 | ||
216 | (pass-if "extra hex digits ignored for six-digit hex escape" | |
217 | (eqv? (string-ref "--\U010300f--" 2) | |
218 | (integer->char #x010300))) | |
219 | ||
220 | (pass-if "escaped characters match non-escaped ASCII characters" | |
fee95176 MG |
221 | (string=? "ABC" "\x41\u0042\U000043")) |
222 | ||
223 | (pass-if "R5RS backslash escapes" | |
224 | (string=? "\"\\" (string #\" #\\))) | |
225 | ||
67a4a16d MG |
226 | (pass-if "R6RS backslash escapes" |
227 | (string=? "\a\b\t\n\v\f\r" | |
228 | (string #\alarm #\backspace #\tab #\newline #\vtab | |
229 | #\page #\return))) | |
230 | ||
fee95176 | 231 | (pass-if "Guile extensions backslash escapes" |
67a4a16d | 232 | (string=? "\0" (string #\nul)))) |
fee95176 MG |
233 | |
234 | ;; | |
235 | ;; string? | |
236 | ;; | |
237 | (with-test-prefix "string?" | |
238 | ||
239 | (pass-if "string" | |
240 | (string? "abc")) | |
241 | ||
242 | (pass-if "symbol" | |
243 | (not (string? 'abc)))) | |
244 | ||
190d4b0d LC |
245 | ;; |
246 | ;; literals | |
247 | ;; | |
248 | ||
249 | (with-test-prefix "literals" | |
250 | ||
251 | ;; The "Storage Model" section of R5RS reads: "In such systems literal | |
252 | ;; constants and the strings returned by `symbol->string' are | |
253 | ;; immutable objects". `eval' doesn't support it yet, but it doesn't | |
254 | ;; really matter because `eval' doesn't coalesce repeated constants, | |
255 | ;; unlike the bytecode compiler. | |
256 | ||
257 | (pass-if-exception "literals are constant" | |
258 | exception:read-only-string | |
259 | (compile '(string-set! "literal string" 0 #\x) | |
260 | #:from 'scheme | |
261 | #:to 'value))) | |
262 | ||
fee95176 MG |
263 | ;; |
264 | ;; string-null? | |
265 | ;; | |
266 | ||
267 | (with-test-prefix "string-null?" | |
268 | ||
269 | (pass-if "null string" | |
270 | (string-null? "")) | |
271 | ||
272 | (pass-if "non-null string" | |
273 | (not (string-null? "a"))) | |
274 | ||
275 | (pass-if "respects \\0" | |
276 | (not (string-null? "\0"))) | |
277 | ||
278 | (pass-if-exception "symbol" | |
279 | exception:wrong-type-arg | |
280 | (string-null? 'a))) | |
6e7d5622 KR |
281 | |
282 | ;; | |
283 | ;; string=? | |
284 | ;; | |
285 | ||
049fa449 DH |
286 | (with-test-prefix "string=?" |
287 | ||
288 | (pass-if "respects 1st parameter's string length" | |
289 | (not (string=? "foo\0" "foo"))) | |
290 | ||
291 | (pass-if "respects 2nd paramter's string length" | |
292 | (not (string=? "foo" "foo\0"))) | |
293 | ||
294 | (with-test-prefix "wrong argument type" | |
295 | ||
296 | (pass-if-exception "1st argument symbol" | |
297 | exception:wrong-type-arg | |
298 | (string=? 'a "a")) | |
299 | ||
300 | (pass-if-exception "2nd argument symbol" | |
301 | exception:wrong-type-arg | |
7614c983 LC |
302 | (string=? "a" 'b)) |
303 | ||
304 | (pass-if-exception "1st argument EOF" | |
305 | exception:wrong-type-arg | |
306 | (string=? (with-input-from-string "" read) "b")) | |
307 | ||
308 | (pass-if-exception "2nd argument EOF" | |
309 | exception:wrong-type-arg | |
310 | (string=? "a" (with-input-from-string "" read))))) | |
049fa449 | 311 | |
6e7d5622 KR |
312 | ;; |
313 | ;; string<? | |
314 | ;; | |
315 | ||
049fa449 DH |
316 | (with-test-prefix "string<?" |
317 | ||
318 | (pass-if "respects string length" | |
319 | (and (not (string<? "foo\0a" "foo\0a")) | |
320 | (string<? "foo\0a" "foo\0b"))) | |
321 | ||
322 | (with-test-prefix "wrong argument type" | |
323 | ||
324 | (pass-if-exception "1st argument symbol" | |
325 | exception:wrong-type-arg | |
326 | (string<? 'a "a")) | |
327 | ||
328 | (pass-if-exception "2nd argument symbol" | |
329 | exception:wrong-type-arg | |
6e7d5622 KR |
330 | (string<? "a" 'b))) |
331 | ||
332 | (pass-if "same as char<?" | |
333 | (eq? (char<? (integer->char 0) (integer->char 255)) | |
334 | (string<? (string-ints 0) (string-ints 255))))) | |
335 | ||
336 | ;; | |
337 | ;; string-ci<? | |
338 | ;; | |
049fa449 DH |
339 | |
340 | (with-test-prefix "string-ci<?" | |
341 | ||
342 | (pass-if "respects string length" | |
343 | (and (not (string-ci<? "foo\0a" "foo\0a")) | |
344 | (string-ci<? "foo\0a" "foo\0b"))) | |
345 | ||
346 | (with-test-prefix "wrong argument type" | |
347 | ||
348 | (pass-if-exception "1st argument symbol" | |
349 | exception:wrong-type-arg | |
350 | (string-ci<? 'a "a")) | |
351 | ||
352 | (pass-if-exception "2nd argument symbol" | |
353 | exception:wrong-type-arg | |
6e7d5622 KR |
354 | (string-ci<? "a" 'b))) |
355 | ||
356 | (pass-if "same as char-ci<?" | |
357 | (eq? (char-ci<? (integer->char 0) (integer->char 255)) | |
358 | (string-ci<? (string-ints 0) (string-ints 255))))) | |
359 | ||
360 | ;; | |
361 | ;; string<=? | |
362 | ;; | |
363 | ||
364 | (with-test-prefix "string<=?" | |
365 | ||
366 | (pass-if "same as char<=?" | |
367 | (eq? (char<=? (integer->char 0) (integer->char 255)) | |
368 | (string<=? (string-ints 0) (string-ints 255))))) | |
369 | ||
370 | ;; | |
371 | ;; string-ci<=? | |
372 | ;; | |
373 | ||
374 | (with-test-prefix "string-ci<=?" | |
375 | ||
376 | (pass-if "same as char-ci<=?" | |
377 | (eq? (char-ci<=? (integer->char 0) (integer->char 255)) | |
378 | (string-ci<=? (string-ints 0) (string-ints 255))))) | |
379 | ||
380 | ;; | |
381 | ;; string>? | |
382 | ;; | |
383 | ||
384 | (with-test-prefix "string>?" | |
385 | ||
386 | (pass-if "same as char>?" | |
387 | (eq? (char>? (integer->char 0) (integer->char 255)) | |
388 | (string>? (string-ints 0) (string-ints 255))))) | |
389 | ||
390 | ;; | |
391 | ;; string-ci>? | |
392 | ;; | |
393 | ||
394 | (with-test-prefix "string-ci>?" | |
395 | ||
396 | (pass-if "same as char-ci>?" | |
397 | (eq? (char-ci>? (integer->char 0) (integer->char 255)) | |
398 | (string-ci>? (string-ints 0) (string-ints 255))))) | |
399 | ||
400 | ;; | |
401 | ;; string>=? | |
402 | ;; | |
403 | ||
404 | (with-test-prefix "string>=?" | |
405 | ||
406 | (pass-if "same as char>=?" | |
407 | (eq? (char>=? (integer->char 0) (integer->char 255)) | |
408 | (string>=? (string-ints 0) (string-ints 255))))) | |
409 | ||
410 | ;; | |
411 | ;; string-ci>=? | |
412 | ;; | |
413 | ||
414 | (with-test-prefix "string-ci>=?" | |
415 | ||
416 | (pass-if "same as char-ci>=?" | |
417 | (eq? (char-ci>=? (integer->char 0) (integer->char 255)) | |
418 | (string-ci>=? (string-ints 0) (string-ints 255))))) | |
419 | ||
edb7bb47 JG |
420 | ;; |
421 | ;; Unicode string normalization forms | |
422 | ;; | |
423 | ||
424 | ;; | |
425 | ;; string-normalize-nfd | |
426 | ;; | |
427 | ||
428 | (with-test-prefix "string-normalize-nfd" | |
429 | ||
430 | (pass-if "canonical decomposition is equal?" | |
431 | (equal? (string-normalize-nfd "\xe9") "\x65\u0301"))) | |
432 | ||
433 | ;; | |
434 | ;; string-normalize-nfkd | |
435 | ;; | |
436 | ||
437 | (with-test-prefix "string-normalize-nfkd" | |
438 | ||
439 | (pass-if "compatibility decomposition is equal?" | |
440 | (equal? (string-normalize-nfkd "\u1e9b\u0323") "s\u0323\u0307"))) | |
441 | ||
442 | ;; | |
443 | ;; string-normalize-nfc | |
444 | ;; | |
445 | ||
446 | (with-test-prefix "string-normalize-nfc" | |
447 | ||
448 | (pass-if "canonical composition is equal?" | |
449 | (equal? (string-normalize-nfc "\x65\u0301") "\xe9"))) | |
450 | ||
451 | ;; | |
452 | ;; string-normalize-nfkc | |
453 | ;; | |
454 | ||
455 | (with-test-prefix "string-normalize-nfkc" | |
456 | ||
457 | (pass-if "compatibility composition is equal?" | |
458 | (equal? (string-normalize-nfkc "\u1e9b\u0323") "\u1e69"))) | |
459 | ||
3ae3166b LC |
460 | ;; |
461 | ;; string-ref | |
462 | ;; | |
463 | ||
464 | (with-test-prefix "string-ref" | |
465 | ||
466 | (pass-if-exception "empty string" | |
467 | exception:out-of-range | |
468 | (string-ref "" 0)) | |
469 | ||
470 | (pass-if-exception "empty string and non-zero index" | |
471 | exception:out-of-range | |
472 | (string-ref "" 123)) | |
473 | ||
474 | (pass-if-exception "out of range" | |
475 | exception:out-of-range | |
476 | (string-ref "hello" 123)) | |
477 | ||
478 | (pass-if-exception "negative index" | |
479 | exception:out-of-range | |
480 | (string-ref "hello" -1)) | |
481 | ||
f5d7662f MG |
482 | (pass-if "regular string, ASCII char" |
483 | (char=? (string-ref "GNU Guile" 4) #\G)) | |
484 | ||
485 | (pass-if "regular string, hex escaped Latin-1 char" | |
486 | (char=? (string-ref "--\xff--" 2) | |
487 | (integer->char #xff))) | |
488 | ||
489 | (pass-if "regular string, hex escaped BMP char" | |
490 | (char=? (string-ref "--\u0100--" 2) | |
491 | (integer->char #x0100))) | |
492 | ||
493 | (pass-if "regular string, hex escaped SMP char" | |
494 | (char=? (string-ref "--\U010300--" 2) | |
495 | (integer->char #x010300)))) | |
3ae3166b | 496 | |
6e7d5622 KR |
497 | ;; |
498 | ;; string-set! | |
499 | ;; | |
049fa449 DH |
500 | |
501 | (with-test-prefix "string-set!" | |
502 | ||
3ae3166b LC |
503 | (pass-if-exception "empty string" |
504 | exception:out-of-range | |
505 | (string-set! (string-copy "") 0 #\x)) | |
506 | ||
507 | (pass-if-exception "empty string and non-zero index" | |
508 | exception:out-of-range | |
509 | (string-set! (string-copy "") 123 #\x)) | |
510 | ||
511 | (pass-if-exception "out of range" | |
512 | exception:out-of-range | |
513 | (string-set! (string-copy "hello") 123 #\x)) | |
514 | ||
515 | (pass-if-exception "negative index" | |
516 | exception:out-of-range | |
517 | (string-set! (string-copy "hello") -1 #\x)) | |
518 | ||
b144a33c | 519 | (pass-if-exception "read-only string" |
d7e4c2da | 520 | exception:read-only-string |
3ae3166b LC |
521 | (string-set! (substring/read-only "abc" 0) 1 #\space)) |
522 | ||
f5d7662f | 523 | (pass-if "regular string, ASCII char" |
3ae3166b LC |
524 | (let ((s (string-copy "GNU guile"))) |
525 | (string-set! s 4 #\G) | |
f5d7662f MG |
526 | (char=? (string-ref s 4) #\G))) |
527 | ||
528 | (pass-if "regular string, Latin-1 char" | |
529 | (let ((s (string-copy "GNU guile"))) | |
530 | (string-set! s 4 (integer->char #xfe)) | |
531 | (char=? (string-ref s 4) (integer->char #xfe)))) | |
532 | ||
533 | (pass-if "regular string, BMP char" | |
534 | (let ((s (string-copy "GNU guile"))) | |
535 | (string-set! s 4 (integer->char #x0100)) | |
536 | (char=? (string-ref s 4) (integer->char #x0100)))) | |
537 | ||
538 | (pass-if "regular string, SMP char" | |
539 | (let ((s (string-copy "GNU guile"))) | |
540 | (string-set! s 4 (integer->char #x010300)) | |
541 | (char=? (string-ref s 4) (integer->char #x010300))))) | |
3ae3166b | 542 | |
3c7cf7f5 MG |
543 | ;; |
544 | ;; list->string | |
545 | ;; | |
546 | (with-test-prefix "string" | |
547 | ||
548 | (pass-if-exception "convert circular list to string" | |
549 | exception:wrong-type-arg | |
550 | (let ((foo (list #\a #\b #\c))) | |
551 | (set-cdr! (cddr foo) (cdr foo)) | |
552 | (apply string foo)))) | |
553 | ||
50e20a60 KR |
554 | (with-test-prefix "string-split" |
555 | ||
556 | ;; in guile 1.6.7 and earlier, character >=128 wasn't matched in the string | |
557 | (pass-if "char 255" | |
558 | (equal? '("a" "b") | |
559 | (string-split (string #\a (integer->char 255) #\b) | |
5f085775 DH |
560 | (integer->char 255)))) |
561 | ||
562 | (pass-if "empty string - char" | |
563 | (equal? '("") | |
564 | (string-split "" #\:))) | |
565 | ||
566 | (pass-if "non-empty - char - no delimiters" | |
567 | (equal? '("foobarfrob") | |
568 | (string-split "foobarfrob" #\:))) | |
569 | ||
570 | (pass-if "non-empty - char - delimiters" | |
571 | (equal? '("foo" "bar" "frob") | |
572 | (string-split "foo:bar:frob" #\:))) | |
573 | ||
574 | (pass-if "non-empty - char - leading delimiters" | |
575 | (equal? '("" "" "foo" "bar" "frob") | |
576 | (string-split "::foo:bar:frob" #\:))) | |
577 | ||
578 | (pass-if "non-empty - char - trailing delimiters" | |
579 | (equal? '("foo" "bar" "frob" "" "") | |
580 | (string-split "foo:bar:frob::" #\:))) | |
581 | ||
582 | (pass-if "empty string - charset" | |
583 | (equal? '("") | |
584 | (string-split "" (char-set #\:)))) | |
585 | ||
586 | (pass-if "non-empty - charset - no delimiters" | |
587 | (equal? '("foobarfrob") | |
588 | (string-split "foobarfrob" (char-set #\:)))) | |
589 | ||
590 | (pass-if "non-empty - charset - delimiters" | |
591 | (equal? '("foo" "bar" "frob") | |
592 | (string-split "foo:bar:frob" (char-set #\:)))) | |
593 | ||
594 | (pass-if "non-empty - charset - leading delimiters" | |
595 | (equal? '("" "" "foo" "bar" "frob") | |
596 | (string-split "::foo:bar:frob" (char-set #\:)))) | |
597 | ||
598 | (pass-if "non-empty - charset - trailing delimiters" | |
599 | (equal? '("foo" "bar" "frob" "" "") | |
600 | (string-split "foo:bar:frob::" (char-set #\:)))) | |
601 | ||
602 | (pass-if "empty string - pred" | |
603 | (equal? '("") | |
604 | (string-split "" (negate char-alphabetic?)))) | |
605 | ||
606 | (pass-if "non-empty - pred - no delimiters" | |
607 | (equal? '("foobarfrob") | |
608 | (string-split "foobarfrob" (negate char-alphabetic?)))) | |
609 | ||
610 | (pass-if "non-empty - pred - delimiters" | |
611 | (equal? '("foo" "bar" "frob") | |
612 | (string-split "foo:bar:frob" (negate char-alphabetic?)))) | |
613 | ||
614 | (pass-if "non-empty - pred - leading delimiters" | |
615 | (equal? '("" "" "foo" "bar" "frob") | |
616 | (string-split "::foo:bar:frob" (negate char-alphabetic?)))) | |
617 | ||
618 | (pass-if "non-empty - pred - trailing delimiters" | |
619 | (equal? '("foo" "bar" "frob" "" "") | |
620 | (string-split "foo:bar:frob::" (negate char-alphabetic?))))) | |
50e20a60 | 621 | |
049fa449 DH |
622 | (with-test-prefix "substring-move!" |
623 | ||
624 | (pass-if-exception "substring-move! checks start and end correctly" | |
625 | exception:out-of-range | |
626 | (substring-move! "sample" 3 0 "test" 3))) | |
1c17f6b0 MV |
627 | |
628 | (with-test-prefix "substring/shared" | |
629 | ||
630 | (pass-if "modify indirectly" | |
631 | (let ((str (string-copy "foofoofoo"))) | |
632 | (string-upcase! (substring/shared str 3 6)) | |
633 | (string=? str "fooFOOfoo"))) | |
634 | ||
635 | (pass-if "modify cow indirectly" | |
636 | (let* ((str1 (string-copy "foofoofoo")) | |
637 | (str2 (string-copy str1))) | |
638 | (string-upcase! (substring/shared str2 3 6)) | |
639 | (and (string=? str1 "foofoofoo") | |
7aa29a87 MV |
640 | (string=? str2 "fooFOOfoo")))) |
641 | ||
642 | (pass-if "modify double indirectly" | |
d7e4c2da | 643 | (let* ((str1 (string-copy "foofoofoo")) |
7aa29a87 MV |
644 | (str2 (substring/shared str1 2 7))) |
645 | (string-upcase! (substring/shared str2 1 4)) | |
646 | (string=? str1 "fooFOOfoo"))) | |
647 | ||
648 | (pass-if "modify cow double indirectly" | |
649 | (let* ((str1 "foofoofoo") | |
650 | (str2 (substring str1 2 7))) | |
651 | (string-upcase! (substring/shared str2 1 4)) | |
652 | (and (string=? str1 "foofoofoo") | |
653 | (string=? str2 "oFOOf"))))) |