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