lib/srfi/n14/tests.ss
(library (srfi n14 tests)
  (export)
  (import (rnrs base)
          (rnrs unicode)
          (srfi n78)
          (srfi n14)
	  (only (rnrs lists) member))
  
  ;; SRFI 14 test suite

  (define (add1 n) (+ n 1))
  (define (not-char-set= x y) (not (char-set= x y)))

  ;; adapted from Olin's test suite
  (define (vowel? c)
    (member c '(#\a #\e #\i #\o #\u)))

 (define char-set:latin-1 (ucs-range->char-set 0 256))
  
  ;; char-set?
  (check (not (char-set? 5)) => #t)
  (check (char-set? (char-set #\a #\e #\i #\o #\u)) => #t)

  ;; char-set=
  (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)

  ;; char-set<=
  (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)

  ;; char-set-hash
  (check (<= 0 (char-set-hash char-set:graphic 100) 99)
	 => #t)

  ;; char-set-fold
  (check (char-set-fold (lambda (c i) (+ i 1)) 0
			(char-set #\e #\i #\o #\u #\e #\e))
	 => 4)

; The following test is ASCII/Latin-1 only, and fails with Unicode
; (char-set= (string->char-set "eiaou2468013579999")
;            (char-set-unfold null? car cdr '(#\a #\e #\i #\o #\u #\u #\u)
;                             char-set:digit))

  ;; char-set-unfold
  (check (char-set-unfold null? car cdr '(#\a #\e #\i #\o #\u)
			  (string->char-set "0123456789"))
	 (=> char-set=)
	 (string->char-set "eiaou246801357999"))

  ;; char-set-unfold!
  (check (char-set-unfold! null? car cdr '(#\a #\e #\i #\o #\u)
			   (string->char-set "0123456789"))
	 (=> not-char-set=)
	 (string->char-set "eiaou246801357"))

  ;; char-set-for-each
  (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")))

  ;; char-set-map
  (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"))

  ;; char-set-copy
  (check (char-set-copy (string->char-set "aeiou"))
	 (=> char-set=)
	 (string->char-set "aeiou"))

  ;; char-set
  (check (char-set #\x #\y)     (=> char-set=)     (string->char-set "xy"))
  (check (char-set #\x #\y #\z) (=> not-char-set=) (string->char-set "xy"))

  ;; list->char-set
  (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"))

  ;; list->char-set!
  (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"))

  ;; char-set-filter
  (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"))

  ;; char-set-filter!
  (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"))

  ;;ucs-range->char-set
  (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"))

  ;; ucs-range_>char-set!
  (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"))


  ;; x->char-set
  (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))

  ;; char-set-size
  (check (char-set-size (char-set-intersection char-set:ascii char-set:digit)) => 10)

  ;; char-set-count
  (check (char-set-count vowel? char-set:ascii) => 5)

  ;; char-set->list
  (check (char-set->list (char-set #\x)) => '(#\x)) 
  (check (char-set->list (char-set #\x)) (=> (lambda (x y) (not (equal? x y)))) '(#\X))

  ;; char-set->string
  (check (char-set->string (char-set #\x)) => "x") 
  (check (char-set->string (char-set #\x)) (=> (lambda (x y) (not (equal? x y)))) "X")

  ;; char-set-contains?
  (check (char-set-contains? (x->char-set "xyz") #\x) => #t) 
  (check (char-set-contains? (x->char-set "xyz") #\a) => #f)

 ;; char-set-every
  (check (char-set-every char-lower-case? (x->char-set "abcd")) => #t)
  (check (char-set-every char-lower-case? (x->char-set "abcD")) => #f)

  ;; char-set-any
  (check (char-set-any char-lower-case? (x->char-set "abcd")) => #t) 
  (check (char-set-any char-lower-case? (x->char-set "ABCD")) => #f)

  ;; cursors
  (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"))

  ;; char-set-adjoin
  (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))

  ;; char-set-adjoin!
  (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))

  ;; char-set-delete
  (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"))

  ;; char-set-delete!
   (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"))

   ;; char-set-intersection
   (check (char-set-intersection char-set:hex-digit (char-set-complement char-set:digit)) 
	  (=> char-set=) 
	  (x->char-set "abcdefABCDEF"))

   ;; char-set-intersection!
   (check (char-set-intersection! (char-set-complement! (x->char-set "0123456789")) char-set:hex-digit) 
	  (=> char-set=) 
	  (x->char-set "abcdefABCDEF"))

   ;; char-set-union
   (check (char-set-union char-set:hex-digit (x->char-set "abcdefghijkl")) 
	  (=> char-set=) 
	  (x->char-set "abcdefABCDEFghijkl0123456789"))

   ;; char-set-union!
   (check (char-set-union! (x->char-set "abcdefghijkl") char-set:hex-digit) 
	  (=> char-set=) 
	  (x->char-set "abcdefABCDEFghijkl0123456789"))

   ;; char-set-difference
   (check (char-set-difference (x->char-set "abcdefghijklmn") char-set:hex-digit) 
	  (=> char-set=) 
	  (x->char-set "ghijklmn"))

   ;; char-set-difference!
   (check (char-set-difference! (x->char-set "abcdefghijklmn") char-set:hex-digit) 
	  (=> char-set=)
	  (x->char-set "ghijklmn"))

   ;; char-set-xor
   (check (char-set-xor (x->char-set "0123456789") char-set:hex-digit) 
	  (=> char-set=) 
	  (x->char-set "abcdefABCDEF"))

   ;; char-set-xor!
   (check (char-set-xor! (x->char-set "0123456789") char-set:hex-digit) 
	  (=> char-set=) 
	  (x->char-set "abcdefABCDEF"))

   ;; char-set-diff+intersection
   (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"))))

   ;; char-set-diff+intersection!
   (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"))))

   ;; char-set:lower-case
   (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)

   ;; char-set:upper-case
   (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)

   ;; char-set:title-case
   (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)

   ;; char-set:letter
   (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)

   ;; char-set:lower-case/2
   (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)

   ;; char-set:upper-case/2
   (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)

   ;; char-set:digit
   (check (char-set-contains? char-set:digit #\1) => #t)
   (check (char-set-contains? char-set:digit #\a) => #f)

   ;; char-set:hex-digit
   (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)

   ;; char-set:letter+digit
   (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)

   ;; char-set:letter/size
   (check (char-set-size char-set:letter) => 92496)

   ;; char-set:letter/2
   (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)

   ;; char-set:letter+digit/2
   (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)
   
   ;; char-set:latin-1
   (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))

   ;; char-set:printing
   (check (char-set-union char-set:graphic char-set:whitespace) (=> char-set=) char-set:printing)

   ;; char-set:whitespace
   (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)

   ;; char-set:iso-control
   (check (char-set-union (ucs-range->char-set 0 32) (ucs-range->char-set 127 160)) 
	  (=> char-set=) 
	  char-set:iso-control)
   
   ;; char-set:punctuation
   (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)

   ;; char-set:symbol
   (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)

   ;; char-set:blank
   (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)

   ;; char-set=/2
   (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)

   ;; char-set<=/2
   (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)

   ;; char-set-hash/2
   (check (char-set-hash char-set:graphic) => (char-set-hash char-set:graphic))

   ;; char-set-size/2
   (check (char-set-size char-set:digit) => 290)

   ;; cursors/2
   (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)

   ;; char-set-unfold/2
   (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))

   ;; char-set-unfold!/2
   (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))

   ;; char-set-for-each/2
   (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)

   ;; char-set-map/2
   (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))

   ;; char-set-copy/2
   (check (char-set-copy char-set:digit) (=> char-set=) char-set:digit)

   ;; abc
   (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)))

   ;; ucs-range->char/2
   (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))

 ;; char-set-count/2
 (check (char-set-count (lambda (x) (and (char<=? #\0 x) (char<=? x #\2))) char-set:digit) 
	=> 3)

 ;; list->char-set/2
 (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)
) ; end library