[bpt/guile.git] / test-suite / tests / srfi-14.test

;;;; 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
Commit	Line	Data
f49dbcad MG	1	;;;; srfi-14.test -- mode:scheme; coding: iso-8859-1 --
f49dbcad MG	2	;;;; --- Test suite for Guile's SRFI-14 functions.
072ad0fe MG	3	;;;; Martin Grabmueller, 2001-07-16
072ad0fe MG	4	;;;;
0ce22459	5	;;;; Copyright (C) 2001, 2006, 2009, 2010, 2014 Free Software Foundation, Inc.
dcc69bab	6	;;;;
53befeb7 NJ	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.
dcc69bab	11	;;;;
53befeb7	12	;;;; This library is distributed in the hope that it will be useful,
072ad0fe	13	;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
53befeb7 NJ	14	;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
53befeb7 NJ	15	;;;; Lesser General Public License for more details.
dcc69bab	16	;;;;
53befeb7 NJ	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
072ad0fe	20
a17d2654 LC	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
072ad0fe MG	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
f49dbcad MG	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
4d07801b MG	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
f49dbcad	264
072ad0fe MG	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"
4d07801b MG	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)))))
072ad0fe MG	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"
f49dbcad	352	exception:wrong-type-arg
072ad0fe MG	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
f49dbcad MG	387	(define char-set:256
	388	(string->char-set (apply string (map integer->char (iota 256)))))
	389
072ad0fe MG	390	(with-test-prefix "char-set-unfold"
	391
	392	(pass-if "create char set"
f49dbcad	393	(char-set= char-set:256
072ad0fe MG	394	(char-set-unfold (lambda (s) (= s 256)) integer->char
	395	(lambda (s) (+ s 1)) 0)))
	396	(pass-if "create char set (base set)"
f49dbcad	397	(char-set= char-set:256
072ad0fe MG	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"
f49dbcad	404	(char-set= char-set:256
072ad0fe MG	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"
f49dbcad	410	(char-set= char-set:256
072ad0fe MG	411	(char-set-unfold! (lambda (s) (= s 32)) integer->char
072ad0fe MG	412	(lambda (s) (+ s 1)) 0
f49dbcad	413	(char-set-copy char-set:256)))))
072ad0fe MG	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
f49dbcad MG	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