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