(library (srfi n14 tests)
(export)
(import (rnrs base)
(rnrs unicode)
(srfi n78)
(srfi n14)
(only (rnrs lists) member))
(define (add1 n) (+ n 1))
(define (not-char-set= x y) (not (char-set= x y)))
(define (vowel? c)
(member c '(#\a #\e #\i #\o #\u)))
(define char-set:latin-1 (ucs-range->char-set 0 256))
(check (not (char-set? 5)) => #t)
(check (char-set? (char-set #\a #\e #\i #\o #\u)) => #t)
(check (char-set=) => #t)
(check (char-set= (char-set)) => #t)
(check (string->char-set "ioeauaiii")
(=> char-set=)
(char-set #\a #\e #\i #\o #\u))
(check (not (char-set= (string->char-set "ioeauaiii")
(char-set #\e #\i #\o #\u)))
=> #t)
(check (char-set<=) => #t)
(check (char-set<= (char-set)) => #t)
(check (char-set<= (char-set #\a #\e #\i #\o #\u)
(string->char-set "ioeauaiii"))
=> #t)
(check (char-set<= (char-set #\e #\i #\o #\u)
(string->char-set "ioeauaiii"))
=> #t)
(check (<= 0 (char-set-hash char-set:graphic 100) 99)
=> #t)
(check (char-set-fold (lambda (c i) (+ i 1)) 0
(char-set #\e #\i #\o #\u #\e #\e))
=> 4)
(check (char-set-unfold null? car cdr '(#\a #\e #\i #\o #\u)
(string->char-set "0123456789"))
(=> char-set=)
(string->char-set "eiaou246801357999"))
(check (char-set-unfold! null? car cdr '(#\a #\e #\i #\o #\u)
(string->char-set "0123456789"))
(=> not-char-set=)
(string->char-set "eiaou246801357"))
(let ((cs (string->char-set "0123456789")))
(char-set-for-each (lambda (c) (set! cs (char-set-delete cs c)))
(string->char-set "02468000"))
(check cs (=> char-set=) (string->char-set "97531")))
(let ((cs (string->char-set "0123456789")))
(char-set-for-each (lambda (c) (set! cs (char-set-delete cs c)))
(string->char-set "02468"))
(check cs
(=> not-char-set=)
(string->char-set "7531")))
(check (char-set-map char-upcase (string->char-set "aeiou"))
(=> char-set=)
(string->char-set "IOUAEEEE"))
(check (char-set-map char-upcase (string->char-set "aeiou"))
(=> not-char-set=)
(string->char-set "OUAEEEE"))
(check (char-set-copy (string->char-set "aeiou"))
(=> char-set=)
(string->char-set "aeiou"))
(check (char-set #\x #\y) (=> char-set=) (string->char-set "xy"))
(check (char-set #\x #\y #\z) (=> not-char-set=) (string->char-set "xy"))
(check (list->char-set '(#\x #\y)) (=> char-set=) (string->char-set "xy"))
(check (list->char-set '(#\x #\y)) (=> not-char-set=) (string->char-set "axy"))
(check (list->char-set '(#\x #\y) (string->char-set "12345"))
(=> char-set=)
(string->char-set "xy12345"))
(check (list->char-set '(#\x #\y) (string->char-set "12345"))
(=> not-char-set=)
(string->char-set "y12345"))
(check (list->char-set! '(#\x #\y) (string->char-set "12345"))
(=> char-set=)
(string->char-set "xy12345"))
(check (list->char-set! '(#\x #\y) (string->char-set "12345"))
(=> not-char-set=)
(string->char-set "y12345"))
(check (char-set-filter vowel? char-set:ascii (string->char-set "12345"))
(=> char-set=)
(string->char-set "aeiou12345"))
(check (char-set-filter vowel? char-set:ascii (string->char-set "12345"))
(=> not-char-set=)
(string->char-set "aeou12345"))
(check (char-set-filter! vowel? char-set:ascii (string->char-set "12345"))
(=> char-set=)
(string->char-set "aeiou12345"))
(check (char-set-filter! vowel? char-set:ascii (string->char-set "12345"))
(=> not-char-set=)
(string->char-set "aeou12345"))
(check (ucs-range->char-set 97 103 #t (string->char-set "12345"))
(=> char-set=)
(string->char-set "abcdef12345"))
(check (ucs-range->char-set 97 103 #t (string->char-set "12345"))
(=> not-char-set=)
(string->char-set "abcef12345"))
(check (ucs-range->char-set! 97 103 #t (string->char-set "12345"))
(=> char-set=)
(string->char-set "abcdef12345"))
(check (ucs-range->char-set! 97 103 #t (string->char-set "12345"))
(=> not-char-set=)
(string->char-set "abcef12345"))
(check (x->char-set #\x) (=> char-set=) (x->char-set "x"))
(check (x->char-set #\x) (=> char-set=) (x->char-set (char-set #\x)))
(check (x->char-set "y") (=> not-char-set=) (x->char-set #\x))
(check (char-set-size (char-set-intersection char-set:ascii char-set:digit)) => 10)
(check (char-set-count vowel? char-set:ascii) => 5)
(check (char-set->list (char-set #\x)) => '(#\x))
(check (char-set->list (char-set #\x)) (=> (lambda (x y) (not (equal? x y)))) '(#\X))
(check (char-set->string (char-set #\x)) => "x")
(check (char-set->string (char-set #\x)) (=> (lambda (x y) (not (equal? x y)))) "X")
(check (char-set-contains? (x->char-set "xyz") #\x) => #t)
(check (char-set-contains? (x->char-set "xyz") #\a) => #f)
(check (char-set-every char-lower-case? (x->char-set "abcd")) => #t)
(check (char-set-every char-lower-case? (x->char-set "abcD")) => #f)
(check (char-set-any char-lower-case? (x->char-set "abcd")) => #t)
(check (char-set-any char-lower-case? (x->char-set "ABCD")) => #f)
(check
(let ((cs (x->char-set "abcd")))
(let lp ((cur (char-set-cursor cs)) (ans '()))
(if (end-of-char-set? cur)
(list->char-set ans)
(lp (char-set-cursor-next cs cur)
(cons (char-upcase (char-set-ref cs cur)) ans)))))
(=> char-set=)
(x->char-set "ABCD"))
(check (char-set-adjoin (x->char-set "123") #\x #\a)
(=> char-set=)
(x->char-set "123xa"))
(check (x->char-set "123x")
(=> not-char-set=)
(char-set-adjoin (x->char-set "123") #\x #\a))
(check (char-set-adjoin! (x->char-set "123") #\x #\a)
(=> char-set=)
(x->char-set "123xa"))
(check (x->char-set "123x") (=> not-char-set=)
(char-set-adjoin! (x->char-set "123") #\x #\a))
(check (char-set-delete (x->char-set "123") #\2 #\a #\2)
(=> char-set=)
(x->char-set "13"))
(check (char-set-delete (x->char-set "123") #\2 #\a #\2)
(=> not-char-set=)
(x->char-set "13a"))
(check (char-set-delete! (x->char-set "123") #\2 #\a #\2)
(=> char-set=)
(x->char-set "13"))
(check (char-set-delete! (x->char-set "123") #\2 #\a #\2)
(=> not-char-set=)
(x->char-set "13a"))
(check (char-set-intersection char-set:hex-digit (char-set-complement char-set:digit))
(=> char-set=)
(x->char-set "abcdefABCDEF"))
(check (char-set-intersection! (char-set-complement! (x->char-set "0123456789")) char-set:hex-digit)
(=> char-set=)
(x->char-set "abcdefABCDEF"))
(check (char-set-union char-set:hex-digit (x->char-set "abcdefghijkl"))
(=> char-set=)
(x->char-set "abcdefABCDEFghijkl0123456789"))
(check (char-set-union! (x->char-set "abcdefghijkl") char-set:hex-digit)
(=> char-set=)
(x->char-set "abcdefABCDEFghijkl0123456789"))
(check (char-set-difference (x->char-set "abcdefghijklmn") char-set:hex-digit)
(=> char-set=)
(x->char-set "ghijklmn"))
(check (char-set-difference! (x->char-set "abcdefghijklmn") char-set:hex-digit)
(=> char-set=)
(x->char-set "ghijklmn"))
(check (char-set-xor (x->char-set "0123456789") char-set:hex-digit)
(=> char-set=)
(x->char-set "abcdefABCDEF"))
(check (char-set-xor! (x->char-set "0123456789") char-set:hex-digit)
(=> char-set=)
(x->char-set "abcdefABCDEF"))
(call-with-values
(lambda () (char-set-diff+intersection char-set:hex-digit char-set:letter))
(lambda (d i)
(check d (=> char-set=) (x->char-set "0123456789"))
(check i (=> char-set=) (x->char-set "abcdefABCDEF"))))
(call-with-values
(lambda () (char-set-diff+intersection! (char-set-copy char-set:hex-digit) (char-set-copy char-set:letter)))
(lambda (d i)
(check d (=> char-set=) (x->char-set "0123456789"))
(check i (=> char-set=) (x->char-set "abcdefABCDEF"))))
(check (char-set-contains? char-set:lower-case #\a) => #t)
(check (char-set-contains? char-set:lower-case #\A) => #f)
(check (char-set-contains? char-set:lower-case (integer->char 224)) => #t)
(check (char-set-contains? char-set:lower-case (integer->char 194)) => #f)
(check (char-set-contains? char-set:lower-case (integer->char 181)) => #t)
(check (char-set-contains? char-set:upper-case #\A) => #t)
(check (char-set-contains? char-set:upper-case #\a) => #f)
(check (char-set-contains? char-set:upper-case (integer->char 194)) => #t)
(check (char-set-contains? char-set:upper-case (integer->char 224)) => #f)
(check (char-set-contains? char-set:title-case (integer->char 453)) => #t)
(check (char-set-contains? char-set:title-case (integer->char 8104)) => #t)
(check (char-set-contains? char-set:title-case #\a) => #f)
(check (char-set-contains? char-set:title-case #\A) => #f)
(check (char-set-contains? char-set:letter #\a) => #t)
(check (char-set-contains? char-set:letter #\A) => #t)
(check (char-set-contains? char-set:letter #\1) => #f)
(check (char-set-contains? char-set:letter (integer->char 170)) => #t)
(check (char-set-contains? char-set:letter (integer->char 186)) => #t)
(check (char-set-every (lambda (c) (char-set-contains? char-set:lower-case c)) char-set:letter) => #f)
(check (char-set-any (lambda (c) (char-set-contains? char-set:lower-case c)) char-set:letter) => #t)
(check (char-set-every (lambda (c) (char-set-contains? char-set:upper-case c)) char-set:letter) => #f)
(check (char-set-any (lambda (c) (char-set-contains? char-set:upper-case c)) char-set:letter) => #t)
(check (char-set-contains? char-set:digit #\1) => #t)
(check (char-set-contains? char-set:digit #\a) => #f)
(check (char-set-contains? char-set:hex-digit #\1) => #t)
(check (char-set-contains? char-set:hex-digit #\a) => #t)
(check (char-set-contains? char-set:hex-digit #\A) => #t)
(check (char-set-contains? char-set:hex-digit #\g) => #f)
(check (char-set-contains? char-set:letter+digit #\1) => #t)
(check (char-set-contains? char-set:letter+digit #\a) => #t)
(check (char-set-contains? char-set:letter+digit #\z) => #t)
(check (char-set-contains? char-set:letter+digit #\A) => #t)
(check (char-set-contains? char-set:letter+digit #\Z) => #t)
(check (char-set-size char-set:letter) => 92496)
(check (char-set-union char-set:letter char-set:digit) (=> char-set=) char-set:letter+digit)
(check (char-set-every (lambda (c) (char-set-contains? char-set:letter c)) char-set:letter+digit) => #f)
(check (char-set-every (lambda (c) (char-set-contains? char-set:digit c)) char-set:letter+digit) => #f)
(check (char-set-any (lambda (c) (char-set-contains? char-set:letter c)) char-set:letter+digit) => #t)
(check (char-set-every (lambda (c) (char-set-contains? char-set:letter+digit c)) char-set:letter) => #t)
(check (char-set-every (lambda (c) (char-set-contains? char-set:letter+digit c)) char-set:digit) => #t)
(check
(char-set-intersection (char-set-union char-set:letter char-set:digit char-set:punctuation char-set:symbol) char-set:latin-1)
(=> char-set=)
(char-set-intersection char-set:graphic char-set:latin-1))
(check (char-set-union char-set:graphic char-set:whitespace) (=> char-set=) char-set:printing)
(check (char-set-contains? char-set:whitespace (integer->char 9)) => #t)
(check (char-set-contains? char-set:whitespace (integer->char 13)) => #t)
(check (char-set-contains? char-set:whitespace #\a) => #f)
(check (char-set-union (ucs-range->char-set 0 32) (ucs-range->char-set 127 160))
(=> char-set=)
char-set:iso-control)
(check (char-set-contains? char-set:punctuation #\!) => #t)
(check (char-set-contains? char-set:punctuation (integer->char 161)) => #t)
(check (char-set-contains? char-set:punctuation #\a) => #f)
(check (char-set-contains? char-set:symbol #\$) => #t)
(check (char-set-contains? char-set:symbol (integer->char 162)) => #t)
(check (char-set-contains? char-set:symbol #\a) => #f)
(check (char-set-contains? char-set:blank #\space) => #t)
(check (char-set-contains? char-set:blank (integer->char 12288)) => #t)
(check (char-set-contains? char-set:blank #\a) => #f)
(check (char-set= char-set:letter char-set:letter char-set:letter) => #t)
(check (char-set= char-set:letter char-set:digit) => #f)
(check (char-set= char-set:letter char-set:letter char-set:digit) => #f)
(check (char-set= char-set:letter char-set:digit char-set:letter) => #f)
(check (char-set<= char-set:graphic char-set:printing) => #t)
(check (char-set<= char-set:printing char-set:graphic) => #f)
(check (char-set<= char-set:graphic char-set:printing char-set:full) => #t)
(check (char-set<= char-set:graphic char-set:full char-set:printing) => #f)
(check (char-set-hash char-set:graphic) => (char-set-hash char-set:graphic))
(check (char-set-size char-set:digit) => 290)
(check
(list->char-set
(let loop ((c (char-set-cursor char-set:digit)) (l '()))
(if (end-of-char-set? c)
l
(loop (char-set-cursor-next char-set:digit c)
(cons (char-set-ref char-set:digit c) l)))))
(=> char-set=)
char-set:digit)
(check (char-set-unfold (lambda (x) (= x 20)) integer->char add1 10)
(=> char-set=)
(ucs-range->char-set 10 20))
(check (char-set-unfold (lambda (x) (= x 20)) integer->char add1 10 (char-set (integer->char 20)))
(=> char-set=)
(ucs-range->char-set 10 21))
(check (char-set-unfold! (lambda (x) (= x 20)) integer->char add1 10 (char-set-copy char-set:empty))
(=> char-set=)
(ucs-range->char-set 10 20))
(check (let ((cs char-set:empty))
(char-set-for-each (lambda (c) (set! cs (char-set-adjoin cs c))) char-set:digit) cs)
(=> char-set=)
char-set:digit)
(check (char-set-map (lambda (c) c) char-set:digit) (=> char-set=) char-set:digit)
(check (char-set-map (lambda (c) c) char-set:digit) (=> char-set=) char-set:digit)
(check (char-set-union (char-set-map (lambda (c) c) char-set:digit) (char-set #\A))
(=> char-set=)
(char-set-adjoin char-set:digit #\A))
(check (char-set-copy char-set:digit) (=> char-set=) char-set:digit)
(let ((abc (char-set #\a #\b #\c)))
(check (char-set #\c #\a #\b) (=> char-set=) abc)
(check (string->char-set "cba") (=> char-set=) abc)
(check (string->char-set! "cba" (char-set-copy char-set:empty)) (=> char-set=) abc)
(check (string->char-set "cb" (char-set #\a)) (=> char-set=) abc)
(check (char-set-filter (lambda (c) (char=? c #\b)) abc)
(=> char-set=)
(char-set #\b))
(check (char-set-filter (lambda (c) (char=? c #\b)) abc char-set:empty)
(=> char-set=)
(char-set #\b))
(check (char-set-filter! (lambda (c) (char=? c #\b)) (char-set-copy abc) (char-set-copy char-set:empty))
(=> char-set=)
(char-set #\b))
(check (x->char-set "abc") (=> char-set=) abc)
(check (x->char-set abc) (=> char-set=) abc)
(check (x->char-set #\a) (=> char-set=) (char-set #\a)))
(check (char-set-union (ucs-range->char-set 0 55296) (ucs-range->char-set 57344 131072))
(=> char-set=)
(ucs-range->char-set 0 131072))
(check (ucs-range->char-set 0 55296) (=> char-set=) (ucs-range->char-set 0 55297))
(check (ucs-range->char-set 0 55296) (=> char-set=) (ucs-range->char-set 0 57343))
(check char-set:empty (=> char-set=) (ucs-range->char-set 55296 55312))
(check char-set:empty (=> char-set=) (ucs-range->char-set 55312 57344))
(check (ucs-range->char-set 55312 57345) (=> char-set=) (ucs-range->char-set 57344 57345))
(check (char-set (integer->char 55295) (integer->char 57344))
(=> char-set=)
(ucs-range->char-set 55295 57345))
(check (char-set-count (lambda (x) (and (char<=? #\0 x) (char<=? x #\2))) char-set:digit)
=> 3)
(check (list->char-set (char-set->list char-set:digit)) (=> char-set=) char-set:digit)
(check (list->char-set (char-set->list char-set:digit) char-set:empty) (=> char-set=) char-set:digit)
(check (list->char-set! (char-set->list char-set:digit) (char-set-copy char-set:empty)) (=> char-set=) char-set:digit)
(check (string->char-set (char-set->string char-set:digit)) (=> char-set=) char-set:digit)
(check-report)
)