guile18/test-suite/tests/srfi-13.test

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