Improved support for Unicode title case in Guile's string and character APIs.
[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;;;;
6e7d5622 4;;;; Copyright (C) 2001, 2004, 2005, 2006 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
MG
557 (pass-if "start and end index"
558 (string=? "o-ba" (string-copy "foo-bar" 2 6)))
df937d20
MG
559)
560
561(with-test-prefix "substring/shared"
562
563 (pass-if "empty string"
564 (eq? "" (substring/shared "" 0)))
565
566 (pass-if "non-empty string"
567 (string=? "foo" (substring/shared "foo-bar" 0 3)))
568
569 (pass-if "non-empty string, not eq?"
570 (string=? "foo-bar" (substring/shared "foo-bar" 0 7))))
571
572(with-test-prefix "string-copy!"
573
574 (pass-if "non-empty string"
575 (string=? "welld, oh yeah!"
576 (let* ((s "hello")
d7e4c2da 577 (t (string-copy "world, oh yeah!")))
df937d20
MG
578 (string-copy! t 1 s 1 3)
579 t))))
580
581(with-test-prefix "string-take"
582
583 (pass-if "empty string"
584 (string=? "" (string-take "foo bar braz" 0)))
585
586 (pass-if "non-empty string"
587 (string=? "foo " (string-take "foo bar braz" 4)))
588
1441e6db
MG
589 (pass-if "non-empty string BMP"
590 (string=? "\u0100oo " (string-take "\u0100oo \u0101ar braz" 4)))
591
df937d20
MG
592 (pass-if "full string"
593 (string=? "foo bar braz" (string-take "foo bar braz" 12))))
594
595(with-test-prefix "string-take-right"
596
597 (pass-if "empty string"
598 (string=? "" (string-take-right "foo bar braz" 0)))
599
600 (pass-if "non-empty string"
601 (string=? "braz" (string-take-right "foo bar braz" 4)))
602
1441e6db
MG
603 (pass-if "non-empty string"
604 (string=? "braz" (string-take-right "foo ba\u0100 braz" 4)))
605
df937d20
MG
606 (pass-if "full string"
607 (string=? "foo bar braz" (string-take-right "foo bar braz" 12))))
608
609(with-test-prefix "string-drop"
610
611 (pass-if "empty string"
612 (string=? "" (string-drop "foo bar braz" 12)))
613
614 (pass-if "non-empty string"
615 (string=? "braz" (string-drop "foo bar braz" 8)))
616
1441e6db
MG
617 (pass-if "non-empty string BMP"
618 (string=? "braz" (string-drop "foo \u0100\u0101\u0102 braz" 8)))
619
df937d20
MG
620 (pass-if "full string"
621 (string=? "foo bar braz" (string-drop "foo bar braz" 0))))
622
623(with-test-prefix "string-drop-right"
624
625 (pass-if "empty string"
626 (string=? "" (string-drop-right "foo bar braz" 12)))
627
628 (pass-if "non-empty string"
629 (string=? "foo " (string-drop-right "foo bar braz" 8)))
630
1441e6db
MG
631 (pass-if "non-empty string BMP"
632 (string=? "foo " (string-drop-right "foo \u0100\u0101\u0102 braz" 8)))
633
df937d20
MG
634 (pass-if "full string"
635 (string=? "foo bar braz" (string-drop-right "foo bar braz" 0))))
636
637(with-test-prefix "string-pad"
638
639 (pass-if "empty string, zero pad"
640 (string=? "" (string-pad "" 0)))
641
642 (pass-if "empty string, zero pad, pad char"
643 (string=? "" (string-pad "" 0)))
644
645 (pass-if "empty pad string, 2 pad "
646 (string=? " " (string-pad "" 2)))
647
648 (pass-if "empty pad string, 2 pad, pad char"
649 (string=? "!!" (string-pad "" 2 #\!)))
650
651 (pass-if "empty pad string, 2 pad, pad char, start index"
652 (string=? "!c" (string-pad "abc" 2 #\! 2)))
653
654 (pass-if "empty pad string, 2 pad, pad char, start and end index"
655 (string=? "!c" (string-pad "abcd" 2 #\! 2 3)))
656
657 (pass-if "freestyle 1"
658 (string=? "32" (string-pad (number->string 532) 2 #\!)))
659
660 (pass-if "freestyle 2"
661 (string=? "!532" (string-pad (number->string 532) 4 #\!))))
662
663(with-test-prefix "string-pad-right"
664
665 (pass-if "empty string, zero pad"
666 (string=? "" (string-pad-right "" 0)))
667
668 (pass-if "empty string, zero pad, pad char"
669 (string=? "" (string-pad-right "" 0)))
670
671 (pass-if "empty pad string, 2 pad "
672 (string=? " " (string-pad-right "" 2)))
673
674 (pass-if "empty pad string, 2 pad, pad char"
675 (string=? "!!" (string-pad-right "" 2 #\!)))
676
677 (pass-if "empty pad string, 2 pad, pad char, start index"
678 (string=? "c!" (string-pad-right "abc" 2 #\! 2)))
679
680 (pass-if "empty pad string, 2 pad, pad char, start and end index"
681 (string=? "c!" (string-pad-right "abcd" 2 #\! 2 3)))
682
683 (pass-if "freestyle 1"
684 (string=? "53" (string-pad-right (number->string 532) 2 #\!)))
685
686 (pass-if "freestyle 2"
687 (string=? "532!" (string-pad-right (number->string 532) 4 #\!))))
688
f764e6d1
MG
689(with-test-prefix "string-trim"
690
685788d0
KR
691 (with-test-prefix "bad char_pred"
692
693 (pass-if-exception "integer" exception:wrong-type-arg
694 (string-trim "abcde" 123))
695
696 (pass-if-exception "string" exception:wrong-type-arg
697 (string-trim "abcde" "zzz")))
698
f764e6d1
MG
699 (pass-if "empty string"
700 (string=? "" (string-trim "")))
701
702 (pass-if "no char/pred"
703 (string=? "foo " (string-trim " \tfoo ")))
704
705 (pass-if "start index, pred"
706 (string=? "foo " (string-trim " \tfoo " char-whitespace? 1)))
707
708 (pass-if "start and end index, pred"
709 (string=? "f" (string-trim " \tfoo " char-whitespace? 1 3)))
710
711 (pass-if "start index, char"
712 (string=? "\tfoo " (string-trim " \tfoo " #\space 1)))
713
714 (pass-if "start and end index, char"
715 (string=? "\tf" (string-trim " \tfoo " #\space 1 3)))
716
717 (pass-if "start index, charset"
718 (string=? "foo " (string-trim " \tfoo " char-set:whitespace 1)))
719
720 (pass-if "start and end index, charset"
721 (string=? "f" (string-trim " \tfoo " char-set:whitespace 1 3))))
722
723(with-test-prefix "string-trim-right"
724
685788d0
KR
725 (with-test-prefix "bad char_pred"
726
727 (pass-if-exception "integer" exception:wrong-type-arg
728 (string-trim-right "abcde" 123))
729
730 (pass-if-exception "string" exception:wrong-type-arg
731 (string-trim-right "abcde" "zzz")))
732
f764e6d1
MG
733 (pass-if "empty string"
734 (string=? "" (string-trim-right "")))
735
736 (pass-if "no char/pred"
737 (string=? " \tfoo" (string-trim-right " \tfoo ")))
738
739 (pass-if "start index, pred"
740 (string=? "\tfoo" (string-trim-right " \tfoo " char-whitespace? 1)))
741
742 (pass-if "start and end index, pred"
743 (string=? "\tf" (string-trim-right " \tfoo " char-whitespace? 1 3)))
744
745 (pass-if "start index, char"
746 (string=? "\tfoo" (string-trim-right " \tfoo " #\space 1)))
747
748 (pass-if "start and end index, char"
749 (string=? "\tf" (string-trim-right " \tfoo " #\space 1 3)))
750
751 (pass-if "start index, charset"
752 (string=? "\tfoo" (string-trim-right " \tfoo " char-set:whitespace 1)))
753
754 (pass-if "start and end index, charset"
755 (string=? "\tf" (string-trim-right " \tfoo " char-set:whitespace 1 3))))
756
757(with-test-prefix "string-trim-both"
758
685788d0
KR
759 (with-test-prefix "bad char_pred"
760
761 (pass-if-exception "integer" exception:wrong-type-arg
762 (string-trim-both "abcde" 123))
763
764 (pass-if-exception "string" exception:wrong-type-arg
765 (string-trim-both "abcde" "zzz")))
766
f764e6d1
MG
767 (pass-if "empty string"
768 (string=? "" (string-trim-both "")))
769
770 (pass-if "no char/pred"
771 (string=? "foo" (string-trim-both " \tfoo ")))
772
773 (pass-if "start index, pred"
774 (string=? "foo" (string-trim-both " \tfoo " char-whitespace? 1)))
775
776 (pass-if "start and end index, pred"
777 (string=? "f" (string-trim-both " \tfoo " char-whitespace? 1 3)))
778
779 (pass-if "start index, char"
780 (string=? "\tfoo" (string-trim-both " \tfoo " #\space 1)))
781
782 (pass-if "start and end index, char"
783 (string=? "\tf" (string-trim-both " \tfoo " #\space 1 3)))
784
785 (pass-if "start index, charset"
786 (string=? "foo" (string-trim-both " \tfoo " char-set:whitespace 1)))
787
788 (pass-if "start and end index, charset"
789 (string=? "f" (string-trim-both " \tfoo " char-set:whitespace 1 3))))
790
f764e6d1
MG
791(define s0 (make-string 200 #\!))
792(define s1 (make-string 0 #\!))
793
794(with-test-prefix "string-fill!"
795
796 (pass-if "empty string, no indices"
797 (string-fill! s1 #\*)
798 (= (string-length s1) 0))
799
800 (pass-if "empty string, start index"
801 (string-fill! s1 #\* 0)
802 (= (string-length s1) 0))
803
804 (pass-if "empty string, start and end index"
805 (string-fill! s1 #\* 0 0)
806 (= (string-length s1) 0))
807
808 (pass-if "no indices"
809 (string-fill! s0 #\*)
810 (char=? (string-ref s0 0) #\*))
811
812 (pass-if "start index"
813 (string-fill! s0 #\+ 10)
814 (char=? (string-ref s0 11) #\+))
815
816 (pass-if "start and end index"
817 (string-fill! s0 #\| 12 20)
818 (char=? (string-ref s0 13) #\|)))
819
5f5850b3
MG
820(with-test-prefix "string-prefix-length"
821
822 (pass-if "empty prefix"
823 (= 0 (string-prefix-length "" "foo bar")))
824
825 (pass-if "non-empty prefix - match"
826 (= 3 (string-prefix-length "foo" "foo bar")))
827
828 (pass-if "non-empty prefix - no match"
829 (= 0 (string-prefix-length "bar" "foo bar"))))
830
831(with-test-prefix "string-prefix-length-ci"
832
833 (pass-if "empty prefix"
834 (= 0 (string-prefix-length-ci "" "foo bar")))
835
836 (pass-if "non-empty prefix - match"
837 (= 3 (string-prefix-length-ci "fOo" "foo bar")))
838
839 (pass-if "non-empty prefix - no match"
840 (= 0 (string-prefix-length-ci "bAr" "foo bar"))))
841
842(with-test-prefix "string-suffix-length"
843
844 (pass-if "empty suffix"
845 (= 0 (string-suffix-length "" "foo bar")))
846
847 (pass-if "non-empty suffix - match"
848 (= 3 (string-suffix-length "bar" "foo bar")))
849
850 (pass-if "non-empty suffix - no match"
851 (= 0 (string-suffix-length "foo" "foo bar"))))
852
853(with-test-prefix "string-suffix-length-ci"
854
855 (pass-if "empty suffix"
856 (= 0 (string-suffix-length-ci "" "foo bar")))
857
858 (pass-if "non-empty suffix - match"
859 (= 3 (string-suffix-length-ci "bAr" "foo bar")))
860
861 (pass-if "non-empty suffix - no match"
862 (= 0 (string-suffix-length-ci "fOo" "foo bar"))))
863
864(with-test-prefix "string-prefix?"
865
866 (pass-if "empty prefix"
867 (string-prefix? "" "foo bar"))
868
869 (pass-if "non-empty prefix - match"
870 (string-prefix? "foo" "foo bar"))
871
872 (pass-if "non-empty prefix - no match"
873 (not (string-prefix? "bar" "foo bar"))))
874
875(with-test-prefix "string-prefix-ci?"
876
877 (pass-if "empty prefix"
878 (string-prefix-ci? "" "foo bar"))
879
880 (pass-if "non-empty prefix - match"
881 (string-prefix-ci? "fOo" "foo bar"))
882
883 (pass-if "non-empty prefix - no match"
884 (not (string-prefix-ci? "bAr" "foo bar"))))
885
886(with-test-prefix "string-suffix?"
887
888 (pass-if "empty suffix"
889 (string-suffix? "" "foo bar"))
890
891 (pass-if "non-empty suffix - match"
892 (string-suffix? "bar" "foo bar"))
893
894 (pass-if "non-empty suffix - no match"
895 (not (string-suffix? "foo" "foo bar"))))
896
897(with-test-prefix "string-suffix-ci?"
898
899 (pass-if "empty suffix"
900 (string-suffix-ci? "" "foo bar"))
901
902 (pass-if "non-empty suffix - match"
903 (string-suffix-ci? "bAr" "foo bar"))
904
905 (pass-if "non-empty suffix - no match"
906 (not (string-suffix-ci? "fOo" "foo bar"))))
907
5f5850b3
MG
908(with-test-prefix "string-index"
909
685788d0
KR
910 (with-test-prefix "bad char_pred"
911
912 (pass-if-exception "integer" exception:wrong-type-arg
913 (string-index "abcde" 123))
914
915 (pass-if-exception "string" exception:wrong-type-arg
916 (string-index "abcde" "zzz")))
917
5f5850b3
MG
918 (pass-if "empty string - char"
919 (not (string-index "" #\a)))
920
921 (pass-if "non-empty - char - match"
922 (= 5 (string-index "foo bar" #\a)))
923
924 (pass-if "non-empty - char - no match"
925 (not (string-index "frobnicate" #\x)))
926
927 (pass-if "empty string - char - start index"
928 (not (string-index "" #\a 0)))
929
930 (pass-if "non-empty - char - match - start index"
931 (= 5 (string-index "foo bar" #\a 1)))
932
933 (pass-if "non-empty - char - no match - start index"
934 (not (string-index "frobnicate" #\x 2)))
935
936 (pass-if "empty string - char - start and end index"
937 (not (string-index "" #\a 0 0)))
938
939 (pass-if "non-empty - char - match - start and end index"
940 (= 5 (string-index "foo bar" #\a 1 6)))
941
942 (pass-if "non-empty - char - no match - start and end index"
943 (not (string-index "frobnicate" #\a 2 5)))
944
945 (pass-if "empty string - charset"
946 (not (string-index "" char-set:letter)))
947
948 (pass-if "non-empty - charset - match"
949 (= 0 (string-index "foo bar" char-set:letter)))
950
951 (pass-if "non-empty - charset - no match"
952 (not (string-index "frobnicate" char-set:digit)))
953
954 (pass-if "empty string - charset - start index"
955 (not (string-index "" char-set:letter 0)))
956
957 (pass-if "non-empty - charset - match - start index"
958 (= 1 (string-index "foo bar" char-set:letter 1)))
959
960 (pass-if "non-empty - charset - no match - start index"
961 (not (string-index "frobnicate" char-set:digit 2)))
962
963 (pass-if "empty string - charset - start and end index"
964 (not (string-index "" char-set:letter 0 0)))
965
966 (pass-if "non-empty - charset - match - start and end index"
967 (= 1 (string-index "foo bar" char-set:letter 1 6)))
968
969 (pass-if "non-empty - charset - no match - start and end index"
970 (not (string-index "frobnicate" char-set:digit 2 5)))
971
972 (pass-if "empty string - pred"
973 (not (string-index "" char-alphabetic?)))
974
975 (pass-if "non-empty - pred - match"
976 (= 0 (string-index "foo bar" char-alphabetic?)))
977
978 (pass-if "non-empty - pred - no match"
979 (not (string-index "frobnicate" char-numeric?)))
980
981 (pass-if "empty string - pred - start index"
982 (not (string-index "" char-alphabetic? 0)))
983
984 (pass-if "non-empty - pred - match - start index"
985 (= 1 (string-index "foo bar" char-alphabetic? 1)))
986
987 (pass-if "non-empty - pred - no match - start index"
988 (not (string-index "frobnicate" char-numeric? 2)))
989
990 (pass-if "empty string - pred - start and end index"
991 (not (string-index "" char-alphabetic? 0 0)))
992
993 (pass-if "non-empty - pred - match - start and end index"
994 (= 1 (string-index "foo bar" char-alphabetic? 1 6)))
995
996 (pass-if "non-empty - pred - no match - start and end index"
59216e48
KR
997 (not (string-index "frobnicate" char-numeric? 2 5)))
998
999 ;; in guile 1.6.7 and earlier this resulted in a segv, because
1000 ;; SCM_MAKE_CHAR didn't cope with "signed char" arguments containing an
1001 ;; 8-bit value
1002 (pass-if "8-bit char in string"
1003 (begin
1004 (string-index (string (integer->char 200)) char-numeric?)
1005 #t)))
5f5850b3
MG
1006
1007(with-test-prefix "string-index-right"
1008
685788d0
KR
1009 (with-test-prefix "bad char_pred"
1010
1011 (pass-if-exception "integer" exception:wrong-type-arg
1012 (string-index-right "abcde" 123))
1013
1014 (pass-if-exception "string" exception:wrong-type-arg
1015 (string-index-right "abcde" "zzz")))
1016
5f5850b3
MG
1017 (pass-if "empty string - char"
1018 (not (string-index-right "" #\a)))
1019
1020 (pass-if "non-empty - char - match"
1021 (= 5 (string-index-right "foo bar" #\a)))
1022
1023 (pass-if "non-empty - char - no match"
1024 (not (string-index-right "frobnicate" #\x)))
1025
1026 (pass-if "empty string - char - start index-right"
1027 (not (string-index-right "" #\a 0)))
1028
1029 (pass-if "non-empty - char - match - start index"
1030 (= 5 (string-index-right "foo bar" #\a 1)))
1031
1032 (pass-if "non-empty - char - no match - start index"
1033 (not (string-index-right "frobnicate" #\x 2)))
1034
1035 (pass-if "empty string - char - start and end index"
1036 (not (string-index-right "" #\a 0 0)))
1037
1038 (pass-if "non-empty - char - match - start and end index"
1039 (= 5 (string-index-right "foo bar" #\a 1 6)))
1040
1041 (pass-if "non-empty - char - no match - start and end index"
1042 (not (string-index-right "frobnicate" #\a 2 5)))
1043
1044 (pass-if "empty string - charset"
1045 (not (string-index-right "" char-set:letter)))
1046
1047 (pass-if "non-empty - charset - match"
1048 (= 6 (string-index-right "foo bar" char-set:letter)))
1049
1050 (pass-if "non-empty - charset - no match"
1051 (not (string-index-right "frobnicate" char-set:digit)))
1052
1053 (pass-if "empty string - charset - start index"
1054 (not (string-index-right "" char-set:letter 0)))
1055
1056 (pass-if "non-empty - charset - match - start index"
1057 (= 6 (string-index-right "foo bar" char-set:letter 1)))
1058
1059 (pass-if "non-empty - charset - no match - start index"
1060 (not (string-index-right "frobnicate" char-set:digit 2)))
1061
1062 (pass-if "empty string - charset - start and end index"
1063 (not (string-index-right "" char-set:letter 0 0)))
1064
1065 (pass-if "non-empty - charset - match - start and end index"
1066 (= 5 (string-index-right "foo bar" char-set:letter 1 6)))
1067
1068 (pass-if "non-empty - charset - no match - start and end index"
1069 (not (string-index-right "frobnicate" char-set:digit 2 5)))
1070
1071 (pass-if "empty string - pred"
1072 (not (string-index-right "" char-alphabetic?)))
1073
1074 (pass-if "non-empty - pred - match"
1075 (= 6 (string-index-right "foo bar" char-alphabetic?)))
1076
1077 (pass-if "non-empty - pred - no match"
1078 (not (string-index-right "frobnicate" char-numeric?)))
1079
1080 (pass-if "empty string - pred - start index"
1081 (not (string-index-right "" char-alphabetic? 0)))
1082
1083 (pass-if "non-empty - pred - match - start index"
1084 (= 6 (string-index-right "foo bar" char-alphabetic? 1)))
1085
1086 (pass-if "non-empty - pred - no match - start index"
1087 (not (string-index-right "frobnicate" char-numeric? 2)))
1088
1089 (pass-if "empty string - pred - start and end index"
1090 (not (string-index-right "" char-alphabetic? 0 0)))
1091
1092 (pass-if "non-empty - pred - match - start and end index"
1093 (= 5 (string-index-right "foo bar" char-alphabetic? 1 6)))
1094
1095 (pass-if "non-empty - pred - no match - start and end index"
1096 (not (string-index-right "frobnicate" char-numeric? 2 5))))
1097
1098(with-test-prefix "string-skip"
1099
685788d0
KR
1100 (with-test-prefix "bad char_pred"
1101
1102 (pass-if-exception "integer" exception:wrong-type-arg
1103 (string-skip "abcde" 123))
1104
1105 (pass-if-exception "string" exception:wrong-type-arg
1106 (string-skip "abcde" "zzz")))
1107
5f5850b3
MG
1108 (pass-if "empty string - char"
1109 (not (string-skip "" #\a)))
1110
1111 (pass-if "non-empty - char - match"
1112 (= 0 (string-skip "foo bar" #\a)))
1113
1114 (pass-if "non-empty - char - no match"
1115 (= 0 (string-skip "frobnicate" #\x)))
1116
1117 (pass-if "empty string - char - start index"
1118 (not (string-skip "" #\a 0)))
1119
1120 (pass-if "non-empty - char - match - start index"
1121 (= 1 (string-skip "foo bar" #\a 1)))
1122
1123 (pass-if "non-empty - char - no match - start index"
1124 (= 2 (string-skip "frobnicate" #\x 2)))
1125
1126 (pass-if "empty string - char - start and end index"
1127 (not (string-skip "" #\a 0 0)))
1128
1129 (pass-if "non-empty - char - match - start and end index"
1130 (= 1 (string-skip "foo bar" #\a 1 6)))
1131
1132 (pass-if "non-empty - char - no match - start and end index"
1133 (= 2 (string-skip "frobnicate" #\a 2 5)))
1134
1135 (pass-if "empty string - charset"
1136 (not (string-skip "" char-set:letter)))
1137
1138 (pass-if "non-empty - charset - match"
1139 (= 3 (string-skip "foo bar" char-set:letter)))
1140
1141 (pass-if "non-empty - charset - no match"
1142 (= 0 (string-skip "frobnicate" char-set:digit)))
1143
1144 (pass-if "empty string - charset - start index"
1145 (not (string-skip "" char-set:letter 0)))
1146
1147 (pass-if "non-empty - charset - match - start index"
1148 (= 3 (string-skip "foo bar" char-set:letter 1)))
1149
1150 (pass-if "non-empty - charset - no match - start index"
1151 (= 2 (string-skip "frobnicate" char-set:digit 2)))
1152
1153 (pass-if "empty string - charset - start and end index"
1154 (not (string-skip "" char-set:letter 0 0)))
1155
1156 (pass-if "non-empty - charset - match - start and end index"
1157 (= 3 (string-skip "foo bar" char-set:letter 1 6)))
1158
1159 (pass-if "non-empty - charset - no match - start and end index"
1160 (= 2 (string-skip "frobnicate" char-set:digit 2 5)))
1161
1162 (pass-if "empty string - pred"
1163 (not (string-skip "" char-alphabetic?)))
1164
1165 (pass-if "non-empty - pred - match"
1166 (= 3 (string-skip "foo bar" char-alphabetic?)))
1167
1168 (pass-if "non-empty - pred - no match"
1169 (= 0 (string-skip "frobnicate" char-numeric?)))
1170
1171 (pass-if "empty string - pred - start index"
1172 (not (string-skip "" char-alphabetic? 0)))
1173
1174 (pass-if "non-empty - pred - match - start index"
1175 (= 3 (string-skip "foo bar" char-alphabetic? 1)))
1176
1177 (pass-if "non-empty - pred - no match - start index"
1178 (= 2 (string-skip "frobnicate" char-numeric? 2)))
1179
1180 (pass-if "empty string - pred - start and end index"
1181 (not (string-skip "" char-alphabetic? 0 0)))
1182
1183 (pass-if "non-empty - pred - match - start and end index"
1184 (= 3 (string-skip "foo bar" char-alphabetic? 1 6)))
1185
1186 (pass-if "non-empty - pred - no match - start and end index"
1187 (= 2 (string-skip "frobnicate" char-numeric? 2 5))))
1188
1189(with-test-prefix "string-skip-right"
1190
685788d0
KR
1191 (with-test-prefix "bad char_pred"
1192
1193 (pass-if-exception "integer" exception:wrong-type-arg
1194 (string-skip-right "abcde" 123))
1195
1196 (pass-if-exception "string" exception:wrong-type-arg
1197 (string-skip-right "abcde" "zzz")))
1198
5f5850b3
MG
1199 (pass-if "empty string - char"
1200 (not (string-skip-right "" #\a)))
1201
1202 (pass-if "non-empty - char - match"
1203 (= 6 (string-skip-right "foo bar" #\a)))
1204
1205 (pass-if "non-empty - char - no match"
1206 (= 9 (string-skip-right "frobnicate" #\x)))
1207
1208 (pass-if "empty string - char - start index-right"
1209 (not (string-skip-right "" #\a 0)))
1210
1211 (pass-if "non-empty - char - match - start index"
1212 (= 6 (string-skip-right "foo bar" #\a 1)))
1213
1214 (pass-if "non-empty - char - no match - start index"
1215 (= 9 (string-skip-right "frobnicate" #\x 2)))
1216
1217 (pass-if "empty string - char - start and end index"
1218 (not (string-skip-right "" #\a 0 0)))
1219
1220 (pass-if "non-empty - char - match - start and end index"
1221 (= 4 (string-skip-right "foo bar" #\a 1 6)))
1222
1223 (pass-if "non-empty - char - no match - start and end index"
1224 (= 4 (string-skip-right "frobnicate" #\a 2 5)))
1225
1226 (pass-if "empty string - charset"
1227 (not (string-skip-right "" char-set:letter)))
1228
1229 (pass-if "non-empty - charset - match"
1230 (= 3 (string-skip-right "foo bar" char-set:letter)))
1231
1232 (pass-if "non-empty - charset - no match"
1233 (= 9 (string-skip-right "frobnicate" char-set:digit)))
1234
1235 (pass-if "empty string - charset - start index"
1236 (not (string-skip-right "" char-set:letter 0)))
1237
1238 (pass-if "non-empty - charset - match - start index"
1239 (= 3 (string-skip-right "foo bar" char-set:letter 1)))
1240
1241 (pass-if "non-empty - charset - no match - start index"
1242 (= 9 (string-skip-right "frobnicate" char-set:digit 2)))
1243
1244 (pass-if "empty string - charset - start and end index"
1245 (not (string-skip-right "" char-set:letter 0 0)))
1246
1247 (pass-if "non-empty - charset - match - start and end index"
1248 (= 3 (string-skip-right "foo bar" char-set:letter 1 6)))
1249
1250 (pass-if "non-empty - charset - no match - start and end index"
1251 (= 4 (string-skip-right "frobnicate" char-set:digit 2 5)))
1252
1253 (pass-if "empty string - pred"
1254 (not (string-skip-right "" char-alphabetic?)))
1255
1256 (pass-if "non-empty - pred - match"
1257 (= 3 (string-skip-right "foo bar" char-alphabetic?)))
1258
1259 (pass-if "non-empty - pred - no match"
1260 (= 9 (string-skip-right "frobnicate" char-numeric?)))
1261
1262 (pass-if "empty string - pred - start index"
1263 (not (string-skip-right "" char-alphabetic? 0)))
1264
1265 (pass-if "non-empty - pred - match - start index"
1266 (= 3 (string-skip-right "foo bar" char-alphabetic? 1)))
1267
1268 (pass-if "non-empty - pred - no match - start index"
1269 (= 9 (string-skip-right "frobnicate" char-numeric? 2)))
1270
1271 (pass-if "empty string - pred - start and end index"
1272 (not (string-skip-right "" char-alphabetic? 0 0)))
1273
1274 (pass-if "non-empty - pred - match - start and end index"
1275 (= 3 (string-skip-right "foo bar" char-alphabetic? 1 6)))
1276
1277 (pass-if "non-empty - pred - no match - start and end index"
1278 (= 4 (string-skip-right "frobnicate" char-numeric? 2 5))))
1279
685788d0
KR
1280;;
1281;; string-count
1282;;
1283
1284(with-test-prefix "string-count"
1285
1286 (with-test-prefix "bad char_pred"
1287
1288 (pass-if-exception "integer" exception:wrong-type-arg
1289 (string-count "abcde" 123))
1290
1291 (pass-if-exception "string" exception:wrong-type-arg
1292 (string-count "abcde" "zzz")))
1293
1294 (with-test-prefix "char"
1295
1296 (pass-if (eqv? 0 (string-count "" #\a)))
1297 (pass-if (eqv? 0 (string-count "-" #\a)))
1298 (pass-if (eqv? 1 (string-count "a" #\a)))
1299 (pass-if (eqv? 0 (string-count "--" #\a)))
1300 (pass-if (eqv? 1 (string-count "a-" #\a)))
1301 (pass-if (eqv? 1 (string-count "-a" #\a)))
1302 (pass-if (eqv? 2 (string-count "aa" #\a)))
1303 (pass-if (eqv? 0 (string-count "---" #\a)))
1304 (pass-if (eqv? 1 (string-count "-a-" #\a)))
1305 (pass-if (eqv? 1 (string-count "a--" #\a)))
1306 (pass-if (eqv? 2 (string-count "aa-" #\a)))
1307 (pass-if (eqv? 2 (string-count "a-a" #\a)))
1308 (pass-if (eqv? 3 (string-count "aaa" #\a)))
1309 (pass-if (eqv? 1 (string-count "--a" #\a)))
1310 (pass-if (eqv? 2 (string-count "-aa" #\a))))
1311
1312 (with-test-prefix "charset"
1313
1314 (pass-if (eqv? 0 (string-count "" char-set:letter)))
1315 (pass-if (eqv? 0 (string-count "-" char-set:letter)))
1316 (pass-if (eqv? 1 (string-count "a" char-set:letter)))
1317 (pass-if (eqv? 0 (string-count "--" char-set:letter)))
1318 (pass-if (eqv? 1 (string-count "a-" char-set:letter)))
1319 (pass-if (eqv? 1 (string-count "-a" char-set:letter)))
1320 (pass-if (eqv? 2 (string-count "aa" char-set:letter)))
1321 (pass-if (eqv? 0 (string-count "---" char-set:letter)))
1322 (pass-if (eqv? 1 (string-count "-a-" char-set:letter)))
1323 (pass-if (eqv? 1 (string-count "a--" char-set:letter)))
1324 (pass-if (eqv? 2 (string-count "aa-" char-set:letter)))
1325 (pass-if (eqv? 2 (string-count "a-a" char-set:letter)))
1326 (pass-if (eqv? 3 (string-count "aaa" char-set:letter)))
1327 (pass-if (eqv? 1 (string-count "--a" char-set:letter)))
1328 (pass-if (eqv? 2 (string-count "-aa" char-set:letter))))
1329
1330 (with-test-prefix "proc"
1331
1332 (pass-if (eqv? 0 (string-count "" char-alphabetic?)))
1333 (pass-if (eqv? 0 (string-count "-" char-alphabetic?)))
1334 (pass-if (eqv? 1 (string-count "a" char-alphabetic?)))
1335 (pass-if (eqv? 0 (string-count "--" char-alphabetic?)))
1336 (pass-if (eqv? 1 (string-count "a-" char-alphabetic?)))
1337 (pass-if (eqv? 1 (string-count "-a" char-alphabetic?)))
1338 (pass-if (eqv? 2 (string-count "aa" char-alphabetic?)))
1339 (pass-if (eqv? 0 (string-count "---" char-alphabetic?)))
1340 (pass-if (eqv? 1 (string-count "-a-" char-alphabetic?)))
1341 (pass-if (eqv? 1 (string-count "a--" char-alphabetic?)))
1342 (pass-if (eqv? 2 (string-count "aa-" char-alphabetic?)))
1343 (pass-if (eqv? 2 (string-count "a-a" char-alphabetic?)))
1344 (pass-if (eqv? 3 (string-count "aaa" char-alphabetic?)))
1345 (pass-if (eqv? 1 (string-count "--a" char-alphabetic?)))
1346 (pass-if (eqv? 2 (string-count "-aa" char-alphabetic?)))))
1347
1348
f764e6d1
MG
1349(with-test-prefix "string-replace"
1350
1351 (pass-if "empty string(s), no indices"
1352 (string=? "" (string-replace "" "")))
1353
1354 (pass-if "empty string(s), 1 index"
1355 (string=? "" (string-replace "" "" 0)))
1356
1357 (pass-if "empty string(s), 2 indices"
1358 (string=? "" (string-replace "" "" 0 0)))
1359
1360 (pass-if "empty string(s), 3 indices"
1361 (string=? "" (string-replace "" "" 0 0 0)))
1362
1363 (pass-if "empty string(s), 4 indices"
1364 (string=? "" (string-replace "" "" 0 0 0 0)))
1365
1366 (pass-if "no indices"
1367 (string=? "uu" (string-replace "foo bar" "uu")))
1368
1369 (pass-if "one index"
1370 (string=? "fuu" (string-replace "foo bar" "uu" 1)))
1371
1372 (pass-if "two indices"
1373 (string=? "fuuar" (string-replace "foo bar" "uu" 1 5)))
1374
1375 (pass-if "three indices"
1376 (string=? "fuar" (string-replace "foo bar" "uu" 1 5 1)))
1377
1378 (pass-if "four indices"
1379 (string=? "fuar" (string-replace "foo bar" "uu" 1 5 1 2))))
1380
1381(with-test-prefix "string-tokenize"
1382
1383 (pass-if "empty string, no char/pred"
1384 (zero? (length (string-tokenize ""))))
1385
f764e6d1
MG
1386 (pass-if "empty string, charset"
1387 (zero? (length (string-tokenize "" char-set:punctuation))))
1388
1389 (pass-if "no char/pred"
1390 (equal? '("foo" "bar" "!a") (string-tokenize "foo\tbar !a")))
1391
f764e6d1 1392 (pass-if "charset"
d26d2903
MV
1393 (equal? '("foo" "bar" "!a") (string-tokenize "foo\tbar !a"
1394 char-set:graphic)))
f764e6d1
MG
1395
1396 (pass-if "charset, start index"
d26d2903
MV
1397 (equal? '("oo" "bar" "!a") (string-tokenize "foo\tbar !a"
1398 char-set:graphic 1)))
f764e6d1
MG
1399
1400 (pass-if "charset, start and end index"
d26d2903
MV
1401 (equal? '("oo" "bar" "!") (string-tokenize "foo\tbar !a"
1402 char-set:graphic 1 9))))
f2974952
KR
1403;;;
1404;;; string-filter
1405;;;
f764e6d1
MG
1406
1407(with-test-prefix "string-filter"
1408
f2974952
KR
1409 (with-test-prefix "bad char_pred"
1410
1411 (pass-if-exception "integer" exception:wrong-type-arg
685788d0 1412 (string-filter "abcde" 123))
f2974952
KR
1413
1414 (pass-if-exception "string" exception:wrong-type-arg
685788d0 1415 (string-filter "abcde" "zzz")))
f2974952 1416
f764e6d1
MG
1417 (pass-if "empty string, char"
1418 (string=? "" (string-filter "" #\.)))
1419
1420 (pass-if "empty string, charset"
1421 (string=? "" (string-filter "" char-set:punctuation)))
1422
1423 (pass-if "empty string, pred"
1424 (string=? "" (string-filter "" char-alphabetic?)))
1425
1426 (pass-if "char"
1427 (string=? "..." (string-filter ".foo.bar." #\.)))
1428
1429 (pass-if "charset"
1430 (string=? "..." (string-filter ".foo.bar." char-set:punctuation)))
1431
1432 (pass-if "pred"
1433 (string=? "foobar" (string-filter ".foo.bar." char-alphabetic?)))
1434
1435 (pass-if "char, start index"
1436 (string=? ".." (string-filter ".foo.bar." #\. 2)))
1437
1438 (pass-if "charset, start index"
1439 (string=? ".." (string-filter ".foo.bar." char-set:punctuation 2)))
1440
1441 (pass-if "pred, start index"
1442 (string=? "oobar" (string-filter ".foo.bar." char-alphabetic? 2)))
1443
1444 (pass-if "char, start and end index"
1445 (string=? "" (string-filter ".foo.bar." #\. 2 4)))
1446
1447 (pass-if "charset, start and end index"
1448 (string=? "" (string-filter ".foo.bar." char-set:punctuation 2 4)))
1449
1450 (pass-if "pred, start and end index"
f2974952
KR
1451 (string=? "oo" (string-filter ".foo.bar." char-alphabetic? 2 4)))
1452
1453 (with-test-prefix "char"
1454
1455 (pass-if (equal? "x" (string-filter "x" #\x)))
1456 (pass-if (equal? "xx" (string-filter "xx" #\x)))
1457 (pass-if (equal? "xx" (string-filter "xyx" #\x)))
1458 (pass-if (equal? "x" (string-filter "xyyy" #\x)))
1459 (pass-if (equal? "x" (string-filter "yyyx" #\x)))
1460
1461 (pass-if (equal? "xx" (string-filter "xxx" #\x 1)))
1462 (pass-if (equal? "xx" (string-filter "xxx" #\x 0 2)))
1463 (pass-if (equal? "x" (string-filter "xyx" #\x 1)))
685788d0
KR
1464 (pass-if (equal? "x" (string-filter "yxx" #\x 0 2)))
1465
1466 ;; leading and trailing removals
1467 (pass-if (string=? "" (string-filter "." #\x)))
1468 (pass-if (string=? "" (string-filter ".." #\x)))
1469 (pass-if (string=? "" (string-filter "..." #\x)))
1470 (pass-if (string=? "x" (string-filter ".x" #\x)))
1471 (pass-if (string=? "x" (string-filter "..x" #\x)))
1472 (pass-if (string=? "x" (string-filter "...x" #\x)))
1473 (pass-if (string=? "x" (string-filter "x." #\x)))
1474 (pass-if (string=? "x" (string-filter "x.." #\x)))
1475 (pass-if (string=? "x" (string-filter "x..." #\x)))
1476 (pass-if (string=? "x" (string-filter "...x..." #\x))))
f2974952
KR
1477
1478 (with-test-prefix "charset"
1479
1480 (let ((charset (char-set #\x #\y)))
1481 (pass-if (equal? "x" (string-filter "x" charset)))
1482 (pass-if (equal? "xx" (string-filter "xx" charset)))
1483 (pass-if (equal? "xy" (string-filter "xy" charset)))
1484 (pass-if (equal? "x" (string-filter "xaaa" charset)))
1485 (pass-if (equal? "y" (string-filter "aaay" charset)))
1486
1487 (pass-if (equal? "yx" (string-filter "xyx" charset 1)))
1488 (pass-if (equal? "xy" (string-filter "xyx" charset 0 2)))
1489 (pass-if (equal? "x" (string-filter "xax" charset 1)))
685788d0
KR
1490 (pass-if (equal? "x" (string-filter "axx" charset 0 2))))
1491
1492 ;; leading and trailing removals
1493 (pass-if (string=? "" (string-filter "." char-set:letter)))
1494 (pass-if (string=? "" (string-filter ".." char-set:letter)))
1495 (pass-if (string=? "" (string-filter "..." char-set:letter)))
1496 (pass-if (string=? "x" (string-filter ".x" char-set:letter)))
1497 (pass-if (string=? "x" (string-filter "..x" char-set:letter)))
1498 (pass-if (string=? "x" (string-filter "...x" char-set:letter)))
1499 (pass-if (string=? "x" (string-filter "x." char-set:letter)))
1500 (pass-if (string=? "x" (string-filter "x.." char-set:letter)))
1501 (pass-if (string=? "x" (string-filter "x..." char-set:letter)))
1502 (pass-if (string=? "x" (string-filter "...x..." char-set:letter)))))
f2974952
KR
1503
1504;;;
1505;;; string-delete
1506;;;
f764e6d1
MG
1507
1508(with-test-prefix "string-delete"
1509
685788d0
KR
1510 (with-test-prefix "bad char_pred"
1511
1512 (pass-if-exception "integer" exception:wrong-type-arg
1513 (string-delete "abcde" 123))
1514
1515 (pass-if-exception "string" exception:wrong-type-arg
1516 (string-delete "abcde" "zzz")))
1517
f764e6d1
MG
1518 (pass-if "empty string, char"
1519 (string=? "" (string-delete "" #\.)))
1520
1521 (pass-if "empty string, charset"
1522 (string=? "" (string-delete "" char-set:punctuation)))
1523
1524 (pass-if "empty string, pred"
1525 (string=? "" (string-delete "" char-alphabetic?)))
1526
1527 (pass-if "char"
1528 (string=? "foobar" (string-delete ".foo.bar." #\.)))
1529
1530 (pass-if "charset"
1531 (string=? "foobar" (string-delete ".foo.bar." char-set:punctuation)))
1532
1533 (pass-if "pred"
1534 (string=? "..." (string-delete ".foo.bar." char-alphabetic?)))
1535
1536 (pass-if "char, start index"
1537 (string=? "oobar" (string-delete ".foo.bar." #\. 2)))
1538
1539 (pass-if "charset, start index"
1540 (string=? "oobar" (string-delete ".foo.bar." char-set:punctuation 2)))
1541
1542 (pass-if "pred, start index"
1543 (string=? ".." (string-delete ".foo.bar." char-alphabetic? 2)))
1544
1545 (pass-if "char, start and end index"
1546 (string=? "oo" (string-delete ".foo.bar." #\. 2 4)))
1547
1548 (pass-if "charset, start and end index"
1549 (string=? "oo" (string-delete ".foo.bar." char-set:punctuation 2 4)))
1550
1551 (pass-if "pred, start and end index"
685788d0
KR
1552 (string=? "" (string-delete ".foo.bar." char-alphabetic? 2 4)))
1553
1554 ;; leading and trailing removals
1555 (pass-if (string=? "" (string-delete "." #\.)))
1556 (pass-if (string=? "" (string-delete ".." #\.)))
1557 (pass-if (string=? "" (string-delete "..." #\.)))
1558 (pass-if (string=? "x" (string-delete ".x" #\.)))
1559 (pass-if (string=? "x" (string-delete "..x" #\.)))
1560 (pass-if (string=? "x" (string-delete "...x" #\.)))
1561 (pass-if (string=? "x" (string-delete "x." #\.)))
1562 (pass-if (string=? "x" (string-delete "x.." #\.)))
1563 (pass-if (string=? "x" (string-delete "x..." #\.)))
1564 (pass-if (string=? "x" (string-delete "...x..." #\.)))
1565
1566 ;; leading and trailing removals
1567 (pass-if (string=? "" (string-delete "." char-set:punctuation)))
1568 (pass-if (string=? "" (string-delete ".." char-set:punctuation)))
1569 (pass-if (string=? "" (string-delete "..." char-set:punctuation)))
1570 (pass-if (string=? "x" (string-delete ".x" char-set:punctuation)))
1571 (pass-if (string=? "x" (string-delete "..x" char-set:punctuation)))
1572 (pass-if (string=? "x" (string-delete "...x" char-set:punctuation)))
1573 (pass-if (string=? "x" (string-delete "x." char-set:punctuation)))
1574 (pass-if (string=? "x" (string-delete "x.." char-set:punctuation)))
1575 (pass-if (string=? "x" (string-delete "x..." char-set:punctuation)))
1576 (pass-if (string=? "x" (string-delete "...x..." char-set:punctuation))))
1577
80fdeb4e
MD
1578
1579(with-test-prefix "string-map"
1580
685788d0
KR
1581 (with-test-prefix "bad proc"
1582
1583 (pass-if-exception "integer" exception:wrong-type-arg
1584 (string-map 123 "abcde"))
1585
1586 (pass-if-exception "string" exception:wrong-type-arg
1587 (string-map "zzz" "abcde")))
1588
80fdeb4e
MD
1589 (pass-if "constant"
1590 (string=? "xxx" (string-map (lambda (c) #\x) "foo")))
1591
1592 (pass-if "identity"
1593 (string=? "foo" (string-map identity "foo")))
1594
1595 (pass-if "upcase"
1596 (string=? "FOO" (string-map char-upcase "foo"))))
e5c5ac92 1597
685788d0
KR
1598(with-test-prefix "string-map!"
1599
1600 (with-test-prefix "bad proc"
1601
1602 (pass-if-exception "integer" exception:wrong-type-arg
1603 (string-map 123 "abcde"))
1604
1605 (pass-if-exception "string" exception:wrong-type-arg
1606 (string-map "zzz" "abcde")))
1607
1608 (pass-if "constant"
1609 (let ((str (string-copy "foo")))
1610 (string-map! (lambda (c) #\x) str)
1611 (string=? str "xxx")))
1612
1613 (pass-if "identity"
1614 (let ((str (string-copy "foo")))
1615 (string-map! identity str)
1616 (string=? str "foo")))
1617
1618 (pass-if "upcase"
1619 (let ((str (string-copy "foo")))
1620 (string-map! char-upcase str)
1621 (string=? str "FOO"))))
1622
e5c5ac92
TTN
1623(with-test-prefix "string-for-each"
1624
685788d0
KR
1625 (with-test-prefix "bad proc"
1626
1627 (pass-if-exception "integer" exception:wrong-type-arg
1628 (string-for-each 123 "abcde"))
1629
1630 (pass-if-exception "string" exception:wrong-type-arg
1631 (string-for-each "zzz" "abcde")))
1632
e5c5ac92
TTN
1633 (pass-if "copy"
1634 (let* ((foo "foo")
1635 (bar (make-string (string-length foo)))
1636 (i 0))
1637 (string-for-each
1638 (lambda (c) (string-set! bar i c) (set! i (1+ i))) foo)
685788d0
KR
1639 (string=? foo bar))))
1640
1641(with-test-prefix "string-for-each-index"
1642
1643 (with-test-prefix "bad proc"
1644
1645 (pass-if-exception "integer" exception:wrong-type-arg
1646 (string-for-each-index 123 "abcde"))
1647
1648 (pass-if-exception "string" exception:wrong-type-arg
1649 (string-for-each-index "zzz" "abcde")))
e5c5ac92
TTN
1650
1651 (pass-if "index"
1652 (let* ((foo "foo")
1653 (bar (make-string (string-length foo))))
1654 (string-for-each-index
1655 (lambda (i) (string-set! bar i (string-ref foo i))) foo)
1656 (string=? foo bar))))
1657