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