summaryrefslogtreecommitdiff
path: root/test-suite/tests/srfi-14.test
diff options
context:
space:
mode:
Diffstat (limited to 'test-suite/tests/srfi-14.test')
-rw-r--r--test-suite/tests/srfi-14.test845
1 files changed, 845 insertions, 0 deletions
diff --git a/test-suite/tests/srfi-14.test b/test-suite/tests/srfi-14.test
new file mode 100644
index 000000000..f511f1c2c
--- /dev/null
+++ b/test-suite/tests/srfi-14.test
@@ -0,0 +1,845 @@
+;;;; srfi-14.test -*- mode:scheme; coding: iso-8859-1 -*-
+;;;; --- Test suite for Guile's SRFI-14 functions.
+;;;; Martin Grabmueller, 2001-07-16
+;;;;
+;;;; Copyright (C) 2001, 2006, 2009, 2010, 2014 Free Software Foundation, Inc.
+;;;;
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;;
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (test-suite test-srfi-14)
+ :use-module (srfi srfi-14)
+ :use-module (srfi srfi-1) ;; `every'
+ :use-module (test-suite lib))
+
+
+(define exception:invalid-char-set-cursor
+ (cons 'misc-error "^invalid character set cursor"))
+
+(define exception:non-char-return
+ (cons 'misc-error "returned non-char"))
+
+
+(with-test-prefix "char set contents"
+
+ (pass-if "empty set"
+ (list= eqv?
+ (char-set->list (char-set))
+ '()))
+
+ (pass-if "single char"
+ (list= eqv?
+ (char-set->list (char-set #\a))
+ (list #\a)))
+
+ (pass-if "contiguous chars"
+ (list= eqv?
+ (char-set->list (char-set #\a #\b #\c))
+ (list #\a #\b #\c)))
+
+ (pass-if "discontiguous chars"
+ (list= eqv?
+ (char-set->list (char-set #\a #\c #\e))
+ (list #\a #\c #\e))))
+
+(with-test-prefix "char set additition"
+
+ (pass-if "empty + x"
+ (let ((cs (char-set)))
+ (char-set-adjoin! cs #\x)
+ (list= eqv?
+ (char-set->list cs)
+ (list #\x))))
+
+ (pass-if "x + y"
+ (let ((cs (char-set #\x)))
+ (char-set-adjoin! cs #\y)
+ (list= eqv?
+ (char-set->list cs)
+ (list #\x #\y))))
+
+ (pass-if "x + w"
+ (let ((cs (char-set #\x)))
+ (char-set-adjoin! cs #\w)
+ (list= eqv?
+ (char-set->list cs)
+ (list #\w #\x))))
+
+ (pass-if "x + z"
+ (let ((cs (char-set #\x)))
+ (char-set-adjoin! cs #\z)
+ (list= eqv?
+ (char-set->list cs)
+ (list #\x #\z))))
+
+ (pass-if "x + v"
+ (let ((cs (char-set #\x)))
+ (char-set-adjoin! cs #\v)
+ (list= eqv?
+ (char-set->list cs)
+ (list #\v #\x))))
+
+ (pass-if "uv + w"
+ (let ((cs (char-set #\u #\v)))
+ (char-set-adjoin! cs #\w)
+ (list= eqv?
+ (char-set->list cs)
+ (list #\u #\v #\w))))
+
+ (pass-if "uv + t"
+ (let ((cs (char-set #\u #\v)))
+ (char-set-adjoin! cs #\t)
+ (list= eqv?
+ (char-set->list cs)
+ (list #\t #\u #\v))))
+
+ (pass-if "uv + x"
+ (let ((cs (char-set #\u #\v)))
+ (char-set-adjoin! cs #\x)
+ (list= eqv?
+ (char-set->list cs)
+ (list #\u #\v #\x))))
+
+ (pass-if "uv + s"
+ (let ((cs (char-set #\u #\v)))
+ (char-set-adjoin! cs #\s)
+ (list= eqv?
+ (char-set->list cs)
+ (list #\s #\u #\v))))
+
+ (pass-if "uvx + w"
+ (let ((cs (char-set #\u #\v #\x)))
+ (char-set-adjoin! cs #\w)
+ (list= eqv?
+ (char-set->list cs)
+ (list #\u #\v #\w #\x))))
+
+ (pass-if "uvx + y"
+ (let ((cs (char-set #\u #\v #\x)))
+ (char-set-adjoin! cs #\y)
+ (list= eqv?
+ (char-set->list cs)
+ (list #\u #\v #\x #\y))))
+
+ (pass-if "uvxy + w"
+ (let ((cs (char-set #\u #\v #\x #\y)))
+ (char-set-adjoin! cs #\w)
+ (list= eqv?
+ (char-set->list cs)
+ (list #\u #\v #\w #\x #\y)))))
+
+(with-test-prefix "char set union"
+ (pass-if "null U abc"
+ (char-set= (char-set-union (char-set) (->char-set "abc"))
+ (->char-set "abc")))
+
+ (pass-if "ab U ab"
+ (char-set= (char-set-union (->char-set "ab") (->char-set "ab"))
+ (->char-set "ab")))
+
+ (pass-if "ab U bc"
+ (char-set= (char-set-union (->char-set "ab") (->char-set "bc"))
+ (->char-set "abc")))
+
+ (pass-if "ab U cd"
+ (char-set= (char-set-union (->char-set "ab") (->char-set "cd"))
+ (->char-set "abcd")))
+
+ (pass-if "ab U de"
+ (char-set= (char-set-union (->char-set "ab") (->char-set "de"))
+ (->char-set "abde")))
+
+ (pass-if "abc U bcd"
+ (char-set= (char-set-union (->char-set "abc") (->char-set "bcd"))
+ (->char-set "abcd")))
+
+ (pass-if "abdf U abcdefg"
+ (char-set= (char-set-union (->char-set "abdf") (->char-set "abcdefg"))
+ (->char-set "abcdefg")))
+
+ (pass-if "abef U cd"
+ (char-set= (char-set-union (->char-set "abef") (->char-set "cd"))
+ (->char-set "abcdef")))
+
+ (pass-if "abgh U cd"
+ (char-set= (char-set-union (->char-set "abgh") (->char-set "cd"))
+ (->char-set "abcdgh")))
+
+ (pass-if "bc U ab"
+ (char-set= (char-set-union (->char-set "bc") (->char-set "ab"))
+ (->char-set "abc")))
+
+ (pass-if "cd U ab"
+ (char-set= (char-set-union (->char-set "cd") (->char-set "ab"))
+ (->char-set "abcd")))
+
+ (pass-if "de U ab"
+ (char-set= (char-set-union (->char-set "de") (->char-set "ab"))
+ (->char-set "abde")))
+
+ (pass-if "cd U abc"
+ (char-set= (char-set-union (->char-set "cd") (->char-set "abc"))
+ (->char-set "abcd")))
+
+ (pass-if "cd U abcd"
+ (char-set= (char-set-union (->char-set "cd") (->char-set "abcd"))
+ (->char-set "abcd")))
+
+ (pass-if "cde U abcdef"
+ (char-set= (char-set-union (->char-set "cde") (->char-set "abcdef"))
+ (->char-set "abcdef"))))
+
+(with-test-prefix "char set xor"
+ (pass-if "null - xy"
+ (char-set= (char-set-xor (char-set) (char-set #\x #\y))
+ (char-set #\x #\y)))
+
+ (pass-if "x - x"
+ (char-set= (char-set-xor (char-set #\x) (char-set #\x))
+ (char-set)))
+
+ (pass-if "xy - x"
+ (char-set= (char-set-xor (char-set #\x #\y) (char-set #\x))
+ (char-set #\y)))
+
+ (pass-if "xy - y"
+ (char-set= (char-set-xor (char-set #\x #\y) (char-set #\y))
+ (char-set #\x)))
+
+ (pass-if "wxy - w"
+ (char-set= (char-set-xor (char-set #\w #\x #\y) (char-set #\w))
+ (char-set #\x #\y)))
+
+ (pass-if "wxy - x"
+ (char-set= (char-set-xor (char-set #\w #\x #\y) (char-set #\x))
+ (char-set #\w #\y)))
+
+ (pass-if "wxy - y"
+ (char-set= (char-set-xor (char-set #\w #\x #\y) (char-set #\y))
+ (char-set #\w #\x)))
+
+ (pass-if "uvxy - u"
+ (char-set= (char-set-xor (char-set #\u #\v #\x #\y) (char-set #\u))
+ (char-set #\v #\x #\y)))
+
+ (pass-if "uvxy - v"
+ (char-set= (char-set-xor (char-set #\u #\v #\x #\y) (char-set #\v))
+ (char-set #\u #\x #\y)))
+
+ (pass-if "uvxy - x"
+ (char-set= (char-set-xor (char-set #\u #\v #\x #\y) (char-set #\x))
+ (char-set #\u #\v #\y)))
+
+ (pass-if "uvxy - y"
+ (char-set= (char-set-xor (char-set #\u #\v #\x #\y) (char-set #\y))
+ (char-set #\u #\v #\x)))
+
+ (pass-if "uwy - u"
+ (char-set= (char-set-xor (char-set #\u #\w #\y) (char-set #\u))
+ (char-set #\w #\y)))
+
+ (pass-if "uwy - w"
+ (char-set= (char-set-xor (char-set #\u #\w #\y) (char-set #\w))
+ (char-set #\u #\y)))
+
+ (pass-if "uwy - y"
+ (char-set= (char-set-xor (char-set #\u #\w #\y) (char-set #\y))
+ (char-set #\u #\w)))
+
+ (pass-if "uvwy - v"
+ (char-set= (char-set-xor (char-set #\u #\v #\w #\y) (char-set #\v))
+ (char-set #\u #\w #\y))))
+
+
+(with-test-prefix "char-set?"
+
+ (pass-if "success on empty set"
+ (char-set? (char-set)))
+
+ (pass-if "success on non-empty set"
+ (char-set? char-set:printing))
+
+ (pass-if "failure on empty set"
+ (not (char-set? #t))))
+
+
+(with-test-prefix "char-set="
+ (pass-if "success, no arg"
+ (char-set=))
+
+ (pass-if "success, one arg"
+ (char-set= char-set:lower-case))
+
+ (pass-if "success, two args"
+ (char-set= char-set:upper-case char-set:upper-case))
+
+ (pass-if "failure, first empty"
+ (not (char-set= (char-set) (char-set #\a))))
+
+ (pass-if "failure, second empty"
+ (not (char-set= (char-set #\a) (char-set))))
+
+ (pass-if "success, more args"
+ (char-set= char-set:blank char-set:blank char-set:blank))
+
+ (pass-if "failure, same length, different elements"
+ (not (char-set= (char-set #\a #\b #\d) (char-set #\a #\c #\d)))))
+
+(with-test-prefix "char-set<="
+ (pass-if "success, no arg"
+ (char-set<=))
+
+ (pass-if "success, one arg"
+ (char-set<= char-set:lower-case))
+
+ (pass-if "success, two args"
+ (char-set<= char-set:upper-case char-set:upper-case))
+
+ (pass-if "success, first empty"
+ (char-set<= (char-set) (char-set #\a)))
+
+ (pass-if "failure, second empty"
+ (not (char-set<= (char-set #\a) (char-set))))
+
+ (pass-if "success, more args, equal"
+ (char-set<= char-set:blank char-set:blank char-set:blank))
+
+ (pass-if "success, more args, not equal"
+ (char-set<= char-set:blank
+ (char-set-adjoin char-set:blank #\F)
+ (char-set-adjoin char-set:blank #\F #\o))))
+
+(with-test-prefix "char-set-hash"
+ (pass-if "empty set, bound"
+ (let ((h (char-set-hash char-set:empty 31)))
+ (and h (number? h) (exact? h) (>= h 0) (< h 31))))
+
+ (pass-if "empty set, no bound"
+ (let ((h (char-set-hash char-set:empty)))
+ (and h (number? h) (exact? h) (>= h 0))))
+
+ (pass-if "full set, bound"
+ (let ((h (char-set-hash char-set:full 31)))
+ (and h (number? h) (exact? h) (>= h 0) (< h 31))))
+
+ (pass-if "full set, no bound"
+ (let ((h (char-set-hash char-set:full)))
+ (and h (number? h) (exact? h) (>= h 0))))
+
+ (pass-if "other set, bound"
+ (let ((h (char-set-hash (char-set #\f #\o #\b #\a #\r) 31)))
+ (and h (number? h) (exact? h) (>= h 0) (< h 31))))
+
+ (pass-if "other set, no bound"
+ (let ((h (char-set-hash (char-set #\f #\o #\b #\a #\r))))
+ (and h (number? h) (exact? h) (>= h 0)))))
+
+
+(with-test-prefix "char-set cursor"
+
+ (pass-if-exception "invalid character cursor"
+ exception:wrong-type-arg
+ (let* ((cs (char-set #\B #\r #\a #\z))
+ (cc (char-set-cursor cs)))
+ (char-set-ref cs 1000)))
+
+ (pass-if "success"
+ (let* ((cs (char-set #\B #\r #\a #\z))
+ (cc (char-set-cursor cs)))
+ (char? (char-set-ref cs cc))))
+
+ (pass-if "end of set fails"
+ (let* ((cs (char-set #\a))
+ (cc (char-set-cursor cs)))
+ (not (end-of-char-set? cc))))
+
+ (pass-if "end of set succeeds, empty set"
+ (let* ((cs (char-set))
+ (cc (char-set-cursor cs)))
+ (end-of-char-set? cc)))
+
+ (pass-if "end of set succeeds, non-empty set"
+ (let* ((cs (char-set #\a))
+ (cc (char-set-cursor cs))
+ (cc (char-set-cursor-next cs cc)))
+ (end-of-char-set? cc))))
+
+(with-test-prefix "char-set-fold"
+
+ (pass-if "count members"
+ (= (char-set-fold (lambda (c n) (+ n 1)) 0 (char-set #\a #\b)) 2))
+
+ (pass-if "copy set"
+ (= (char-set-size (char-set-fold (lambda (c cs) (char-set-adjoin cs c))
+ (char-set) (char-set #\a #\b))) 2)))
+
+(define char-set:256
+ (string->char-set (apply string (map integer->char (iota 256)))))
+
+(with-test-prefix "char-set-unfold"
+
+ (pass-if "create char set"
+ (char-set= char-set:256
+ (char-set-unfold (lambda (s) (= s 256)) integer->char
+ (lambda (s) (+ s 1)) 0)))
+ (pass-if "create char set (base set)"
+ (char-set= char-set:256
+ (char-set-unfold (lambda (s) (= s 256)) integer->char
+ (lambda (s) (+ s 1)) 0 char-set:empty))))
+
+(with-test-prefix "char-set-unfold!"
+
+ (pass-if "create char set"
+ (char-set= char-set:256
+ (char-set-unfold! (lambda (s) (= s 256)) integer->char
+ (lambda (s) (+ s 1)) 0
+ (char-set-copy char-set:empty))))
+
+ (pass-if "create char set"
+ (char-set= char-set:256
+ (char-set-unfold! (lambda (s) (= s 32)) integer->char
+ (lambda (s) (+ s 1)) 0
+ (char-set-copy char-set:256)))))
+
+
+(with-test-prefix "char-set-for-each"
+
+ (pass-if "copy char set"
+ (= (char-set-size (let ((cs (char-set)))
+ (char-set-for-each
+ (lambda (c) (char-set-adjoin! cs c))
+ (char-set #\a #\b))
+ cs))
+ 2)))
+
+(with-test-prefix "char-set-map"
+
+ (pass-if "upper case char set 1"
+ (char-set= (char-set-map char-upcase
+ (string->char-set "abcdefghijklmnopqrstuvwxyz"))
+ (string->char-set "ABCDEFGHIJKLMNOPQRSTUVWXYZ")))
+
+ (pass-if "upper case char set 2"
+ (char-set= (char-set-map char-upcase
+ (string->char-set "àáâãäåæçèéêëìíîïñòóôõöøùúûüýþ"))
+ (string->char-set "ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÑÒÓÔÕÖØÙÚÛÜÝÞ"))))
+
+(with-test-prefix "string->char-set"
+
+ (pass-if "some char set"
+ (let ((chars '(#\g #\u #\i #\l #\e)))
+ (char-set= (list->char-set chars)
+ (string->char-set (apply string chars))))))
+
+(with-test-prefix "char-set->string"
+
+ (pass-if "some char set"
+ (let ((cs (char-set #\g #\u #\i #\l #\e)))
+ (string=? (char-set->string cs)
+ "egilu"))))
+
+(with-test-prefix "list->char-set"
+
+ (pass-if "list->char-set"
+ (char-set= (list->char-set '(#\a #\b #\c))
+ (->char-set "abc")))
+
+ (pass-if "list->char-set!"
+ (let* ((cs (char-set #\a #\z)))
+ (list->char-set! '(#\m #\n) cs)
+ (char-set= cs
+ (char-set #\a #\m #\n #\z)))))
+
+(with-test-prefix "string->char-set"
+
+ (pass-if "string->char-set"
+ (char-set= (string->char-set "foobar")
+ (string->char-set "barfoo")))
+
+ (pass-if "string->char-set cs"
+ (char-set= (string->char-set "foo" (string->char-set "bar"))
+ (string->char-set "barfoo")))
+
+ (pass-if "string->char-set!"
+ (let ((cs (string->char-set "bar")))
+ (string->char-set! "foo" cs)
+ (char-set= cs
+ (string->char-set "barfoo")))))
+
+(with-test-prefix "char-set-filter"
+
+ (pass-if "filter w/o base"
+ (char-set=
+ (char-set-filter (lambda (c) (char=? c #\x))
+ (->char-set "qrstuvwxyz"))
+ (->char-set #\x)))
+
+ (pass-if "filter w/ base"
+ (char-set=
+ (char-set-filter (lambda (c) (char=? c #\x))
+ (->char-set "qrstuvwxyz")
+ (->char-set "op"))
+
+ (->char-set "opx")))
+
+ (pass-if "filter!"
+ (let ((cs (->char-set "abc")))
+ (set! cs (char-set-filter! (lambda (c) (char=? c #\x))
+ (->char-set "qrstuvwxyz")
+ cs))
+ (char-set= (string->char-set "abcx")
+ cs))))
+
+
+(with-test-prefix "char-set-intersection"
+
+ (pass-if "empty"
+ (char-set= (char-set-intersection (char-set) (char-set))
+ (char-set)))
+
+ (pass-if "identical, one element"
+ (char-set= (char-set-intersection (char-set #\a) (char-set #\a))
+ (char-set #\a)))
+
+ (pass-if "identical, two elements"
+ (char-set= (char-set-intersection (char-set #\a #\b) (char-set #\a #\b))
+ (char-set #\a #\b)))
+
+ (pass-if "identical, two elements"
+ (char-set= (char-set-intersection (char-set #\a #\c) (char-set #\a #\c))
+ (char-set #\a #\c)))
+
+ (pass-if "one vs null"
+ (char-set= (char-set-intersection (char-set #\a) (char-set))
+ (char-set)))
+
+ (pass-if "null vs one"
+ (char-set= (char-set-intersection (char-set) (char-set #\a))
+ (char-set)))
+
+ (pass-if "no elements shared"
+ (char-set= (char-set-intersection (char-set #\a #\c) (char-set #\b #\d))
+ (char-set)))
+
+ (pass-if "one elements shared"
+ (char-set= (char-set-intersection (char-set #\a #\c #\d) (char-set #\b #\d))
+ (char-set #\d))))
+
+(with-test-prefix "char-set-complement"
+
+ (pass-if "complement of null"
+ (char-set= (char-set-complement (char-set))
+ (char-set-union (ucs-range->char-set 0 #xd800)
+ (ucs-range->char-set #xe000 #x110000))))
+
+ (pass-if "complement of null (2)"
+ (char-set= (char-set-complement (char-set))
+ (ucs-range->char-set 0 #x110000)))
+
+ (pass-if "complement of #\\0"
+ (char-set= (char-set-complement (char-set #\nul))
+ (ucs-range->char-set 1 #x110000)))
+
+ (pass-if "complement of U+10FFFF"
+ (char-set= (char-set-complement (char-set (integer->char #x10ffff)))
+ (ucs-range->char-set 0 #x10ffff)))
+
+ (pass-if "complement of 'FOO'"
+ (char-set= (char-set-complement (->char-set "FOO"))
+ (char-set-union (ucs-range->char-set 0 (char->integer #\F))
+ (ucs-range->char-set (char->integer #\G)
+ (char->integer #\O))
+ (ucs-range->char-set (char->integer #\P)
+ #x110000))))
+ (pass-if "complement of #\\a #\\b U+010300"
+ (char-set= (char-set-complement (char-set #\a #\b (integer->char #x010300)))
+ (char-set-union (ucs-range->char-set 0 (char->integer #\a))
+ (ucs-range->char-set (char->integer #\c) #x010300)
+ (ucs-range->char-set #x010301 #x110000)))))
+
+(with-test-prefix "ucs-range->char-set"
+ (pass-if "char-set"
+ (char-set= (ucs-range->char-set 65 68)
+ (->char-set "ABC")))
+
+ (pass-if "char-set w/ base"
+ (char-set= (ucs-range->char-set 65 68 #f (->char-set "DEF"))
+ (->char-set "ABCDEF")))
+
+ (pass-if "char-set!"
+ (let ((cs (->char-set "DEF")))
+ (ucs-range->char-set! 65 68 #f cs)
+ (char-set= cs
+ (->char-set "ABCDEF")))))
+
+(with-test-prefix "char-set-count"
+ (pass-if "null"
+ (= 0 (char-set-count (lambda (c) #t) (char-set))))
+
+ (pass-if "count"
+ (= 5 (char-set-count (lambda (c) #t)
+ (->char-set "guile")))))
+
+(with-test-prefix "char-set-contains?"
+ (pass-if "#\\a not in null"
+ (not (char-set-contains? (char-set) #\a)))
+
+ (pass-if "#\\a is in 'abc'"
+ (char-set-contains? (->char-set "abc") #\a)))
+
+(with-test-prefix "any / every"
+ (pass-if "char-set-every #t"
+ (char-set-every (lambda (c) #t)
+ (->char-set "abc")))
+
+ (pass-if "char-set-every #f"
+ (not (char-set-every (lambda (c) (char=? c #\c))
+ (->char-set "abc"))))
+
+ (pass-if "char-set-any #t"
+ (char-set-any (lambda (c) (char=? c #\c))
+ (->char-set "abc")))
+
+ (pass-if "char-set-any #f"
+ (not (char-set-any (lambda (c) #f)
+ (->char-set "abc")))))
+
+(with-test-prefix "char-set-delete"
+ (pass-if "abc - a"
+ (char-set= (char-set-delete (->char-set "abc") #\a)
+ (char-set #\b #\c)))
+
+ (pass-if "abc - d"
+ (char-set= (char-set-delete (->char-set "abc") #\d)
+ (char-set #\a #\b #\c)))
+
+ (pass-if "delete! abc - a"
+ (let ((cs (char-set #\a #\b #\c)))
+ (char-set-delete! cs #\a)
+ (char-set= cs (char-set #\b #\c)))))
+
+(with-test-prefix "char-set-difference"
+ (pass-if "not different"
+ (char-set= (char-set-difference (->char-set "foobar") (->char-set "foobar"))
+ (char-set)))
+
+ (pass-if "completely different"
+ (char-set= (char-set-difference (->char-set "foo") (->char-set "bar"))
+ (->char-set "foo")))
+
+ (pass-if "partially different"
+ (char-set= (char-set-difference (->char-set "breakfast") (->char-set "breakroom"))
+ (->char-set "fst"))))
+
+(with-test-prefix "standard char sets (ASCII)"
+
+ (pass-if "char-set:lower-case"
+ (char-set<= (string->char-set "abcdefghijklmnopqrstuvwxyz")
+ char-set:lower-case))
+
+ (pass-if "char-set:upper-case"
+ (char-set<= (string->char-set "ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+ char-set:upper-case))
+
+ (pass-if "char-set:title-case"
+ (char-set<= (string->char-set "")
+ char-set:title-case))
+
+ (pass-if "char-set:letter"
+ (char-set<= (char-set-union
+ (string->char-set "abcdefghijklmnopqrstuvwxyz")
+ (string->char-set "ABCDEFGHIJKLMNOPQRSTUVWXYZ"))
+ char-set:letter))
+
+ (pass-if "char-set:digit"
+ (char-set<= (string->char-set "0123456789")
+ char-set:digit))
+
+ (pass-if "char-set:hex-digit"
+ (char-set<= (string->char-set "0123456789abcdefABCDEF")
+ char-set:hex-digit))
+
+ (pass-if "char-set:letter+digit"
+ (char-set<= (char-set-union
+ (string->char-set "abcdefghijklmnopqrstuvwxyz")
+ (string->char-set "ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+ (string->char-set "0123456789"))
+ char-set:letter+digit))
+
+ (pass-if "char-set:punctuation"
+ (char-set<= (string->char-set "!\"#%&'()*,-./:;?@[\\]_{}")
+ char-set:punctuation))
+
+ (pass-if "char-set:symbol"
+ (char-set<= (string->char-set "$+<=>^`|~")
+ char-set:symbol))
+
+ (pass-if "char-set:graphic"
+ (char-set<= (char-set-union
+ (string->char-set "abcdefghijklmnopqrstuvwxyz")
+ (string->char-set "ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+ (string->char-set "0123456789")
+ (string->char-set "!\"#%&'()*,-./:;?@[\\]_{}")
+ (string->char-set "$+<=>^`|~"))
+ char-set:graphic))
+
+ (pass-if "char-set:whitespace"
+ (char-set<= (string->char-set
+ (string
+ (integer->char #x09)
+ (integer->char #x0a)
+ (integer->char #x0b)
+ (integer->char #x0c)
+ (integer->char #x0d)
+ (integer->char #x20)))
+ char-set:whitespace))
+
+ (pass-if "char-set:printing"
+ (char-set<= (char-set-union
+ (string->char-set "abcdefghijklmnopqrstuvwxyz")
+ (string->char-set "ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+ (string->char-set "0123456789")
+ (string->char-set "!\"#%&'()*,-./:;?@[\\]_{}")
+ (string->char-set "$+<=>^`|~")
+ (string->char-set (string
+ (integer->char #x09)
+ (integer->char #x0a)
+ (integer->char #x0b)
+ (integer->char #x0c)
+ (integer->char #x0d)
+ (integer->char #x20))))
+ char-set:printing))
+
+ (pass-if "char-set:ASCII"
+ (char-set= (ucs-range->char-set 0 128)
+ char-set:ascii))
+
+ (pass-if "char-set:iso-control"
+ (char-set<= (string->char-set
+ (apply string
+ (map integer->char (append
+ ;; U+0000 to U+001F
+ (iota #x20)
+ (list #x7f)))))
+ char-set:iso-control)))
+
+
+;;;
+;;; Non-ASCII codepoints
+;;;
+;;; Here, we only test ISO-8859-1 (Latin-1), notably because behavior of
+;;; SRFI-14 for implementations supporting this charset is well-defined.
+;;;
+
+(define (every? pred lst)
+ (not (not (every pred lst))))
+
+(when (defined? 'setlocale)
+ (setlocale LC_ALL ""))
+
+(with-test-prefix "Latin-1 (8-bit charset)"
+
+ (pass-if "char-set:lower-case"
+ (char-set<= (string->char-set
+ (string-append "abcdefghijklmnopqrstuvwxyz"
+ "µßàáâãäåæçèéêëìíîïðñòóôõöøùúûüýþÿ")
+ char-set:lower-case)))
+
+ (pass-if "char-set:upper-case"
+ (char-set<= (string->char-set
+ (string-append "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
+ "ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖØÙÚÛÜÝÞ")
+ char-set:lower-case)))
+
+ (pass-if "char-set:title-case"
+ (char-set<= (string->char-set "")
+ char-set:title-case))
+
+ (pass-if "char-set:letter"
+ (char-set<= (string->char-set
+ (string-append
+ ;; Lowercase
+ "abcdefghijklmnopqrstuvwxyz"
+ "µßàáâãäåæçèéêëìíîïðñòóôõöøùúûüýþÿ"
+ ;; Uppercase
+ "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
+ "ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖØÙÚÛÜÝÞ"
+ ;; Uncased
+ "ªº"))
+ char-set:letter))
+
+ (pass-if "char-set:digit"
+ (char-set<= (string->char-set "0123456789")
+ char-set:digit))
+
+ (pass-if "char-set:hex-digit"
+ (char-set<= (string->char-set "0123456789abcdefABCDEF")
+ char-set:hex-digit))
+
+ (pass-if "char-set:letter+digit"
+ (char-set<= (char-set-union
+ char-set:letter
+ char-set:digit)
+ char-set:letter+digit))
+
+ (pass-if "char-set:punctuation"
+ (char-set<= (string->char-set
+ (string-append "!\"#%&'()*,-./:;?@[\\]_{}"
+ "¡§«¶·»¿"))
+ char-set:punctuation))
+
+ (pass-if "char-set:symbol"
+ (char-set<= (string->char-set
+ (string-append "$+<=>^`|~"
+ "¢£¤¥¦¨©¬®¯°±´¸×÷"))
+ char-set:symbol))
+
+ ;; Note that SRFI-14 itself is inconsistent here. Characters that
+ ;; are non-digit numbers (such as category No) are clearly 'graphic'
+ ;; but don't occur in the letter, digit, punct, or symbol charsets.
+ (pass-if "char-set:graphic"
+ (char-set<= (char-set-union
+ char-set:letter
+ char-set:digit
+ char-set:punctuation
+ char-set:symbol)
+ char-set:graphic))
+
+ (pass-if "char-set:whitespace"
+ (char-set<= (string->char-set
+ (string
+ (integer->char #x09)
+ (integer->char #x0a)
+ (integer->char #x0b)
+ (integer->char #x0c)
+ (integer->char #x0d)
+ (integer->char #x20)
+ (integer->char #xa0)))
+ char-set:whitespace))
+
+ (pass-if "char-set:printing"
+ (char-set<= (char-set-union char-set:graphic char-set:whitespace)
+ char-set:printing))
+
+ (pass-if "char-set:iso-control"
+ (char-set<= (string->char-set
+ (apply string
+ (map integer->char (append
+ ;; U+0000 to U+001F
+ (iota #x20)
+ (list #x7f)
+ ;; U+007F to U+009F
+ (map (lambda (x) (+ #x80 x))
+ (iota #x20))))))
+ char-set:iso-control)))