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