Fast generic function dispatch without calling `compile' at runtime
[bpt/guile.git] / test-suite / tests / srfi-13.test
CommitLineData
df937d20
MG
1;;;; srfi-13.test --- Test suite for Guile's SRFI-13 functions. -*- scheme -*-
2;;;; Martin Grabmueller, 2001-05-07
3;;;;
043850d9 4;;;; Copyright (C) 2001, 2004, 2005, 2006, 2011, 2012 Free Software Foundation, Inc.
e5c5ac92 5;;;;
53befeb7
NJ
6;;;; This library is free software; you can redistribute it and/or
7;;;; modify it under the terms of the GNU Lesser General Public
8;;;; License as published by the Free Software Foundation; either
9;;;; version 3 of the License, or (at your option) any later version.
10;;;;
11;;;; This library is distributed in the hope that it will be useful,
df937d20 12;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
53befeb7
NJ
13;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14;;;; Lesser General Public License for more details.
15;;;;
16;;;; You should have received a copy of the GNU Lesser General Public
17;;;; License along with this library; if not, write to the Free Software
18;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
df937d20 19
6e7d5622
KR
20(define-module (test-strings)
21 #:use-module (test-suite lib)
22 #:use-module (srfi srfi-13)
23 #:use-module (srfi srfi-14))
24
df937d20
MG
25
26(define exception:strict-infix-grammar
27 (cons 'misc-error "^strict-infix"))
28
6e7d5622
KR
29;; Create a string from integer char values, eg. (string-ints 65) => "A"
30(define (string-ints . args)
31 (apply string (map integer->char args)))
32
1441e6db
MG
33;; Some abbreviations
34;; BMP - Basic Multilingual Plane (codepoints below U+FFFF)
35;; SMP - Suplementary Multilingual Plane (codebpoints from U+10000 to U+1FFFF)
6e7d5622 36
967c0904
KR
37;;;
38;;; string-any
39;;;
40
df937d20
MG
41(with-test-prefix "string-any"
42
fee95176
MG
43 (pass-if "null string"
44 (not (string-any #\a "")))
45
46 (pass-if "start index == end index"
47 (not (string-any #\a "aaa" 1 1)))
48
967c0904
KR
49 (with-test-prefix "bad char_pred"
50
51 (pass-if-exception "integer" exception:wrong-type-arg
52 (string-any 123 "abcde"))
53
54 (pass-if-exception "string" exception:wrong-type-arg
55 (string-any "zzz" "abcde")))
56
57 (with-test-prefix "char"
58
59 (pass-if "no match"
60 (not (string-any #\C "abcde")))
61
62 (pass-if "one match"
63 (string-any #\C "abCde"))
64
1441e6db
MG
65 (pass-if "one match: BMP"
66 (string-any (integer->char #x0100) "ab\u0100de"))
67
68 (pass-if "one match: SMP"
69 (string-any (integer->char #x010300) "ab\U010300de"))
70
967c0904
KR
71 (pass-if "more than one match"
72 (string-any #\X "abXXX"))
73
74 (pass-if "no match, start index"
75 (not (string-any #\A "Abcde" 1)))
76
77 (pass-if "one match, start index"
78 (string-any #\C "abCde" 1))
79
80 (pass-if "more than one match, start index"
81 (string-any #\X "abXXX" 1))
82
83 (pass-if "no match, start and end index"
84 (not (string-any #\X "XbcdX" 1 4)))
85
86 (pass-if "one match, start and end index"
87 (string-any #\C "abCde" 1 4))
88
89 (pass-if "more than one match, start and end index"
90 (string-any #\X "abXXX" 1 4)))
91
92 (with-test-prefix "charset"
93
94 (pass-if "no match"
95 (not (string-any char-set:upper-case "abcde")))
96
97 (pass-if "one match"
98 (string-any char-set:upper-case "abCde"))
99
100 (pass-if "more than one match"
101 (string-any char-set:upper-case "abCDE"))
102
103 (pass-if "no match, start index"
104 (not (string-any char-set:upper-case "Abcde" 1)))
105
106 (pass-if "one match, start index"
107 (string-any char-set:upper-case "abCde" 1))
108
109 (pass-if "more than one match, start index"
110 (string-any char-set:upper-case "abCDE" 1))
111
112 (pass-if "no match, start and end index"
113 (not (string-any char-set:upper-case "AbcdE" 1 4)))
114
115 (pass-if "one match, start and end index"
116 (string-any char-set:upper-case "abCde" 1 4))
117
118 (pass-if "more than one match, start and end index"
119 (string-any char-set:upper-case "abCDE" 1 4)))
120
121 (with-test-prefix "pred"
df937d20 122
967c0904
KR
123 (pass-if "no match"
124 (not (string-any char-upper-case? "abcde")))
df937d20 125
967c0904
KR
126 (pass-if "one match"
127 (string-any char-upper-case? "abCde"))
df937d20 128
967c0904
KR
129 (pass-if "more than one match"
130 (string-any char-upper-case? "abCDE"))
df937d20 131
967c0904
KR
132 (pass-if "no match, start index"
133 (not (string-any char-upper-case? "Abcde" 1)))
df937d20 134
967c0904
KR
135 (pass-if "one match, start index"
136 (string-any char-upper-case? "abCde" 1))
df937d20 137
967c0904
KR
138 (pass-if "more than one match, start index"
139 (string-any char-upper-case? "abCDE" 1))
df937d20 140
967c0904
KR
141 (pass-if "no match, start and end index"
142 (not (string-any char-upper-case? "AbcdE" 1 4)))
df937d20 143
967c0904
KR
144 (pass-if "one match, start and end index"
145 (string-any char-upper-case? "abCde" 1 4))
146
147 (pass-if "more than one match, start and end index"
148 (string-any char-upper-case? "abCDE" 1 4))))
df937d20 149
820f33aa
JG
150;;;
151;;; string-titlecase
152;;;
153
154(with-test-prefix "string-titlecase"
155
156 (pass-if "all-lower"
157 (string=? "Foo" (string-titlecase "foo")))
158
159 (pass-if "all-upper"
160 (string=? "Foo" (string-titlecase "FOO")))
161
162 (pass-if "two-words"
163 (string=? "Hello, World!" (string-titlecase "hello, world!")))
164
165 (pass-if "titlecase-characters"
166 (string=? (list->string '(#\762))
167 (string-titlecase (list->string '(#\763))))))
168
8a8ca420
KR
169;;;
170;;; string-append/shared
171;;;
172
173(with-test-prefix "string-append/shared"
174
175 (pass-if "no args"
176 (string=? "" (string-append/shared)))
177
178 (with-test-prefix "one arg"
179 (pass-if "empty"
180 (string=? "" (string-append/shared "")))
181 (pass-if "non-empty"
182 (string=? "xyz" (string-append/shared "xyz"))))
183
184 (with-test-prefix "two args"
185 (pass-if (string=? "" (string-append/shared "" "")))
186 (pass-if (string=? "xyz" (string-append/shared "xyz" "")))
187 (pass-if (string=? "xyz" (string-append/shared "" "xyz")))
1441e6db
MG
188 (pass-if (string=? "abcxyz" (string-append/shared "abc" "xyz")))
189 (pass-if (string=? "abc\u0100\u0101"
190 (string-append/shared "abc" "\u0100\u0101"))))
8a8ca420
KR
191
192 (with-test-prefix "three args"
193 (pass-if (string=? "" (string-append/shared "" "" "")))
194 (pass-if (string=? "xy" (string-append/shared "xy" "" "")))
195 (pass-if (string=? "xy" (string-append/shared "" "xy" "")))
196 (pass-if (string=? "abxy" (string-append/shared "ab" "xy" "")))
197 (pass-if (string=? "ab" (string-append/shared "" "" "ab")))
198 (pass-if (string=? "xyab" (string-append/shared "xy" "" "ab")))
199 (pass-if (string=? "xyab" (string-append/shared "" "xy" "ab")))
200 (pass-if (string=? "ghxyab" (string-append/shared "gh" "xy" "ab"))))
201
202 (with-test-prefix "four args"
203 (pass-if (string=? "" (string-append/shared "" "" "" "")))
204 (pass-if (string=? "xy" (string-append/shared "xy" "" "" "")))
205 (pass-if (string=? "xy" (string-append/shared "" "xy" "" "")))
206 (pass-if (string=? "xy" (string-append/shared "" "" "xy" "")))
207 (pass-if (string=? "xy" (string-append/shared "" "" "" "xy")))
208
209 (pass-if (string=? "abxy" (string-append/shared "ab" "xy" "" "")))
210 (pass-if (string=? "abxy" (string-append/shared "ab" "" "xy" "")))
211 (pass-if (string=? "abxy" (string-append/shared "ab" "" "" "xy")))
212 (pass-if (string=? "abxy" (string-append/shared "" "ab" "" "xy")))
213 (pass-if (string=? "abxy" (string-append/shared "" "" "ab" "xy")))))
214
0381cf34
KR
215;;;
216;;; string-concatenate
217;;;
218
219(with-test-prefix "string-concatenate"
220
221 (pass-if-exception "inum" exception:wrong-type-arg
222 (string-concatenate 123))
223
224 (pass-if-exception "symbol" exception:wrong-type-arg
225 (string-concatenate 'x))
226
227 (pass-if-exception "improper 1" exception:wrong-type-arg
228 (string-concatenate '("a" . "b")))
229
1441e6db
MG
230 (pass-if (equal? "abc" (string-concatenate '("a" "b" "c"))))
231
232 (pass-if "concatenate BMP"
233 (equal? "a\u0100" (string-concatenate '("a" "\u0100")))))
0381cf34 234
6e7d5622
KR
235;;
236;; string-compare
237;;
238
239(with-test-prefix "string-compare"
240
241 (pass-if "same as char<?"
242 (eq? (char<? (integer->char 0) (integer->char 255))
243 (string-compare (string-ints 0) (string-ints 255)
244 (lambda (pos) #t) ;; lt
245 (lambda (pos) #f) ;; eq
246 (lambda (pos) #f))))) ;; gt
247
248;;
249;; string-compare-ci
250;;
251
252(with-test-prefix "string-compare-ci"
253
254 (pass-if "same as char-ci<?"
255 (eq? (char-ci<? (integer->char 0) (integer->char 255))
256 (string-compare-ci (string-ints 0) (string-ints 255)
257 (lambda (pos) #t) ;; lt
258 (lambda (pos) #f) ;; eq
259 (lambda (pos) #f))))) ;; gt
260
0381cf34
KR
261;;;
262;;; string-concatenate/shared
263;;;
264
265(with-test-prefix "string-concatenate/shared"
266
267 (pass-if-exception "inum" exception:wrong-type-arg
268 (string-concatenate/shared 123))
269
270 (pass-if-exception "symbol" exception:wrong-type-arg
271 (string-concatenate/shared 'x))
272
273 (pass-if-exception "improper 1" exception:wrong-type-arg
274 (string-concatenate/shared '("a" . "b")))
275
1441e6db
MG
276 (pass-if (equal? "abc" (string-concatenate/shared '("a" "b" "c"))))
277
278 (pass-if "BMP"
279 (equal? "a\u0100c" (string-concatenate/shared '("a" "\u0100" "c")))))
0381cf34 280
4c6563e1
KR
281;;;
282;;; string-every
283;;;
284
df937d20
MG
285(with-test-prefix "string-every"
286
fee95176
MG
287 (pass-if "null string"
288 (string-every #\a ""))
289
290 (pass-if "start index == end index"
291 (string-every #\a "bbb" 1 1))
292
685788d0
KR
293 (with-test-prefix "bad char_pred"
294
295 (pass-if-exception "integer" exception:wrong-type-arg
296 (string-every 123 "abcde"))
297
298 (pass-if-exception "string" exception:wrong-type-arg
299 (string-every "zzz" "abcde")))
300
967c0904
KR
301 (with-test-prefix "char"
302
303 (pass-if "empty string"
304 (string-every #\X ""))
305
306 (pass-if "empty substring"
307 (string-every #\X "abc" 1 1))
308
309 (pass-if "no match at all"
310 (not (string-every #\X "abcde")))
311
312 (pass-if "not all match"
313 (not (string-every #\X "abXXX")))
314
315 (pass-if "all match"
316 (string-every #\X "XXXXX"))
317
1441e6db
MG
318 (pass-if "all match BMP"
319 (string-every #\200000 "\U010000\U010000"))
320
967c0904
KR
321 (pass-if "no match at all, start index"
322 (not (string-every #\X "Xbcde" 1)))
323
324 (pass-if "not all match, start index"
325 (not (string-every #\X "XXcde" 1)))
326
327 (pass-if "all match, start index"
328 (string-every #\X "aXXXX" 1))
329
330 (pass-if "no match at all, start and end index"
331 (not (string-every #\X "XbcdX" 1 4)))
332
333 (pass-if "not all match, start and end index"
334 (not (string-every #\X "XXcde" 1 4)))
335
336 (pass-if "all match, start and end index"
337 (string-every #\X "aXXXe" 1 4)))
338
339 (with-test-prefix "charset"
340
341 (pass-if "empty string"
342 (string-every char-set:upper-case ""))
343
344 (pass-if "empty substring"
345 (string-every char-set:upper-case "abc" 1 1))
346
347 (pass-if "no match at all"
348 (not (string-every char-set:upper-case "abcde")))
349
350 (pass-if "not all match"
351 (not (string-every char-set:upper-case "abCDE")))
352
353 (pass-if "all match"
354 (string-every char-set:upper-case "ABCDE"))
355
356 (pass-if "no match at all, start index"
357 (not (string-every char-set:upper-case "Abcde" 1)))
358
359 (pass-if "not all match, start index"
360 (not (string-every char-set:upper-case "ABcde" 1)))
361
362 (pass-if "all match, start index"
363 (string-every char-set:upper-case "aBCDE" 1))
364
365 (pass-if "no match at all, start and end index"
366 (not (string-every char-set:upper-case "AbcdE" 1 4)))
367
368 (pass-if "not all match, start and end index"
369 (not (string-every char-set:upper-case "ABcde" 1 4)))
370
371 (pass-if "all match, start and end index"
372 (string-every char-set:upper-case "aBCDe" 1 4)))
373
374 (with-test-prefix "pred"
375
376 ;; in guile 1.6.4 and earlier string-every incorrectly returned #f on an
377 ;; empty string
378 (pass-if "empty string"
379 (string-every char-upper-case? ""))
380 (pass-if "empty substring"
381 (string-every char-upper-case? "abc" 1 1))
4c6563e1 382
967c0904
KR
383 (pass-if "no match at all"
384 (not (string-every char-upper-case? "abcde")))
df937d20 385
967c0904
KR
386 (pass-if "not all match"
387 (not (string-every char-upper-case? "abCDE")))
df937d20 388
967c0904
KR
389 (pass-if "all match"
390 (string-every char-upper-case? "ABCDE"))
df937d20 391
967c0904
KR
392 (pass-if "no match at all, start index"
393 (not (string-every char-upper-case? "Abcde" 1)))
df937d20 394
967c0904
KR
395 (pass-if "not all match, start index"
396 (not (string-every char-upper-case? "ABcde" 1)))
df937d20 397
967c0904
KR
398 (pass-if "all match, start index"
399 (string-every char-upper-case? "aBCDE" 1))
df937d20 400
967c0904
KR
401 (pass-if "no match at all, start and end index"
402 (not (string-every char-upper-case? "AbcdE" 1 4)))
df937d20 403
967c0904
KR
404 (pass-if "not all match, start and end index"
405 (not (string-every char-upper-case? "ABcde" 1 4)))
df937d20 406
967c0904
KR
407 (pass-if "all match, start and end index"
408 (string-every char-upper-case? "aBCDe" 1 4))))
df937d20
MG
409
410(with-test-prefix "string-tabulate"
411
685788d0
KR
412 (with-test-prefix "bad proc"
413
414 (pass-if-exception "integer" exception:wrong-type-arg
415 (string-tabulate 123 10))
416
417 (pass-if-exception "string" exception:wrong-type-arg
418 (string-tabulate "zzz" 10)))
419
df937d20
MG
420 (pass-if "static fill-char"
421 (string=? (string-tabulate (lambda (idx) #\!) 10) "!!!!!!!!!!"))
422
423 (pass-if "variable fill-char"
424 (string=? (string-tabulate
425 (lambda (idx) (integer->char (+ idx 32))) 10) " !\"#$%&'()")))
426
df937d20
MG
427(with-test-prefix "string->list"
428
429 (pass-if "empty"
430 (zero? (length (string->list ""))))
431
432 (pass-if "nonempty"
433 (= (length (string->list "foo")) 3))
434
7cfbc4f7
MG
435 (pass-if "empty, start index"
436 (zero? (length (string->list "foo" 3 3))))
df937d20 437
7cfbc4f7
MG
438 (pass-if "nonempty, start index"
439 (= (length (string->list "foo" 1 3)) 2))
1441e6db
MG
440
441 (pass-if "nonempty, start index, BMP"
442 (= (length (string->list "\xff\u0100\u0300" 1 3)) 2))
df937d20
MG
443 )
444
445(with-test-prefix "reverse-list->string"
446
447 (pass-if "empty"
448 (string-null? (reverse-list->string '())))
449
450 (pass-if "nonempty"
1441e6db 451 (string=? "foo" (reverse-list->string '(#\o #\o #\f))))
df937d20 452
1441e6db
MG
453 (pass-if "nonempty, BMP"
454 (string=? "\u0100\u0101\u0102" (reverse-list->string '(#\402 #\401 #\400)))))
df937d20
MG
455
456(with-test-prefix "string-join"
457
458 (pass-if "empty list, no delimiter, implicit infix, empty 1"
459 (string=? "" (string-join '())))
460
461 (pass-if "empty string, no delimiter, implicit infix, empty 2"
462 (string=? "" (string-join '(""))))
463
464 (pass-if "non-empty, no delimiter, implicit infix"
465 (string=? "bla" (string-join '("bla"))))
466
467 (pass-if "empty list, implicit infix, empty 1"
468 (string=? "" (string-join '() "|delim|")))
469
470 (pass-if "empty string, implicit infix, empty 2"
471 (string=? "" (string-join '("") "|delim|")))
472
473 (pass-if "non-empty, implicit infix"
474 (string=? "bla" (string-join '("bla") "|delim|")))
475
476 (pass-if "non-empty, implicit infix"
477 (string=? "bla" (string-join '("bla") "|delim|")))
478
479 (pass-if "two strings, implicit infix"
480 (string=? "bla|delim|fasel" (string-join '("bla" "fasel") "|delim|")))
481
482 (pass-if "empty, explicit infix"
483 (string=? "" (string-join '("") "|delim|" 'infix)))
484
485 (pass-if "empty list, explicit infix"
486 (string=? "" (string-join '() "|delim|" 'infix)))
487
488 (pass-if "non-empty, explicit infix"
489 (string=? "bla" (string-join '("bla") "|delim|" 'infix)))
490
491 (pass-if "two strings, explicit infix"
492 (string=? "bla|delim|fasel" (string-join '("bla" "fasel") "|delim|"
493 'infix)))
494
1441e6db
MG
495 (pass-if "two strings, explicit infix, BMP"
496 (string=? "\u0100\u0101::\u0102\u0103"
497 (string-join '("\u0100\u0101" "\u0102\u0103") "::"
498 'infix)))
499
e5c5ac92 500 (pass-if-exception "empty list, strict infix"
df937d20
MG
501 exception:strict-infix-grammar
502 (string-join '() "|delim|" 'strict-infix))
503
504 (pass-if "empty, strict infix"
505 (string=? "" (string-join '("") "|delim|" 'strict-infix)))
506
507 (pass-if "non-empty, strict infix"
508 (string=? "foo" (string-join '("foo") "|delim|" 'strict-infix)))
509
510 (pass-if "two strings, strict infix"
511 (string=? "foo|delim|bar" (string-join '("foo" "bar") "|delim|"
512 'strict-infix)))
513
514 (pass-if "empty list, prefix"
515 (string=? "" (string-join '() "|delim|" 'prefix)))
516
517 (pass-if "empty, prefix"
518 (string=? "|delim|" (string-join '("") "|delim|" 'prefix)))
519
520 (pass-if "non-empty, prefix"
521 (string=? "|delim|foo" (string-join '("foo") "|delim|" 'prefix)))
522
523 (pass-if "two strings, prefix"
524 (string=? "|delim|foo|delim|bar" (string-join '("foo" "bar") "|delim|"
525 'prefix)))
526
527 (pass-if "empty list, suffix"
528 (string=? "" (string-join '() "|delim|" 'suffix)))
529
530 (pass-if "empty, suffix"
531 (string=? "|delim|" (string-join '("") "|delim|" 'suffix)))
532
533 (pass-if "non-empty, suffix"
534 (string=? "foo|delim|" (string-join '("foo") "|delim|" 'suffix)))
535
536 (pass-if "two strings, suffix"
537 (string=? "foo|delim|bar|delim|" (string-join '("foo" "bar") "|delim|"
538 'suffix))))
539
df937d20
MG
540(with-test-prefix "string-copy"
541
542 (pass-if "empty string"
543 (string=? "" (string-copy "")))
544
545 (pass-if "full string"
546 (string=? "foo-bar" (string-copy "foo-bar")))
547
1441e6db
MG
548 (pass-if "full string, BMP"
549 (string=? "foo-\u0100\u0101" (string-copy "foo-\u0100\u0101")))
550
7cfbc4f7
MG
551 (pass-if "start index"
552 (string=? "o-bar" (string-copy "foo-bar" 2)))
df937d20 553
1441e6db
MG
554 (pass-if "start index"
555 (string=? "o-bar" (string-copy "\u0100\u0101o-bar" 2)))
556
7cfbc4f7 557 (pass-if "start and end index"
793e8a93 558 (string=? "o-ba" (string-copy "foo-bar" 2 6))))
df937d20
MG
559
560(with-test-prefix "substring/shared"
561
562 (pass-if "empty string"
043850d9
MW
563 (let ((s ""))
564 (eq? s (substring/shared s 0))))
df937d20 565
043850d9 566 (pass-if "non-empty string, not eq?"
df937d20
MG
567 (string=? "foo" (substring/shared "foo-bar" 0 3)))
568
043850d9
MW
569 (pass-if "shared copy of non-empty string is eq?"
570 (let ((s "foo-bar"))
571 (eq? s (substring/shared s 0 7)))))
df937d20
MG
572
573(with-test-prefix "string-copy!"
574
575 (pass-if "non-empty string"
576 (string=? "welld, oh yeah!"
577 (let* ((s "hello")
d7e4c2da 578 (t (string-copy "world, oh yeah!")))
df937d20 579 (string-copy! t 1 s 1 3)
793e8a93
MW
580 t)))
581
582 (pass-if-equal "overlapping src and dest, moving right"
583 "aabce"
584 (let ((str (string-copy "abcde")))
585 (string-copy! str 1 str 0 3) str))
586
587 (pass-if-equal "overlapping src and dest, moving left"
588 "bcdde"
589 (let ((str (string-copy "abcde")))
590 (string-copy! str 0 str 1 4) str)))
df937d20
MG
591
592(with-test-prefix "string-take"
593
594 (pass-if "empty string"
595 (string=? "" (string-take "foo bar braz" 0)))
596
597 (pass-if "non-empty string"
598 (string=? "foo " (string-take "foo bar braz" 4)))
599
1441e6db
MG
600 (pass-if "non-empty string BMP"
601 (string=? "\u0100oo " (string-take "\u0100oo \u0101ar braz" 4)))
602
df937d20
MG
603 (pass-if "full string"
604 (string=? "foo bar braz" (string-take "foo bar braz" 12))))
605
606(with-test-prefix "string-take-right"
607
608 (pass-if "empty string"
609 (string=? "" (string-take-right "foo bar braz" 0)))
610
611 (pass-if "non-empty string"
612 (string=? "braz" (string-take-right "foo bar braz" 4)))
613
1441e6db
MG
614 (pass-if "non-empty string"
615 (string=? "braz" (string-take-right "foo ba\u0100 braz" 4)))
616
df937d20
MG
617 (pass-if "full string"
618 (string=? "foo bar braz" (string-take-right "foo bar braz" 12))))
619
620(with-test-prefix "string-drop"
621
622 (pass-if "empty string"
623 (string=? "" (string-drop "foo bar braz" 12)))
624
625 (pass-if "non-empty string"
626 (string=? "braz" (string-drop "foo bar braz" 8)))
627
1441e6db
MG
628 (pass-if "non-empty string BMP"
629 (string=? "braz" (string-drop "foo \u0100\u0101\u0102 braz" 8)))
630
df937d20
MG
631 (pass-if "full string"
632 (string=? "foo bar braz" (string-drop "foo bar braz" 0))))
633
634(with-test-prefix "string-drop-right"
635
636 (pass-if "empty string"
637 (string=? "" (string-drop-right "foo bar braz" 12)))
638
639 (pass-if "non-empty string"
640 (string=? "foo " (string-drop-right "foo bar braz" 8)))
641
1441e6db
MG
642 (pass-if "non-empty string BMP"
643 (string=? "foo " (string-drop-right "foo \u0100\u0101\u0102 braz" 8)))
644
df937d20
MG
645 (pass-if "full string"
646 (string=? "foo bar braz" (string-drop-right "foo bar braz" 0))))
647
648(with-test-prefix "string-pad"
649
650 (pass-if "empty string, zero pad"
651 (string=? "" (string-pad "" 0)))
652
653 (pass-if "empty string, zero pad, pad char"
654 (string=? "" (string-pad "" 0)))
655
656 (pass-if "empty pad string, 2 pad "
657 (string=? " " (string-pad "" 2)))
658
659 (pass-if "empty pad string, 2 pad, pad char"
660 (string=? "!!" (string-pad "" 2 #\!)))
661
662 (pass-if "empty pad string, 2 pad, pad char, start index"
663 (string=? "!c" (string-pad "abc" 2 #\! 2)))
664
665 (pass-if "empty pad string, 2 pad, pad char, start and end index"
666 (string=? "!c" (string-pad "abcd" 2 #\! 2 3)))
667
668 (pass-if "freestyle 1"
669 (string=? "32" (string-pad (number->string 532) 2 #\!)))
670
671 (pass-if "freestyle 2"
672 (string=? "!532" (string-pad (number->string 532) 4 #\!))))
673
674(with-test-prefix "string-pad-right"
675
676 (pass-if "empty string, zero pad"
677 (string=? "" (string-pad-right "" 0)))
678
679 (pass-if "empty string, zero pad, pad char"
680 (string=? "" (string-pad-right "" 0)))
681
682 (pass-if "empty pad string, 2 pad "
683 (string=? " " (string-pad-right "" 2)))
684
685 (pass-if "empty pad string, 2 pad, pad char"
686 (string=? "!!" (string-pad-right "" 2 #\!)))
687
688 (pass-if "empty pad string, 2 pad, pad char, start index"
689 (string=? "c!" (string-pad-right "abc" 2 #\! 2)))
690
691 (pass-if "empty pad string, 2 pad, pad char, start and end index"
692 (string=? "c!" (string-pad-right "abcd" 2 #\! 2 3)))
693
694 (pass-if "freestyle 1"
695 (string=? "53" (string-pad-right (number->string 532) 2 #\!)))
696
697 (pass-if "freestyle 2"
698 (string=? "532!" (string-pad-right (number->string 532) 4 #\!))))
699
f764e6d1
MG
700(with-test-prefix "string-trim"
701
685788d0
KR
702 (with-test-prefix "bad char_pred"
703
704 (pass-if-exception "integer" exception:wrong-type-arg
705 (string-trim "abcde" 123))
706
707 (pass-if-exception "string" exception:wrong-type-arg
708 (string-trim "abcde" "zzz")))
709
f764e6d1
MG
710 (pass-if "empty string"
711 (string=? "" (string-trim "")))
712
713 (pass-if "no char/pred"
714 (string=? "foo " (string-trim " \tfoo ")))
715
716 (pass-if "start index, pred"
717 (string=? "foo " (string-trim " \tfoo " char-whitespace? 1)))
718
719 (pass-if "start and end index, pred"
720 (string=? "f" (string-trim " \tfoo " char-whitespace? 1 3)))
721
722 (pass-if "start index, char"
723 (string=? "\tfoo " (string-trim " \tfoo " #\space 1)))
724
725 (pass-if "start and end index, char"
726 (string=? "\tf" (string-trim " \tfoo " #\space 1 3)))
727
728 (pass-if "start index, charset"
729 (string=? "foo " (string-trim " \tfoo " char-set:whitespace 1)))
730
731 (pass-if "start and end index, charset"
732 (string=? "f" (string-trim " \tfoo " char-set:whitespace 1 3))))
733
734(with-test-prefix "string-trim-right"
735
685788d0
KR
736 (with-test-prefix "bad char_pred"
737
738 (pass-if-exception "integer" exception:wrong-type-arg
739 (string-trim-right "abcde" 123))
740
741 (pass-if-exception "string" exception:wrong-type-arg
742 (string-trim-right "abcde" "zzz")))
743
f764e6d1
MG
744 (pass-if "empty string"
745 (string=? "" (string-trim-right "")))
746
747 (pass-if "no char/pred"
748 (string=? " \tfoo" (string-trim-right " \tfoo ")))
749
750 (pass-if "start index, pred"
751 (string=? "\tfoo" (string-trim-right " \tfoo " char-whitespace? 1)))
752
753 (pass-if "start and end index, pred"
754 (string=? "\tf" (string-trim-right " \tfoo " char-whitespace? 1 3)))
755
756 (pass-if "start index, char"
757 (string=? "\tfoo" (string-trim-right " \tfoo " #\space 1)))
758
759 (pass-if "start and end index, char"
760 (string=? "\tf" (string-trim-right " \tfoo " #\space 1 3)))
761
762 (pass-if "start index, charset"
763 (string=? "\tfoo" (string-trim-right " \tfoo " char-set:whitespace 1)))
764
765 (pass-if "start and end index, charset"
766 (string=? "\tf" (string-trim-right " \tfoo " char-set:whitespace 1 3))))
767
768(with-test-prefix "string-trim-both"
769
685788d0
KR
770 (with-test-prefix "bad char_pred"
771
772 (pass-if-exception "integer" exception:wrong-type-arg
773 (string-trim-both "abcde" 123))
774
775 (pass-if-exception "string" exception:wrong-type-arg
776 (string-trim-both "abcde" "zzz")))
777
f764e6d1
MG
778 (pass-if "empty string"
779 (string=? "" (string-trim-both "")))
780
781 (pass-if "no char/pred"
782 (string=? "foo" (string-trim-both " \tfoo ")))
783
784 (pass-if "start index, pred"
785 (string=? "foo" (string-trim-both " \tfoo " char-whitespace? 1)))
786
787 (pass-if "start and end index, pred"
788 (string=? "f" (string-trim-both " \tfoo " char-whitespace? 1 3)))
789
790 (pass-if "start index, char"
791 (string=? "\tfoo" (string-trim-both " \tfoo " #\space 1)))
792
793 (pass-if "start and end index, char"
794 (string=? "\tf" (string-trim-both " \tfoo " #\space 1 3)))
795
796 (pass-if "start index, charset"
797 (string=? "foo" (string-trim-both " \tfoo " char-set:whitespace 1)))
798
799 (pass-if "start and end index, charset"
800 (string=? "f" (string-trim-both " \tfoo " char-set:whitespace 1 3))))
801
f764e6d1
MG
802(define s0 (make-string 200 #\!))
803(define s1 (make-string 0 #\!))
804
805(with-test-prefix "string-fill!"
806
807 (pass-if "empty string, no indices"
808 (string-fill! s1 #\*)
809 (= (string-length s1) 0))
810
811 (pass-if "empty string, start index"
812 (string-fill! s1 #\* 0)
813 (= (string-length s1) 0))
814
815 (pass-if "empty string, start and end index"
816 (string-fill! s1 #\* 0 0)
817 (= (string-length s1) 0))
818
819 (pass-if "no indices"
820 (string-fill! s0 #\*)
821 (char=? (string-ref s0 0) #\*))
822
823 (pass-if "start index"
824 (string-fill! s0 #\+ 10)
825 (char=? (string-ref s0 11) #\+))
826
827 (pass-if "start and end index"
828 (string-fill! s0 #\| 12 20)
829 (char=? (string-ref s0 13) #\|)))
830
5f5850b3
MG
831(with-test-prefix "string-prefix-length"
832
833 (pass-if "empty prefix"
834 (= 0 (string-prefix-length "" "foo bar")))
835
836 (pass-if "non-empty prefix - match"
837 (= 3 (string-prefix-length "foo" "foo bar")))
838
839 (pass-if "non-empty prefix - no match"
840 (= 0 (string-prefix-length "bar" "foo bar"))))
841
842(with-test-prefix "string-prefix-length-ci"
843
844 (pass-if "empty prefix"
845 (= 0 (string-prefix-length-ci "" "foo bar")))
846
847 (pass-if "non-empty prefix - match"
848 (= 3 (string-prefix-length-ci "fOo" "foo bar")))
849
850 (pass-if "non-empty prefix - no match"
851 (= 0 (string-prefix-length-ci "bAr" "foo bar"))))
852
853(with-test-prefix "string-suffix-length"
854
855 (pass-if "empty suffix"
856 (= 0 (string-suffix-length "" "foo bar")))
857
858 (pass-if "non-empty suffix - match"
859 (= 3 (string-suffix-length "bar" "foo bar")))
860
861 (pass-if "non-empty suffix - no match"
862 (= 0 (string-suffix-length "foo" "foo bar"))))
863
864(with-test-prefix "string-suffix-length-ci"
865
866 (pass-if "empty suffix"
867 (= 0 (string-suffix-length-ci "" "foo bar")))
868
869 (pass-if "non-empty suffix - match"
870 (= 3 (string-suffix-length-ci "bAr" "foo bar")))
871
872 (pass-if "non-empty suffix - no match"
873 (= 0 (string-suffix-length-ci "fOo" "foo bar"))))
874
875(with-test-prefix "string-prefix?"
876
877 (pass-if "empty prefix"
878 (string-prefix? "" "foo bar"))
879
880 (pass-if "non-empty prefix - match"
881 (string-prefix? "foo" "foo bar"))
882
883 (pass-if "non-empty prefix - no match"
884 (not (string-prefix? "bar" "foo bar"))))
885
886(with-test-prefix "string-prefix-ci?"
887
888 (pass-if "empty prefix"
889 (string-prefix-ci? "" "foo bar"))
890
891 (pass-if "non-empty prefix - match"
892 (string-prefix-ci? "fOo" "foo bar"))
893
894 (pass-if "non-empty prefix - no match"
895 (not (string-prefix-ci? "bAr" "foo bar"))))
896
897(with-test-prefix "string-suffix?"
898
899 (pass-if "empty suffix"
900 (string-suffix? "" "foo bar"))
901
902 (pass-if "non-empty suffix - match"
903 (string-suffix? "bar" "foo bar"))
904
905 (pass-if "non-empty suffix - no match"
906 (not (string-suffix? "foo" "foo bar"))))
907
908(with-test-prefix "string-suffix-ci?"
909
910 (pass-if "empty suffix"
911 (string-suffix-ci? "" "foo bar"))
912
913 (pass-if "non-empty suffix - match"
914 (string-suffix-ci? "bAr" "foo bar"))
915
916 (pass-if "non-empty suffix - no match"
917 (not (string-suffix-ci? "fOo" "foo bar"))))
918
5f5850b3
MG
919(with-test-prefix "string-index"
920
685788d0
KR
921 (with-test-prefix "bad char_pred"
922
923 (pass-if-exception "integer" exception:wrong-type-arg
924 (string-index "abcde" 123))
925
926 (pass-if-exception "string" exception:wrong-type-arg
927 (string-index "abcde" "zzz")))
928
5f5850b3
MG
929 (pass-if "empty string - char"
930 (not (string-index "" #\a)))
931
932 (pass-if "non-empty - char - match"
933 (= 5 (string-index "foo bar" #\a)))
934
935 (pass-if "non-empty - char - no match"
936 (not (string-index "frobnicate" #\x)))
937
938 (pass-if "empty string - char - start index"
939 (not (string-index "" #\a 0)))
940
941 (pass-if "non-empty - char - match - start index"
942 (= 5 (string-index "foo bar" #\a 1)))
943
944 (pass-if "non-empty - char - no match - start index"
945 (not (string-index "frobnicate" #\x 2)))
946
947 (pass-if "empty string - char - start and end index"
948 (not (string-index "" #\a 0 0)))
949
950 (pass-if "non-empty - char - match - start and end index"
951 (= 5 (string-index "foo bar" #\a 1 6)))
952
953 (pass-if "non-empty - char - no match - start and end index"
954 (not (string-index "frobnicate" #\a 2 5)))
955
956 (pass-if "empty string - charset"
957 (not (string-index "" char-set:letter)))
958
959 (pass-if "non-empty - charset - match"
960 (= 0 (string-index "foo bar" char-set:letter)))
961
962 (pass-if "non-empty - charset - no match"
963 (not (string-index "frobnicate" char-set:digit)))
964
965 (pass-if "empty string - charset - start index"
966 (not (string-index "" char-set:letter 0)))
967
968 (pass-if "non-empty - charset - match - start index"
969 (= 1 (string-index "foo bar" char-set:letter 1)))
970
971 (pass-if "non-empty - charset - no match - start index"
972 (not (string-index "frobnicate" char-set:digit 2)))
973
974 (pass-if "empty string - charset - start and end index"
975 (not (string-index "" char-set:letter 0 0)))
976
977 (pass-if "non-empty - charset - match - start and end index"
978 (= 1 (string-index "foo bar" char-set:letter 1 6)))
979
980 (pass-if "non-empty - charset - no match - start and end index"
981 (not (string-index "frobnicate" char-set:digit 2 5)))
982
983 (pass-if "empty string - pred"
984 (not (string-index "" char-alphabetic?)))
985
986 (pass-if "non-empty - pred - match"
987 (= 0 (string-index "foo bar" char-alphabetic?)))
988
989 (pass-if "non-empty - pred - no match"
990 (not (string-index "frobnicate" char-numeric?)))
991
992 (pass-if "empty string - pred - start index"
993 (not (string-index "" char-alphabetic? 0)))
994
995 (pass-if "non-empty - pred - match - start index"
996 (= 1 (string-index "foo bar" char-alphabetic? 1)))
997
998 (pass-if "non-empty - pred - no match - start index"
999 (not (string-index "frobnicate" char-numeric? 2)))
1000
1001 (pass-if "empty string - pred - start and end index"
1002 (not (string-index "" char-alphabetic? 0 0)))
1003
1004 (pass-if "non-empty - pred - match - start and end index"
1005 (= 1 (string-index "foo bar" char-alphabetic? 1 6)))
1006
1007 (pass-if "non-empty - pred - no match - start and end index"
59216e48
KR
1008 (not (string-index "frobnicate" char-numeric? 2 5)))
1009
1010 ;; in guile 1.6.7 and earlier this resulted in a segv, because
1011 ;; SCM_MAKE_CHAR didn't cope with "signed char" arguments containing an
1012 ;; 8-bit value
1013 (pass-if "8-bit char in string"
1014 (begin
1015 (string-index (string (integer->char 200)) char-numeric?)
1016 #t)))
5f5850b3
MG
1017
1018(with-test-prefix "string-index-right"
1019
685788d0
KR
1020 (with-test-prefix "bad char_pred"
1021
1022 (pass-if-exception "integer" exception:wrong-type-arg
1023 (string-index-right "abcde" 123))
1024
1025 (pass-if-exception "string" exception:wrong-type-arg
1026 (string-index-right "abcde" "zzz")))
1027
5f5850b3
MG
1028 (pass-if "empty string - char"
1029 (not (string-index-right "" #\a)))
1030
1031 (pass-if "non-empty - char - match"
1032 (= 5 (string-index-right "foo bar" #\a)))
1033
1034 (pass-if "non-empty - char - no match"
1035 (not (string-index-right "frobnicate" #\x)))
1036
1037 (pass-if "empty string - char - start index-right"
1038 (not (string-index-right "" #\a 0)))
1039
1040 (pass-if "non-empty - char - match - start index"
1041 (= 5 (string-index-right "foo bar" #\a 1)))
1042
1043 (pass-if "non-empty - char - no match - start index"
1044 (not (string-index-right "frobnicate" #\x 2)))
1045
1046 (pass-if "empty string - char - start and end index"
1047 (not (string-index-right "" #\a 0 0)))
1048
1049 (pass-if "non-empty - char - match - start and end index"
1050 (= 5 (string-index-right "foo bar" #\a 1 6)))
1051
1052 (pass-if "non-empty - char - no match - start and end index"
1053 (not (string-index-right "frobnicate" #\a 2 5)))
1054
1055 (pass-if "empty string - charset"
1056 (not (string-index-right "" char-set:letter)))
1057
1058 (pass-if "non-empty - charset - match"
1059 (= 6 (string-index-right "foo bar" char-set:letter)))
1060
1061 (pass-if "non-empty - charset - no match"
1062 (not (string-index-right "frobnicate" char-set:digit)))
1063
1064 (pass-if "empty string - charset - start index"
1065 (not (string-index-right "" char-set:letter 0)))
1066
1067 (pass-if "non-empty - charset - match - start index"
1068 (= 6 (string-index-right "foo bar" char-set:letter 1)))
1069
1070 (pass-if "non-empty - charset - no match - start index"
1071 (not (string-index-right "frobnicate" char-set:digit 2)))
1072
1073 (pass-if "empty string - charset - start and end index"
1074 (not (string-index-right "" char-set:letter 0 0)))
1075
1076 (pass-if "non-empty - charset - match - start and end index"
1077 (= 5 (string-index-right "foo bar" char-set:letter 1 6)))
1078
1079 (pass-if "non-empty - charset - no match - start and end index"
1080 (not (string-index-right "frobnicate" char-set:digit 2 5)))
1081
1082 (pass-if "empty string - pred"
1083 (not (string-index-right "" char-alphabetic?)))
1084
1085 (pass-if "non-empty - pred - match"
1086 (= 6 (string-index-right "foo bar" char-alphabetic?)))
1087
1088 (pass-if "non-empty - pred - no match"
1089 (not (string-index-right "frobnicate" char-numeric?)))
1090
1091 (pass-if "empty string - pred - start index"
1092 (not (string-index-right "" char-alphabetic? 0)))
1093
1094 (pass-if "non-empty - pred - match - start index"
1095 (= 6 (string-index-right "foo bar" char-alphabetic? 1)))
1096
1097 (pass-if "non-empty - pred - no match - start index"
1098 (not (string-index-right "frobnicate" char-numeric? 2)))
1099
1100 (pass-if "empty string - pred - start and end index"
1101 (not (string-index-right "" char-alphabetic? 0 0)))
1102
1103 (pass-if "non-empty - pred - match - start and end index"
1104 (= 5 (string-index-right "foo bar" char-alphabetic? 1 6)))
1105
1106 (pass-if "non-empty - pred - no match - start and end index"
1107 (not (string-index-right "frobnicate" char-numeric? 2 5))))
1108
1109(with-test-prefix "string-skip"
1110
685788d0
KR
1111 (with-test-prefix "bad char_pred"
1112
1113 (pass-if-exception "integer" exception:wrong-type-arg
1114 (string-skip "abcde" 123))
1115
1116 (pass-if-exception "string" exception:wrong-type-arg
1117 (string-skip "abcde" "zzz")))
1118
5f5850b3
MG
1119 (pass-if "empty string - char"
1120 (not (string-skip "" #\a)))
1121
1122 (pass-if "non-empty - char - match"
1123 (= 0 (string-skip "foo bar" #\a)))
1124
1125 (pass-if "non-empty - char - no match"
1126 (= 0 (string-skip "frobnicate" #\x)))
1127
1128 (pass-if "empty string - char - start index"
1129 (not (string-skip "" #\a 0)))
1130
1131 (pass-if "non-empty - char - match - start index"
1132 (= 1 (string-skip "foo bar" #\a 1)))
1133
1134 (pass-if "non-empty - char - no match - start index"
1135 (= 2 (string-skip "frobnicate" #\x 2)))
1136
1137 (pass-if "empty string - char - start and end index"
1138 (not (string-skip "" #\a 0 0)))
1139
1140 (pass-if "non-empty - char - match - start and end index"
1141 (= 1 (string-skip "foo bar" #\a 1 6)))
1142
1143 (pass-if "non-empty - char - no match - start and end index"
1144 (= 2 (string-skip "frobnicate" #\a 2 5)))
1145
1146 (pass-if "empty string - charset"
1147 (not (string-skip "" char-set:letter)))
1148
1149 (pass-if "non-empty - charset - match"
1150 (= 3 (string-skip "foo bar" char-set:letter)))
1151
1152 (pass-if "non-empty - charset - no match"
1153 (= 0 (string-skip "frobnicate" char-set:digit)))
1154
1155 (pass-if "empty string - charset - start index"
1156 (not (string-skip "" char-set:letter 0)))
1157
1158 (pass-if "non-empty - charset - match - start index"
1159 (= 3 (string-skip "foo bar" char-set:letter 1)))
1160
1161 (pass-if "non-empty - charset - no match - start index"
1162 (= 2 (string-skip "frobnicate" char-set:digit 2)))
1163
1164 (pass-if "empty string - charset - start and end index"
1165 (not (string-skip "" char-set:letter 0 0)))
1166
1167 (pass-if "non-empty - charset - match - start and end index"
1168 (= 3 (string-skip "foo bar" char-set:letter 1 6)))
1169
1170 (pass-if "non-empty - charset - no match - start and end index"
1171 (= 2 (string-skip "frobnicate" char-set:digit 2 5)))
1172
1173 (pass-if "empty string - pred"
1174 (not (string-skip "" char-alphabetic?)))
1175
1176 (pass-if "non-empty - pred - match"
1177 (= 3 (string-skip "foo bar" char-alphabetic?)))
1178
1179 (pass-if "non-empty - pred - no match"
1180 (= 0 (string-skip "frobnicate" char-numeric?)))
1181
1182 (pass-if "empty string - pred - start index"
1183 (not (string-skip "" char-alphabetic? 0)))
1184
1185 (pass-if "non-empty - pred - match - start index"
1186 (= 3 (string-skip "foo bar" char-alphabetic? 1)))
1187
1188 (pass-if "non-empty - pred - no match - start index"
1189 (= 2 (string-skip "frobnicate" char-numeric? 2)))
1190
1191 (pass-if "empty string - pred - start and end index"
1192 (not (string-skip "" char-alphabetic? 0 0)))
1193
1194 (pass-if "non-empty - pred - match - start and end index"
1195 (= 3 (string-skip "foo bar" char-alphabetic? 1 6)))
1196
1197 (pass-if "non-empty - pred - no match - start and end index"
1198 (= 2 (string-skip "frobnicate" char-numeric? 2 5))))
1199
1200(with-test-prefix "string-skip-right"
1201
685788d0
KR
1202 (with-test-prefix "bad char_pred"
1203
1204 (pass-if-exception "integer" exception:wrong-type-arg
1205 (string-skip-right "abcde" 123))
1206
1207 (pass-if-exception "string" exception:wrong-type-arg
1208 (string-skip-right "abcde" "zzz")))
1209
5f5850b3
MG
1210 (pass-if "empty string - char"
1211 (not (string-skip-right "" #\a)))
1212
1213 (pass-if "non-empty - char - match"
1214 (= 6 (string-skip-right "foo bar" #\a)))
1215
1216 (pass-if "non-empty - char - no match"
1217 (= 9 (string-skip-right "frobnicate" #\x)))
1218
1219 (pass-if "empty string - char - start index-right"
1220 (not (string-skip-right "" #\a 0)))
1221
1222 (pass-if "non-empty - char - match - start index"
1223 (= 6 (string-skip-right "foo bar" #\a 1)))
1224
1225 (pass-if "non-empty - char - no match - start index"
1226 (= 9 (string-skip-right "frobnicate" #\x 2)))
1227
1228 (pass-if "empty string - char - start and end index"
1229 (not (string-skip-right "" #\a 0 0)))
1230
1231 (pass-if "non-empty - char - match - start and end index"
1232 (= 4 (string-skip-right "foo bar" #\a 1 6)))
1233
1234 (pass-if "non-empty - char - no match - start and end index"
1235 (= 4 (string-skip-right "frobnicate" #\a 2 5)))
1236
1237 (pass-if "empty string - charset"
1238 (not (string-skip-right "" char-set:letter)))
1239
1240 (pass-if "non-empty - charset - match"
1241 (= 3 (string-skip-right "foo bar" char-set:letter)))
1242
1243 (pass-if "non-empty - charset - no match"
1244 (= 9 (string-skip-right "frobnicate" char-set:digit)))
1245
1246 (pass-if "empty string - charset - start index"
1247 (not (string-skip-right "" char-set:letter 0)))
1248
1249 (pass-if "non-empty - charset - match - start index"
1250 (= 3 (string-skip-right "foo bar" char-set:letter 1)))
1251
1252 (pass-if "non-empty - charset - no match - start index"
1253 (= 9 (string-skip-right "frobnicate" char-set:digit 2)))
1254
1255 (pass-if "empty string - charset - start and end index"
1256 (not (string-skip-right "" char-set:letter 0 0)))
1257
1258 (pass-if "non-empty - charset - match - start and end index"
1259 (= 3 (string-skip-right "foo bar" char-set:letter 1 6)))
1260
1261 (pass-if "non-empty - charset - no match - start and end index"
1262 (= 4 (string-skip-right "frobnicate" char-set:digit 2 5)))
1263
1264 (pass-if "empty string - pred"
1265 (not (string-skip-right "" char-alphabetic?)))
1266
1267 (pass-if "non-empty - pred - match"
1268 (= 3 (string-skip-right "foo bar" char-alphabetic?)))
1269
1270 (pass-if "non-empty - pred - no match"
1271 (= 9 (string-skip-right "frobnicate" char-numeric?)))
1272
1273 (pass-if "empty string - pred - start index"
1274 (not (string-skip-right "" char-alphabetic? 0)))
1275
1276 (pass-if "non-empty - pred - match - start index"
1277 (= 3 (string-skip-right "foo bar" char-alphabetic? 1)))
1278
1279 (pass-if "non-empty - pred - no match - start index"
1280 (= 9 (string-skip-right "frobnicate" char-numeric? 2)))
1281
1282 (pass-if "empty string - pred - start and end index"
1283 (not (string-skip-right "" char-alphabetic? 0 0)))
1284
1285 (pass-if "non-empty - pred - match - start and end index"
1286 (= 3 (string-skip-right "foo bar" char-alphabetic? 1 6)))
1287
1288 (pass-if "non-empty - pred - no match - start and end index"
1289 (= 4 (string-skip-right "frobnicate" char-numeric? 2 5))))
1290
685788d0
KR
1291;;
1292;; string-count
1293;;
1294
1295(with-test-prefix "string-count"
1296
1297 (with-test-prefix "bad char_pred"
1298
1299 (pass-if-exception "integer" exception:wrong-type-arg
1300 (string-count "abcde" 123))
1301
1302 (pass-if-exception "string" exception:wrong-type-arg
1303 (string-count "abcde" "zzz")))
1304
1305 (with-test-prefix "char"
1306
1307 (pass-if (eqv? 0 (string-count "" #\a)))
1308 (pass-if (eqv? 0 (string-count "-" #\a)))
1309 (pass-if (eqv? 1 (string-count "a" #\a)))
1310 (pass-if (eqv? 0 (string-count "--" #\a)))
1311 (pass-if (eqv? 1 (string-count "a-" #\a)))
1312 (pass-if (eqv? 1 (string-count "-a" #\a)))
1313 (pass-if (eqv? 2 (string-count "aa" #\a)))
1314 (pass-if (eqv? 0 (string-count "---" #\a)))
1315 (pass-if (eqv? 1 (string-count "-a-" #\a)))
1316 (pass-if (eqv? 1 (string-count "a--" #\a)))
1317 (pass-if (eqv? 2 (string-count "aa-" #\a)))
1318 (pass-if (eqv? 2 (string-count "a-a" #\a)))
1319 (pass-if (eqv? 3 (string-count "aaa" #\a)))
1320 (pass-if (eqv? 1 (string-count "--a" #\a)))
1321 (pass-if (eqv? 2 (string-count "-aa" #\a))))
1322
1323 (with-test-prefix "charset"
1324
1325 (pass-if (eqv? 0 (string-count "" char-set:letter)))
1326 (pass-if (eqv? 0 (string-count "-" char-set:letter)))
1327 (pass-if (eqv? 1 (string-count "a" char-set:letter)))
1328 (pass-if (eqv? 0 (string-count "--" char-set:letter)))
1329 (pass-if (eqv? 1 (string-count "a-" char-set:letter)))
1330 (pass-if (eqv? 1 (string-count "-a" char-set:letter)))
1331 (pass-if (eqv? 2 (string-count "aa" char-set:letter)))
1332 (pass-if (eqv? 0 (string-count "---" char-set:letter)))
1333 (pass-if (eqv? 1 (string-count "-a-" char-set:letter)))
1334 (pass-if (eqv? 1 (string-count "a--" char-set:letter)))
1335 (pass-if (eqv? 2 (string-count "aa-" char-set:letter)))
1336 (pass-if (eqv? 2 (string-count "a-a" char-set:letter)))
1337 (pass-if (eqv? 3 (string-count "aaa" char-set:letter)))
1338 (pass-if (eqv? 1 (string-count "--a" char-set:letter)))
1339 (pass-if (eqv? 2 (string-count "-aa" char-set:letter))))
1340
1341 (with-test-prefix "proc"
1342
1343 (pass-if (eqv? 0 (string-count "" char-alphabetic?)))
1344 (pass-if (eqv? 0 (string-count "-" char-alphabetic?)))
1345 (pass-if (eqv? 1 (string-count "a" char-alphabetic?)))
1346 (pass-if (eqv? 0 (string-count "--" char-alphabetic?)))
1347 (pass-if (eqv? 1 (string-count "a-" char-alphabetic?)))
1348 (pass-if (eqv? 1 (string-count "-a" char-alphabetic?)))
1349 (pass-if (eqv? 2 (string-count "aa" char-alphabetic?)))
1350 (pass-if (eqv? 0 (string-count "---" char-alphabetic?)))
1351 (pass-if (eqv? 1 (string-count "-a-" char-alphabetic?)))
1352 (pass-if (eqv? 1 (string-count "a--" char-alphabetic?)))
1353 (pass-if (eqv? 2 (string-count "aa-" char-alphabetic?)))
1354 (pass-if (eqv? 2 (string-count "a-a" char-alphabetic?)))
1355 (pass-if (eqv? 3 (string-count "aaa" char-alphabetic?)))
1356 (pass-if (eqv? 1 (string-count "--a" char-alphabetic?)))
1357 (pass-if (eqv? 2 (string-count "-aa" char-alphabetic?)))))
1358
1359
f764e6d1
MG
1360(with-test-prefix "string-replace"
1361
1362 (pass-if "empty string(s), no indices"
1363 (string=? "" (string-replace "" "")))
1364
1365 (pass-if "empty string(s), 1 index"
1366 (string=? "" (string-replace "" "" 0)))
1367
1368 (pass-if "empty string(s), 2 indices"
1369 (string=? "" (string-replace "" "" 0 0)))
1370
1371 (pass-if "empty string(s), 3 indices"
1372 (string=? "" (string-replace "" "" 0 0 0)))
1373
1374 (pass-if "empty string(s), 4 indices"
1375 (string=? "" (string-replace "" "" 0 0 0 0)))
1376
1377 (pass-if "no indices"
1378 (string=? "uu" (string-replace "foo bar" "uu")))
1379
1380 (pass-if "one index"
1381 (string=? "fuu" (string-replace "foo bar" "uu" 1)))
1382
1383 (pass-if "two indices"
1384 (string=? "fuuar" (string-replace "foo bar" "uu" 1 5)))
1385
1386 (pass-if "three indices"
1387 (string=? "fuar" (string-replace "foo bar" "uu" 1 5 1)))
1388
1389 (pass-if "four indices"
1390 (string=? "fuar" (string-replace "foo bar" "uu" 1 5 1 2))))
1391
1392(with-test-prefix "string-tokenize"
1393
1394 (pass-if "empty string, no char/pred"
1395 (zero? (length (string-tokenize ""))))
1396
f764e6d1
MG
1397 (pass-if "empty string, charset"
1398 (zero? (length (string-tokenize "" char-set:punctuation))))
1399
1400 (pass-if "no char/pred"
1401 (equal? '("foo" "bar" "!a") (string-tokenize "foo\tbar !a")))
1402
f764e6d1 1403 (pass-if "charset"
d26d2903
MV
1404 (equal? '("foo" "bar" "!a") (string-tokenize "foo\tbar !a"
1405 char-set:graphic)))
f764e6d1
MG
1406
1407 (pass-if "charset, start index"
d26d2903
MV
1408 (equal? '("oo" "bar" "!a") (string-tokenize "foo\tbar !a"
1409 char-set:graphic 1)))
f764e6d1
MG
1410
1411 (pass-if "charset, start and end index"
d26d2903
MV
1412 (equal? '("oo" "bar" "!") (string-tokenize "foo\tbar !a"
1413 char-set:graphic 1 9))))
f2974952
KR
1414;;;
1415;;; string-filter
1416;;;
f764e6d1
MG
1417
1418(with-test-prefix "string-filter"
1419
f2974952
KR
1420 (with-test-prefix "bad char_pred"
1421
1422 (pass-if-exception "integer" exception:wrong-type-arg
fc740bfc 1423 (string-filter 123 "abcde"))
f2974952 1424
fc740bfc
AW
1425 ;; Have to comment out this test for now, given that it triggers the
1426 ;; deprecation warning, even as the test passes.
1427 #;
f2974952 1428 (pass-if-exception "string" exception:wrong-type-arg
fc740bfc 1429 (string-filter "zzz" "abcde")))
f2974952 1430
f764e6d1 1431 (pass-if "empty string, char"
fc740bfc 1432 (string=? "" (string-filter #\. "")))
f764e6d1
MG
1433
1434 (pass-if "empty string, charset"
fc740bfc 1435 (string=? "" (string-filter char-set:punctuation "")))
f764e6d1
MG
1436
1437 (pass-if "empty string, pred"
fc740bfc 1438 (string=? "" (string-filter char-alphabetic? "")))
f764e6d1
MG
1439
1440 (pass-if "char"
fc740bfc 1441 (string=? "..." (string-filter #\. ".foo.bar.")))
f764e6d1
MG
1442
1443 (pass-if "charset"
fc740bfc 1444 (string=? "..." (string-filter char-set:punctuation ".foo.bar.")))
f764e6d1
MG
1445
1446 (pass-if "pred"
fc740bfc 1447 (string=? "foobar" (string-filter char-alphabetic? ".foo.bar.")))
f764e6d1
MG
1448
1449 (pass-if "char, start index"
fc740bfc 1450 (string=? ".." (string-filter #\. ".foo.bar." 2)))
f764e6d1
MG
1451
1452 (pass-if "charset, start index"
fc740bfc 1453 (string=? ".." (string-filter char-set:punctuation ".foo.bar." 2)))
f764e6d1
MG
1454
1455 (pass-if "pred, start index"
fc740bfc 1456 (string=? "oobar" (string-filter char-alphabetic? ".foo.bar." 2)))
f764e6d1
MG
1457
1458 (pass-if "char, start and end index"
fc740bfc 1459 (string=? "" (string-filter #\. ".foo.bar." 2 4)))
f764e6d1
MG
1460
1461 (pass-if "charset, start and end index"
fc740bfc 1462 (string=? "" (string-filter char-set:punctuation ".foo.bar." 2 4)))
f764e6d1
MG
1463
1464 (pass-if "pred, start and end index"
fc740bfc 1465 (string=? "oo" (string-filter char-alphabetic? ".foo.bar." 2 4)))
f2974952
KR
1466
1467 (with-test-prefix "char"
1468
fc740bfc
AW
1469 (pass-if (equal? "x" (string-filter #\x "x")))
1470 (pass-if (equal? "xx" (string-filter #\x "xx")))
1471 (pass-if (equal? "xx" (string-filter #\x "xyx")))
1472 (pass-if (equal? "x" (string-filter #\x "xyyy")))
1473 (pass-if (equal? "x" (string-filter #\x "yyyx")))
f2974952 1474
fc740bfc
AW
1475 (pass-if (equal? "xx" (string-filter #\x "xxx" 1)))
1476 (pass-if (equal? "xx" (string-filter #\x "xxx" 0 2)))
1477 (pass-if (equal? "x" (string-filter #\x "xyx" 1)))
1478 (pass-if (equal? "x" (string-filter #\x "yxx" 0 2)))
685788d0
KR
1479
1480 ;; leading and trailing removals
fc740bfc
AW
1481 (pass-if (string=? "" (string-filter #\x ".")))
1482 (pass-if (string=? "" (string-filter #\x "..")))
1483 (pass-if (string=? "" (string-filter #\x "...")))
1484 (pass-if (string=? "x" (string-filter #\x ".x")))
1485 (pass-if (string=? "x" (string-filter #\x "..x")))
1486 (pass-if (string=? "x" (string-filter #\x "...x")))
1487 (pass-if (string=? "x" (string-filter #\x "x.")))
1488 (pass-if (string=? "x" (string-filter #\x "x..")))
1489 (pass-if (string=? "x" (string-filter #\x "x...")))
1490 (pass-if (string=? "x" (string-filter #\x "...x..."))))
f2974952
KR
1491
1492 (with-test-prefix "charset"
1493
1494 (let ((charset (char-set #\x #\y)))
fc740bfc
AW
1495 (pass-if (equal? "x" (string-filter charset "x")))
1496 (pass-if (equal? "xx" (string-filter charset "xx")))
1497 (pass-if (equal? "xy" (string-filter charset "xy")))
1498 (pass-if (equal? "x" (string-filter charset "xaaa")))
1499 (pass-if (equal? "y" (string-filter charset "aaay")))
f2974952 1500
fc740bfc
AW
1501 (pass-if (equal? "yx" (string-filter charset "xyx" 1)))
1502 (pass-if (equal? "xy" (string-filter charset "xyx" 0 2)))
1503 (pass-if (equal? "x" (string-filter charset "xax" 1)))
1504 (pass-if (equal? "x" (string-filter charset "axx" 0 2))))
685788d0
KR
1505
1506 ;; leading and trailing removals
fc740bfc
AW
1507 (pass-if (string=? "" (string-filter char-set:letter ".")))
1508 (pass-if (string=? "" (string-filter char-set:letter "..")))
1509 (pass-if (string=? "" (string-filter char-set:letter "...")))
1510 (pass-if (string=? "x" (string-filter char-set:letter ".x")))
1511 (pass-if (string=? "x" (string-filter char-set:letter "..x")))
1512 (pass-if (string=? "x" (string-filter char-set:letter "...x")))
1513 (pass-if (string=? "x" (string-filter char-set:letter "x.")))
1514 (pass-if (string=? "x" (string-filter char-set:letter "x..")))
1515 (pass-if (string=? "x" (string-filter char-set:letter "x...")))
1516 (pass-if (string=? "x" (string-filter char-set:letter "...x...")))))
f2974952
KR
1517
1518;;;
1519;;; string-delete
1520;;;
f764e6d1
MG
1521
1522(with-test-prefix "string-delete"
1523
685788d0
KR
1524 (with-test-prefix "bad char_pred"
1525
1526 (pass-if-exception "integer" exception:wrong-type-arg
fc740bfc 1527 (string-delete 123 "abcde"))
685788d0 1528
fc740bfc
AW
1529 ;; Like string-filter, commenting out this test.
1530 #;
685788d0 1531 (pass-if-exception "string" exception:wrong-type-arg
fc740bfc 1532 (string-delete "zzz" "abcde")))
685788d0 1533
f764e6d1 1534 (pass-if "empty string, char"
fc740bfc 1535 (string=? "" (string-delete #\. "")))
f764e6d1
MG
1536
1537 (pass-if "empty string, charset"
fc740bfc 1538 (string=? "" (string-delete char-set:punctuation "")))
f764e6d1
MG
1539
1540 (pass-if "empty string, pred"
fc740bfc 1541 (string=? "" (string-delete char-alphabetic? "")))
f764e6d1
MG
1542
1543 (pass-if "char"
fc740bfc 1544 (string=? "foobar" (string-delete #\. ".foo.bar.")))
f764e6d1
MG
1545
1546 (pass-if "charset"
fc740bfc 1547 (string=? "foobar" (string-delete char-set:punctuation ".foo.bar.")))
f764e6d1
MG
1548
1549 (pass-if "pred"
fc740bfc 1550 (string=? "..." (string-delete char-alphabetic? ".foo.bar.")))
f764e6d1
MG
1551
1552 (pass-if "char, start index"
fc740bfc 1553 (string=? "oobar" (string-delete #\. ".foo.bar." 2)))
f764e6d1
MG
1554
1555 (pass-if "charset, start index"
fc740bfc 1556 (string=? "oobar" (string-delete char-set:punctuation ".foo.bar." 2)))
f764e6d1
MG
1557
1558 (pass-if "pred, start index"
fc740bfc 1559 (string=? ".." (string-delete char-alphabetic? ".foo.bar." 2)))
f764e6d1
MG
1560
1561 (pass-if "char, start and end index"
fc740bfc 1562 (string=? "oo" (string-delete #\. ".foo.bar." 2 4)))
f764e6d1
MG
1563
1564 (pass-if "charset, start and end index"
fc740bfc 1565 (string=? "oo" (string-delete char-set:punctuation ".foo.bar." 2 4)))
f764e6d1
MG
1566
1567 (pass-if "pred, start and end index"
fc740bfc 1568 (string=? "" (string-delete char-alphabetic? ".foo.bar." 2 4)))
685788d0
KR
1569
1570 ;; leading and trailing removals
fc740bfc
AW
1571 (pass-if (string=? "" (string-delete #\. ".")))
1572 (pass-if (string=? "" (string-delete #\. "..")))
1573 (pass-if (string=? "" (string-delete #\. "...")))
1574 (pass-if (string=? "x" (string-delete #\. ".x")))
1575 (pass-if (string=? "x" (string-delete #\. "..x")))
1576 (pass-if (string=? "x" (string-delete #\. "...x")))
1577 (pass-if (string=? "x" (string-delete #\. "x.")))
1578 (pass-if (string=? "x" (string-delete #\. "x..")))
1579 (pass-if (string=? "x" (string-delete #\. "x...")))
1580 (pass-if (string=? "x" (string-delete #\. "...x...")))
685788d0
KR
1581
1582 ;; leading and trailing removals
fc740bfc
AW
1583 (pass-if (string=? "" (string-delete char-set:punctuation ".")))
1584 (pass-if (string=? "" (string-delete char-set:punctuation "..")))
1585 (pass-if (string=? "" (string-delete char-set:punctuation "...")))
1586 (pass-if (string=? "x" (string-delete char-set:punctuation ".x")))
1587 (pass-if (string=? "x" (string-delete char-set:punctuation "..x")))
1588 (pass-if (string=? "x" (string-delete char-set:punctuation "...x")))
1589 (pass-if (string=? "x" (string-delete char-set:punctuation "x.")))
1590 (pass-if (string=? "x" (string-delete char-set:punctuation "x..")))
1591 (pass-if (string=? "x" (string-delete char-set:punctuation "x...")))
1592 (pass-if (string=? "x" (string-delete char-set:punctuation "...x..."))))
685788d0 1593
80fdeb4e
MD
1594
1595(with-test-prefix "string-map"
1596
685788d0
KR
1597 (with-test-prefix "bad proc"
1598
1599 (pass-if-exception "integer" exception:wrong-type-arg
1600 (string-map 123 "abcde"))
1601
1602 (pass-if-exception "string" exception:wrong-type-arg
1603 (string-map "zzz" "abcde")))
1604
80fdeb4e
MD
1605 (pass-if "constant"
1606 (string=? "xxx" (string-map (lambda (c) #\x) "foo")))
1607
1608 (pass-if "identity"
1609 (string=? "foo" (string-map identity "foo")))
1610
1611 (pass-if "upcase"
1612 (string=? "FOO" (string-map char-upcase "foo"))))
e5c5ac92 1613
685788d0
KR
1614(with-test-prefix "string-map!"
1615
1616 (with-test-prefix "bad proc"
1617
1618 (pass-if-exception "integer" exception:wrong-type-arg
1619 (string-map 123 "abcde"))
1620
1621 (pass-if-exception "string" exception:wrong-type-arg
1622 (string-map "zzz" "abcde")))
1623
1624 (pass-if "constant"
1625 (let ((str (string-copy "foo")))
1626 (string-map! (lambda (c) #\x) str)
1627 (string=? str "xxx")))
1628
1629 (pass-if "identity"
1630 (let ((str (string-copy "foo")))
1631 (string-map! identity str)
1632 (string=? str "foo")))
1633
1634 (pass-if "upcase"
1635 (let ((str (string-copy "foo")))
1636 (string-map! char-upcase str)
1637 (string=? str "FOO"))))
1638
e5c5ac92
TTN
1639(with-test-prefix "string-for-each"
1640
685788d0
KR
1641 (with-test-prefix "bad proc"
1642
1643 (pass-if-exception "integer" exception:wrong-type-arg
1644 (string-for-each 123 "abcde"))
1645
1646 (pass-if-exception "string" exception:wrong-type-arg
1647 (string-for-each "zzz" "abcde")))
1648
e5c5ac92
TTN
1649 (pass-if "copy"
1650 (let* ((foo "foo")
1651 (bar (make-string (string-length foo)))
1652 (i 0))
1653 (string-for-each
1654 (lambda (c) (string-set! bar i c) (set! i (1+ i))) foo)
685788d0
KR
1655 (string=? foo bar))))
1656
1657(with-test-prefix "string-for-each-index"
1658
1659 (with-test-prefix "bad proc"
1660
1661 (pass-if-exception "integer" exception:wrong-type-arg
1662 (string-for-each-index 123 "abcde"))
1663
1664 (pass-if-exception "string" exception:wrong-type-arg
1665 (string-for-each-index "zzz" "abcde")))
e5c5ac92
TTN
1666
1667 (pass-if "index"
1668 (let* ((foo "foo")
1669 (bar (make-string (string-length foo))))
1670 (string-for-each-index
1671 (lambda (i) (string-set! bar i (string-ref foo i))) foo)
1672 (string=? foo bar))))
1673