diff options
Diffstat (limited to 'test-suite/tests/srfi-14.test')
-rw-r--r-- | test-suite/tests/srfi-14.test | 845 |
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))) |