1;;;; srfi-14.test -*- mode:scheme; coding: iso-8859-1 -*- 2;;;; --- Test suite for Guile's SRFI-14 functions. 3;;;; Martin Grabmueller, 2001-07-16 4;;;; 5;;;; Copyright (C) 2001, 2006, 2009, 2010, 2014 Free Software Foundation, Inc. 6;;;; 7;;;; This library is free software; you can redistribute it and/or 8;;;; modify it under the terms of the GNU Lesser General Public 9;;;; License as published by the Free Software Foundation; either 10;;;; version 3 of the License, or (at your option) any later version. 11;;;; 12;;;; This library is distributed in the hope that it will be useful, 13;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of 14;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 15;;;; Lesser General Public License for more details. 16;;;; 17;;;; You should have received a copy of the GNU Lesser General Public 18;;;; License along with this library; if not, write to the Free Software 19;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 20 21(define-module (test-suite test-srfi-14) 22 :use-module (srfi srfi-14) 23 :use-module (srfi srfi-1) ;; `every' 24 :use-module (test-suite lib)) 25 26 27(define exception:invalid-char-set-cursor 28 (cons 'misc-error "^invalid character set cursor")) 29 30(define exception:non-char-return 31 (cons 'misc-error "returned non-char")) 32 33 34(with-test-prefix "char set contents" 35 36 (pass-if "empty set" 37 (list= eqv? 38 (char-set->list (char-set)) 39 '())) 40 41 (pass-if "single char" 42 (list= eqv? 43 (char-set->list (char-set #\a)) 44 (list #\a))) 45 46 (pass-if "contiguous chars" 47 (list= eqv? 48 (char-set->list (char-set #\a #\b #\c)) 49 (list #\a #\b #\c))) 50 51 (pass-if "discontiguous chars" 52 (list= eqv? 53 (char-set->list (char-set #\a #\c #\e)) 54 (list #\a #\c #\e)))) 55 56(with-test-prefix "char set additition" 57 58 (pass-if "empty + x" 59 (let ((cs (char-set))) 60 (char-set-adjoin! cs #\x) 61 (list= eqv? 62 (char-set->list cs) 63 (list #\x)))) 64 65 (pass-if "x + y" 66 (let ((cs (char-set #\x))) 67 (char-set-adjoin! cs #\y) 68 (list= eqv? 69 (char-set->list cs) 70 (list #\x #\y)))) 71 72 (pass-if "x + w" 73 (let ((cs (char-set #\x))) 74 (char-set-adjoin! cs #\w) 75 (list= eqv? 76 (char-set->list cs) 77 (list #\w #\x)))) 78 79 (pass-if "x + z" 80 (let ((cs (char-set #\x))) 81 (char-set-adjoin! cs #\z) 82 (list= eqv? 83 (char-set->list cs) 84 (list #\x #\z)))) 85 86 (pass-if "x + v" 87 (let ((cs (char-set #\x))) 88 (char-set-adjoin! cs #\v) 89 (list= eqv? 90 (char-set->list cs) 91 (list #\v #\x)))) 92 93 (pass-if "uv + w" 94 (let ((cs (char-set #\u #\v))) 95 (char-set-adjoin! cs #\w) 96 (list= eqv? 97 (char-set->list cs) 98 (list #\u #\v #\w)))) 99 100 (pass-if "uv + t" 101 (let ((cs (char-set #\u #\v))) 102 (char-set-adjoin! cs #\t) 103 (list= eqv? 104 (char-set->list cs) 105 (list #\t #\u #\v)))) 106 107 (pass-if "uv + x" 108 (let ((cs (char-set #\u #\v))) 109 (char-set-adjoin! cs #\x) 110 (list= eqv? 111 (char-set->list cs) 112 (list #\u #\v #\x)))) 113 114 (pass-if "uv + s" 115 (let ((cs (char-set #\u #\v))) 116 (char-set-adjoin! cs #\s) 117 (list= eqv? 118 (char-set->list cs) 119 (list #\s #\u #\v)))) 120 121 (pass-if "uvx + w" 122 (let ((cs (char-set #\u #\v #\x))) 123 (char-set-adjoin! cs #\w) 124 (list= eqv? 125 (char-set->list cs) 126 (list #\u #\v #\w #\x)))) 127 128 (pass-if "uvx + y" 129 (let ((cs (char-set #\u #\v #\x))) 130 (char-set-adjoin! cs #\y) 131 (list= eqv? 132 (char-set->list cs) 133 (list #\u #\v #\x #\y)))) 134 135 (pass-if "uvxy + w" 136 (let ((cs (char-set #\u #\v #\x #\y))) 137 (char-set-adjoin! cs #\w) 138 (list= eqv? 139 (char-set->list cs) 140 (list #\u #\v #\w #\x #\y))))) 141 142(with-test-prefix "char set union" 143 (pass-if "null U abc" 144 (char-set= (char-set-union (char-set) (->char-set "abc")) 145 (->char-set "abc"))) 146 147 (pass-if "ab U ab" 148 (char-set= (char-set-union (->char-set "ab") (->char-set "ab")) 149 (->char-set "ab"))) 150 151 (pass-if "ab U bc" 152 (char-set= (char-set-union (->char-set "ab") (->char-set "bc")) 153 (->char-set "abc"))) 154 155 (pass-if "ab U cd" 156 (char-set= (char-set-union (->char-set "ab") (->char-set "cd")) 157 (->char-set "abcd"))) 158 159 (pass-if "ab U de" 160 (char-set= (char-set-union (->char-set "ab") (->char-set "de")) 161 (->char-set "abde"))) 162 163 (pass-if "abc U bcd" 164 (char-set= (char-set-union (->char-set "abc") (->char-set "bcd")) 165 (->char-set "abcd"))) 166 167 (pass-if "abdf U abcdefg" 168 (char-set= (char-set-union (->char-set "abdf") (->char-set "abcdefg")) 169 (->char-set "abcdefg"))) 170 171 (pass-if "abef U cd" 172 (char-set= (char-set-union (->char-set "abef") (->char-set "cd")) 173 (->char-set "abcdef"))) 174 175 (pass-if "abgh U cd" 176 (char-set= (char-set-union (->char-set "abgh") (->char-set "cd")) 177 (->char-set "abcdgh"))) 178 179 (pass-if "bc U ab" 180 (char-set= (char-set-union (->char-set "bc") (->char-set "ab")) 181 (->char-set "abc"))) 182 183 (pass-if "cd U ab" 184 (char-set= (char-set-union (->char-set "cd") (->char-set "ab")) 185 (->char-set "abcd"))) 186 187 (pass-if "de U ab" 188 (char-set= (char-set-union (->char-set "de") (->char-set "ab")) 189 (->char-set "abde"))) 190 191 (pass-if "cd U abc" 192 (char-set= (char-set-union (->char-set "cd") (->char-set "abc")) 193 (->char-set "abcd"))) 194 195 (pass-if "cd U abcd" 196 (char-set= (char-set-union (->char-set "cd") (->char-set "abcd")) 197 (->char-set "abcd"))) 198 199 (pass-if "cde U abcdef" 200 (char-set= (char-set-union (->char-set "cde") (->char-set "abcdef")) 201 (->char-set "abcdef")))) 202 203(with-test-prefix "char set xor" 204 (pass-if "null - xy" 205 (char-set= (char-set-xor (char-set) (char-set #\x #\y)) 206 (char-set #\x #\y))) 207 208 (pass-if "x - x" 209 (char-set= (char-set-xor (char-set #\x) (char-set #\x)) 210 (char-set))) 211 212 (pass-if "xy - x" 213 (char-set= (char-set-xor (char-set #\x #\y) (char-set #\x)) 214 (char-set #\y))) 215 216 (pass-if "xy - y" 217 (char-set= (char-set-xor (char-set #\x #\y) (char-set #\y)) 218 (char-set #\x))) 219 220 (pass-if "wxy - w" 221 (char-set= (char-set-xor (char-set #\w #\x #\y) (char-set #\w)) 222 (char-set #\x #\y))) 223 224 (pass-if "wxy - x" 225 (char-set= (char-set-xor (char-set #\w #\x #\y) (char-set #\x)) 226 (char-set #\w #\y))) 227 228 (pass-if "wxy - y" 229 (char-set= (char-set-xor (char-set #\w #\x #\y) (char-set #\y)) 230 (char-set #\w #\x))) 231 232 (pass-if "uvxy - u" 233 (char-set= (char-set-xor (char-set #\u #\v #\x #\y) (char-set #\u)) 234 (char-set #\v #\x #\y))) 235 236 (pass-if "uvxy - v" 237 (char-set= (char-set-xor (char-set #\u #\v #\x #\y) (char-set #\v)) 238 (char-set #\u #\x #\y))) 239 240 (pass-if "uvxy - x" 241 (char-set= (char-set-xor (char-set #\u #\v #\x #\y) (char-set #\x)) 242 (char-set #\u #\v #\y))) 243 244 (pass-if "uvxy - y" 245 (char-set= (char-set-xor (char-set #\u #\v #\x #\y) (char-set #\y)) 246 (char-set #\u #\v #\x))) 247 248 (pass-if "uwy - u" 249 (char-set= (char-set-xor (char-set #\u #\w #\y) (char-set #\u)) 250 (char-set #\w #\y))) 251 252 (pass-if "uwy - w" 253 (char-set= (char-set-xor (char-set #\u #\w #\y) (char-set #\w)) 254 (char-set #\u #\y))) 255 256 (pass-if "uwy - y" 257 (char-set= (char-set-xor (char-set #\u #\w #\y) (char-set #\y)) 258 (char-set #\u #\w))) 259 260 (pass-if "uvwy - v" 261 (char-set= (char-set-xor (char-set #\u #\v #\w #\y) (char-set #\v)) 262 (char-set #\u #\w #\y)))) 263 264 265(with-test-prefix "char-set?" 266 267 (pass-if "success on empty set" 268 (char-set? (char-set))) 269 270 (pass-if "success on non-empty set" 271 (char-set? char-set:printing)) 272 273 (pass-if "failure on empty set" 274 (not (char-set? #t)))) 275 276 277(with-test-prefix "char-set=" 278 (pass-if "success, no arg" 279 (char-set=)) 280 281 (pass-if "success, one arg" 282 (char-set= char-set:lower-case)) 283 284 (pass-if "success, two args" 285 (char-set= char-set:upper-case char-set:upper-case)) 286 287 (pass-if "failure, first empty" 288 (not (char-set= (char-set) (char-set #\a)))) 289 290 (pass-if "failure, second empty" 291 (not (char-set= (char-set #\a) (char-set)))) 292 293 (pass-if "success, more args" 294 (char-set= char-set:blank char-set:blank char-set:blank)) 295 296 (pass-if "failure, same length, different elements" 297 (not (char-set= (char-set #\a #\b #\d) (char-set #\a #\c #\d))))) 298 299(with-test-prefix "char-set<=" 300 (pass-if "success, no arg" 301 (char-set<=)) 302 303 (pass-if "success, one arg" 304 (char-set<= char-set:lower-case)) 305 306 (pass-if "success, two args" 307 (char-set<= char-set:upper-case char-set:upper-case)) 308 309 (pass-if "success, first empty" 310 (char-set<= (char-set) (char-set #\a))) 311 312 (pass-if "failure, second empty" 313 (not (char-set<= (char-set #\a) (char-set)))) 314 315 (pass-if "success, more args, equal" 316 (char-set<= char-set:blank char-set:blank char-set:blank)) 317 318 (pass-if "success, more args, not equal" 319 (char-set<= char-set:blank 320 (char-set-adjoin char-set:blank #\F) 321 (char-set-adjoin char-set:blank #\F #\o)))) 322 323(with-test-prefix "char-set-hash" 324 (pass-if "empty set, bound" 325 (let ((h (char-set-hash char-set:empty 31))) 326 (and h (number? h) (exact? h) (>= h 0) (< h 31)))) 327 328 (pass-if "empty set, no bound" 329 (let ((h (char-set-hash char-set:empty))) 330 (and h (number? h) (exact? h) (>= h 0)))) 331 332 (pass-if "full set, bound" 333 (let ((h (char-set-hash char-set:full 31))) 334 (and h (number? h) (exact? h) (>= h 0) (< h 31)))) 335 336 (pass-if "full set, no bound" 337 (let ((h (char-set-hash char-set:full))) 338 (and h (number? h) (exact? h) (>= h 0)))) 339 340 (pass-if "other set, bound" 341 (let ((h (char-set-hash (char-set #\f #\o #\b #\a #\r) 31))) 342 (and h (number? h) (exact? h) (>= h 0) (< h 31)))) 343 344 (pass-if "other set, no bound" 345 (let ((h (char-set-hash (char-set #\f #\o #\b #\a #\r)))) 346 (and h (number? h) (exact? h) (>= h 0))))) 347 348 349(with-test-prefix "char-set cursor" 350 351 (pass-if-exception "invalid character cursor" 352 exception:wrong-type-arg 353 (let* ((cs (char-set #\B #\r #\a #\z)) 354 (cc (char-set-cursor cs))) 355 (char-set-ref cs 1000))) 356 357 (pass-if "success" 358 (let* ((cs (char-set #\B #\r #\a #\z)) 359 (cc (char-set-cursor cs))) 360 (char? (char-set-ref cs cc)))) 361 362 (pass-if "end of set fails" 363 (let* ((cs (char-set #\a)) 364 (cc (char-set-cursor cs))) 365 (not (end-of-char-set? cc)))) 366 367 (pass-if "end of set succeeds, empty set" 368 (let* ((cs (char-set)) 369 (cc (char-set-cursor cs))) 370 (end-of-char-set? cc))) 371 372 (pass-if "end of set succeeds, non-empty set" 373 (let* ((cs (char-set #\a)) 374 (cc (char-set-cursor cs)) 375 (cc (char-set-cursor-next cs cc))) 376 (end-of-char-set? cc)))) 377 378(with-test-prefix "char-set-fold" 379 380 (pass-if "count members" 381 (= (char-set-fold (lambda (c n) (+ n 1)) 0 (char-set #\a #\b)) 2)) 382 383 (pass-if "copy set" 384 (= (char-set-size (char-set-fold (lambda (c cs) (char-set-adjoin cs c)) 385 (char-set) (char-set #\a #\b))) 2))) 386 387(define char-set:256 388 (string->char-set (apply string (map integer->char (iota 256))))) 389 390(with-test-prefix "char-set-unfold" 391 392 (pass-if "create char set" 393 (char-set= char-set:256 394 (char-set-unfold (lambda (s) (= s 256)) integer->char 395 (lambda (s) (+ s 1)) 0))) 396 (pass-if "create char set (base set)" 397 (char-set= char-set:256 398 (char-set-unfold (lambda (s) (= s 256)) integer->char 399 (lambda (s) (+ s 1)) 0 char-set:empty)))) 400 401(with-test-prefix "char-set-unfold!" 402 403 (pass-if "create char set" 404 (char-set= char-set:256 405 (char-set-unfold! (lambda (s) (= s 256)) integer->char 406 (lambda (s) (+ s 1)) 0 407 (char-set-copy char-set:empty)))) 408 409 (pass-if "create char set" 410 (char-set= char-set:256 411 (char-set-unfold! (lambda (s) (= s 32)) integer->char 412 (lambda (s) (+ s 1)) 0 413 (char-set-copy char-set:256))))) 414 415 416(with-test-prefix "char-set-for-each" 417 418 (pass-if "copy char set" 419 (= (char-set-size (let ((cs (char-set))) 420 (char-set-for-each 421 (lambda (c) (char-set-adjoin! cs c)) 422 (char-set #\a #\b)) 423 cs)) 424 2))) 425 426(with-test-prefix "char-set-map" 427 428 (pass-if "upper case char set 1" 429 (char-set= (char-set-map char-upcase 430 (string->char-set "abcdefghijklmnopqrstuvwxyz")) 431 (string->char-set "ABCDEFGHIJKLMNOPQRSTUVWXYZ"))) 432 433 (pass-if "upper case char set 2" 434 (char-set= (char-set-map char-upcase 435 (string->char-set "�����������������������������")) 436 (string->char-set "�����������������������������")))) 437 438(with-test-prefix "string->char-set" 439 440 (pass-if "some char set" 441 (let ((chars '(#\g #\u #\i #\l #\e))) 442 (char-set= (list->char-set chars) 443 (string->char-set (apply string chars)))))) 444 445(with-test-prefix "char-set->string" 446 447 (pass-if "some char set" 448 (let ((cs (char-set #\g #\u #\i #\l #\e))) 449 (string=? (char-set->string cs) 450 "egilu")))) 451 452(with-test-prefix "list->char-set" 453 454 (pass-if "list->char-set" 455 (char-set= (list->char-set '(#\a #\b #\c)) 456 (->char-set "abc"))) 457 458 (pass-if "list->char-set!" 459 (let* ((cs (char-set #\a #\z))) 460 (list->char-set! '(#\m #\n) cs) 461 (char-set= cs 462 (char-set #\a #\m #\n #\z))))) 463 464(with-test-prefix "string->char-set" 465 466 (pass-if "string->char-set" 467 (char-set= (string->char-set "foobar") 468 (string->char-set "barfoo"))) 469 470 (pass-if "string->char-set cs" 471 (char-set= (string->char-set "foo" (string->char-set "bar")) 472 (string->char-set "barfoo"))) 473 474 (pass-if "string->char-set!" 475 (let ((cs (string->char-set "bar"))) 476 (string->char-set! "foo" cs) 477 (char-set= cs 478 (string->char-set "barfoo"))))) 479 480(with-test-prefix "char-set-filter" 481 482 (pass-if "filter w/o base" 483 (char-set= 484 (char-set-filter (lambda (c) (char=? c #\x)) 485 (->char-set "qrstuvwxyz")) 486 (->char-set #\x))) 487 488 (pass-if "filter w/ base" 489 (char-set= 490 (char-set-filter (lambda (c) (char=? c #\x)) 491 (->char-set "qrstuvwxyz") 492 (->char-set "op")) 493 494 (->char-set "opx"))) 495 496 (pass-if "filter!" 497 (let ((cs (->char-set "abc"))) 498 (set! cs (char-set-filter! (lambda (c) (char=? c #\x)) 499 (->char-set "qrstuvwxyz") 500 cs)) 501 (char-set= (string->char-set "abcx") 502 cs)))) 503 504 505(with-test-prefix "char-set-intersection" 506 507 (pass-if "empty" 508 (char-set= (char-set-intersection (char-set) (char-set)) 509 (char-set))) 510 511 (pass-if "identical, one element" 512 (char-set= (char-set-intersection (char-set #\a) (char-set #\a)) 513 (char-set #\a))) 514 515 (pass-if "identical, two elements" 516 (char-set= (char-set-intersection (char-set #\a #\b) (char-set #\a #\b)) 517 (char-set #\a #\b))) 518 519 (pass-if "identical, two elements" 520 (char-set= (char-set-intersection (char-set #\a #\c) (char-set #\a #\c)) 521 (char-set #\a #\c))) 522 523 (pass-if "one vs null" 524 (char-set= (char-set-intersection (char-set #\a) (char-set)) 525 (char-set))) 526 527 (pass-if "null vs one" 528 (char-set= (char-set-intersection (char-set) (char-set #\a)) 529 (char-set))) 530 531 (pass-if "no elements shared" 532 (char-set= (char-set-intersection (char-set #\a #\c) (char-set #\b #\d)) 533 (char-set))) 534 535 (pass-if "one elements shared" 536 (char-set= (char-set-intersection (char-set #\a #\c #\d) (char-set #\b #\d)) 537 (char-set #\d)))) 538 539(with-test-prefix "char-set-complement" 540 541 (pass-if "complement of null" 542 (char-set= (char-set-complement (char-set)) 543 (char-set-union (ucs-range->char-set 0 #xd800) 544 (ucs-range->char-set #xe000 #x110000)))) 545 546 (pass-if "complement of null (2)" 547 (char-set= (char-set-complement (char-set)) 548 (ucs-range->char-set 0 #x110000))) 549 550 (pass-if "complement of #\\0" 551 (char-set= (char-set-complement (char-set #\nul)) 552 (ucs-range->char-set 1 #x110000))) 553 554 (pass-if "complement of U+10FFFF" 555 (char-set= (char-set-complement (char-set (integer->char #x10ffff))) 556 (ucs-range->char-set 0 #x10ffff))) 557 558 (pass-if "complement of 'FOO'" 559 (char-set= (char-set-complement (->char-set "FOO")) 560 (char-set-union (ucs-range->char-set 0 (char->integer #\F)) 561 (ucs-range->char-set (char->integer #\G) 562 (char->integer #\O)) 563 (ucs-range->char-set (char->integer #\P) 564 #x110000)))) 565 (pass-if "complement of #\\a #\\b U+010300" 566 (char-set= (char-set-complement (char-set #\a #\b (integer->char #x010300))) 567 (char-set-union (ucs-range->char-set 0 (char->integer #\a)) 568 (ucs-range->char-set (char->integer #\c) #x010300) 569 (ucs-range->char-set #x010301 #x110000))))) 570 571(with-test-prefix "ucs-range->char-set" 572 (pass-if "char-set" 573 (char-set= (ucs-range->char-set 65 68) 574 (->char-set "ABC"))) 575 576 (pass-if "char-set w/ base" 577 (char-set= (ucs-range->char-set 65 68 #f (->char-set "DEF")) 578 (->char-set "ABCDEF"))) 579 580 (pass-if "char-set!" 581 (let ((cs (->char-set "DEF"))) 582 (ucs-range->char-set! 65 68 #f cs) 583 (char-set= cs 584 (->char-set "ABCDEF"))))) 585 586(with-test-prefix "char-set-count" 587 (pass-if "null" 588 (= 0 (char-set-count (lambda (c) #t) (char-set)))) 589 590 (pass-if "count" 591 (= 5 (char-set-count (lambda (c) #t) 592 (->char-set "guile"))))) 593 594(with-test-prefix "char-set-contains?" 595 (pass-if "#\\a not in null" 596 (not (char-set-contains? (char-set) #\a))) 597 598 (pass-if "#\\a is in 'abc'" 599 (char-set-contains? (->char-set "abc") #\a))) 600 601(with-test-prefix "any / every" 602 (pass-if "char-set-every #t" 603 (char-set-every (lambda (c) #t) 604 (->char-set "abc"))) 605 606 (pass-if "char-set-every #f" 607 (not (char-set-every (lambda (c) (char=? c #\c)) 608 (->char-set "abc")))) 609 610 (pass-if "char-set-any #t" 611 (char-set-any (lambda (c) (char=? c #\c)) 612 (->char-set "abc"))) 613 614 (pass-if "char-set-any #f" 615 (not (char-set-any (lambda (c) #f) 616 (->char-set "abc"))))) 617 618(with-test-prefix "char-set-delete" 619 (pass-if "abc - a" 620 (char-set= (char-set-delete (->char-set "abc") #\a) 621 (char-set #\b #\c))) 622 623 (pass-if "abc - d" 624 (char-set= (char-set-delete (->char-set "abc") #\d) 625 (char-set #\a #\b #\c))) 626 627 (pass-if "delete! abc - a" 628 (let ((cs (char-set #\a #\b #\c))) 629 (char-set-delete! cs #\a) 630 (char-set= cs (char-set #\b #\c))))) 631 632(with-test-prefix "char-set-difference" 633 (pass-if "not different" 634 (char-set= (char-set-difference (->char-set "foobar") (->char-set "foobar")) 635 (char-set))) 636 637 (pass-if "completely different" 638 (char-set= (char-set-difference (->char-set "foo") (->char-set "bar")) 639 (->char-set "foo"))) 640 641 (pass-if "partially different" 642 (char-set= (char-set-difference (->char-set "breakfast") (->char-set "breakroom")) 643 (->char-set "fst")))) 644 645(with-test-prefix "standard char sets (ASCII)" 646 647 (pass-if "char-set:lower-case" 648 (char-set<= (string->char-set "abcdefghijklmnopqrstuvwxyz") 649 char-set:lower-case)) 650 651 (pass-if "char-set:upper-case" 652 (char-set<= (string->char-set "ABCDEFGHIJKLMNOPQRSTUVWXYZ") 653 char-set:upper-case)) 654 655 (pass-if "char-set:title-case" 656 (char-set<= (string->char-set "") 657 char-set:title-case)) 658 659 (pass-if "char-set:letter" 660 (char-set<= (char-set-union 661 (string->char-set "abcdefghijklmnopqrstuvwxyz") 662 (string->char-set "ABCDEFGHIJKLMNOPQRSTUVWXYZ")) 663 char-set:letter)) 664 665 (pass-if "char-set:digit" 666 (char-set<= (string->char-set "0123456789") 667 char-set:digit)) 668 669 (pass-if "char-set:hex-digit" 670 (char-set<= (string->char-set "0123456789abcdefABCDEF") 671 char-set:hex-digit)) 672 673 (pass-if "char-set:letter+digit" 674 (char-set<= (char-set-union 675 (string->char-set "abcdefghijklmnopqrstuvwxyz") 676 (string->char-set "ABCDEFGHIJKLMNOPQRSTUVWXYZ") 677 (string->char-set "0123456789")) 678 char-set:letter+digit)) 679 680 (pass-if "char-set:punctuation" 681 (char-set<= (string->char-set "!\"#%&'()*,-./:;?@[\\]_{}") 682 char-set:punctuation)) 683 684 (pass-if "char-set:symbol" 685 (char-set<= (string->char-set "$+<=>^`|~") 686 char-set:symbol)) 687 688 (pass-if "char-set:graphic" 689 (char-set<= (char-set-union 690 (string->char-set "abcdefghijklmnopqrstuvwxyz") 691 (string->char-set "ABCDEFGHIJKLMNOPQRSTUVWXYZ") 692 (string->char-set "0123456789") 693 (string->char-set "!\"#%&'()*,-./:;?@[\\]_{}") 694 (string->char-set "$+<=>^`|~")) 695 char-set:graphic)) 696 697 (pass-if "char-set:whitespace" 698 (char-set<= (string->char-set 699 (string 700 (integer->char #x09) 701 (integer->char #x0a) 702 (integer->char #x0b) 703 (integer->char #x0c) 704 (integer->char #x0d) 705 (integer->char #x20))) 706 char-set:whitespace)) 707 708 (pass-if "char-set:printing" 709 (char-set<= (char-set-union 710 (string->char-set "abcdefghijklmnopqrstuvwxyz") 711 (string->char-set "ABCDEFGHIJKLMNOPQRSTUVWXYZ") 712 (string->char-set "0123456789") 713 (string->char-set "!\"#%&'()*,-./:;?@[\\]_{}") 714 (string->char-set "$+<=>^`|~") 715 (string->char-set (string 716 (integer->char #x09) 717 (integer->char #x0a) 718 (integer->char #x0b) 719 (integer->char #x0c) 720 (integer->char #x0d) 721 (integer->char #x20)))) 722 char-set:printing)) 723 724 (pass-if "char-set:ASCII" 725 (char-set= (ucs-range->char-set 0 128) 726 char-set:ascii)) 727 728 (pass-if "char-set:iso-control" 729 (char-set<= (string->char-set 730 (apply string 731 (map integer->char (append 732 ;; U+0000 to U+001F 733 (iota #x20) 734 (list #x7f))))) 735 char-set:iso-control))) 736 737 738;;; 739;;; Non-ASCII codepoints 740;;; 741;;; Here, we only test ISO-8859-1 (Latin-1), notably because behavior of 742;;; SRFI-14 for implementations supporting this charset is well-defined. 743;;; 744 745(define (every? pred lst) 746 (not (not (every pred lst)))) 747 748(when (defined? 'setlocale) 749 (setlocale LC_ALL "")) 750 751(with-test-prefix "Latin-1 (8-bit charset)" 752 753 (pass-if "char-set:lower-case" 754 (char-set<= (string->char-set 755 (string-append "abcdefghijklmnopqrstuvwxyz" 756 "���������������������������������") 757 char-set:lower-case))) 758 759 (pass-if "char-set:upper-case" 760 (char-set<= (string->char-set 761 (string-append "ABCDEFGHIJKLMNOPQRSTUVWXYZ" 762 "������������������������������") 763 char-set:lower-case))) 764 765 (pass-if "char-set:title-case" 766 (char-set<= (string->char-set "") 767 char-set:title-case)) 768 769 (pass-if "char-set:letter" 770 (char-set<= (string->char-set 771 (string-append 772 ;; Lowercase 773 "abcdefghijklmnopqrstuvwxyz" 774 "���������������������������������" 775 ;; Uppercase 776 "ABCDEFGHIJKLMNOPQRSTUVWXYZ" 777 "������������������������������" 778 ;; Uncased 779 "��")) 780 char-set:letter)) 781 782 (pass-if "char-set:digit" 783 (char-set<= (string->char-set "0123456789") 784 char-set:digit)) 785 786 (pass-if "char-set:hex-digit" 787 (char-set<= (string->char-set "0123456789abcdefABCDEF") 788 char-set:hex-digit)) 789 790 (pass-if "char-set:letter+digit" 791 (char-set<= (char-set-union 792 char-set:letter 793 char-set:digit) 794 char-set:letter+digit)) 795 796 (pass-if "char-set:punctuation" 797 (char-set<= (string->char-set 798 (string-append "!\"#%&'()*,-./:;?@[\\]_{}" 799 "�������")) 800 char-set:punctuation)) 801 802 (pass-if "char-set:symbol" 803 (char-set<= (string->char-set 804 (string-append "$+<=>^`|~" 805 "����������������")) 806 char-set:symbol)) 807 808 ;; Note that SRFI-14 itself is inconsistent here. Characters that 809 ;; are non-digit numbers (such as category No) are clearly 'graphic' 810 ;; but don't occur in the letter, digit, punct, or symbol charsets. 811 (pass-if "char-set:graphic" 812 (char-set<= (char-set-union 813 char-set:letter 814 char-set:digit 815 char-set:punctuation 816 char-set:symbol) 817 char-set:graphic)) 818 819 (pass-if "char-set:whitespace" 820 (char-set<= (string->char-set 821 (string 822 (integer->char #x09) 823 (integer->char #x0a) 824 (integer->char #x0b) 825 (integer->char #x0c) 826 (integer->char #x0d) 827 (integer->char #x20) 828 (integer->char #xa0))) 829 char-set:whitespace)) 830 831 (pass-if "char-set:printing" 832 (char-set<= (char-set-union char-set:graphic char-set:whitespace) 833 char-set:printing)) 834 835 (pass-if "char-set:iso-control" 836 (char-set<= (string->char-set 837 (apply string 838 (map integer->char (append 839 ;; U+0000 to U+001F 840 (iota #x20) 841 (list #x7f) 842 ;; U+007F to U+009F 843 (map (lambda (x) (+ #x80 x)) 844 (iota #x20)))))) 845 char-set:iso-control))) 846