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