;;;;
;;;; 14.stk         -- Tests for SRFI-14
;;;;


;;; This is a regression testing suite for the SRFI-14 char-set library.
;;; Olin Shivers

(let ((vowel? (lambda (c) (member c '(#\a #\e #\i #\o #\u)))))

  (test "SRFI-14.0" #t
        (not (char-set? 5)))

  (test "SRFI-14.1" #t
        (char-set? (char-set #\a #\e #\i #\o #\u)))

  (test "SRFI-14.2" #t
        (char-set=))
  (test "SRFI-14.3" #t
        (char-set= (char-set)))

  (test "SRFI-14.4" #t (char-set=
                        (char-set #\a #\e #\i #\o #\u)
                        (string->char-set "ioeauaiii")))

  (test "SRFI-14.6" #t (not (char-set=
                             (char-set #\e #\i #\o #\u)
                             (string->char-set "ioeauaiii"))))

  (test "SRFI-14.7" #t
        (char-set<=))
  (test "SRFI-14.8" #t
        (char-set<= (char-set)))

  (test "SRFI-14.9" #t
        (char-set<= (char-set #\a #\e #\i #\o #\u)
                    (string->char-set "ioeauaiii")))

  (test "SRFI-14.10" #t (char-set<=
                         (char-set #\e #\i #\o #\u)
                         (string->char-set "ioeauaiii")))

  (test "SRFI-14.11" #t
        (<= 0 (char-set-hash char-set:graphic 100) 99))

  (test "SRFI-14.12" #t
        (= 4 (char-set-fold (lambda (c i) (+ i 1)) 0
                            (char-set #\e #\i #\o #\u #\e #\e))))

  (test "SRFI-14.13" #t
        (char-set= (string->char-set "eiaou2468013579999")
                   (char-set-unfold null? car cdr '(#\a #\e #\i #\o #\u #\u #\u)
                                    (string->char-set "0123456789"))))

  (test "SRFI-14.14" #t
        (char-set= (string->char-set "eiaou246801357999")
                   (char-set-unfold! null? car cdr '(#\a #\e #\i #\o #\u)
                                     (string->char-set "0123456789"))))

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

  (let ((cs (string->char-set "0123456789")))
    (char-set-for-each (lambda (c) (set! cs (char-set-delete cs c)))
                       (string->char-set "02468000"))
    (test "SRFI-14.16" #t
          (char-set= cs (string->char-set "97531"))))

  (test "SRFI-14.17" #t
        (not (let ((cs (string->char-set "0123456789")))
               (char-set-for-each (lambda (c) (set! cs (char-set-delete cs c)))
                                  (string->char-set "02468"))
               (char-set= cs (string->char-set "7531")))))

  (test "SRFI-14.18" #t
        (char-set= (char-set-map char-upcase (string->char-set "aeiou"))
                   (string->char-set "IOUAEEEE")))

  (test "SRFI-14.19" #t
        (not (char-set= (char-set-map char-upcase (string->char-set "aeiou"))
                        (string->char-set "OUAEEEE"))))

  (test "SRFI-14.20" #t
        (char-set= (char-set-copy (string->char-set "aeiou"))
                   (string->char-set "aeiou")))

  (test "SRFI-14.21" #t
        (char-set= (char-set #\x #\y) (string->char-set "xy")))
  (test "SRFI-14.22" #t
        (not (char-set= (char-set #\x #\y #\z) (string->char-set "xy"))))

  (test "SRFI-14.23" #t
        (char-set= (string->char-set "xy") (list->char-set '(#\x #\y))))
  (test "SRFI-14.24" #t
        (not (char-set= (string->char-set "axy") (list->char-set '(#\x #\y)))))

  (test "SRFI-14.25" #t
        (char-set= (string->char-set "xy12345")
                   (list->char-set '(#\x #\y) (string->char-set "12345"))))
  (test "SRFI-14.26" #t
        (not (char-set= (string->char-set "y12345")
                        (list->char-set '(#\x #\y) (string->char-set "12345")))))

  (test "SRFI-14.27" #t
        (char-set= (string->char-set "xy12345")
                   (list->char-set! '(#\x #\y) (string->char-set "12345"))))
  (test "SRFI-14.28" #t
        (not (char-set= (string->char-set "y12345")
                        (list->char-set! '(#\x #\y) (string->char-set "12345")))))

  (test "SRFI-14.29" #t
        (char-set= (string->char-set "aeiou12345")
                   (char-set-filter vowel? char-set:ascii (string->char-set "12345"))))
  (test "SRFI-14.30" #t
        (not (char-set= (string->char-set "aeou12345")
                        (char-set-filter vowel? char-set:ascii (string->char-set "12345")))))

  (test "SRFI-14.31" #t
        (char-set= (string->char-set "aeiou12345")
                   (char-set-filter! vowel? char-set:ascii (string->char-set "12345"))))
  (test "SRFI-14.32" #t
        (not (char-set= (string->char-set "aeou12345")
                        (char-set-filter! vowel? char-set:ascii (string->char-set "12345")))))


  (test "SRFI-14.33" #t
        (char-set= (string->char-set "abcdef12345")
                   (ucs-range->char-set 97 103 #t (string->char-set "12345"))))
  (test "SRFI-14.34" #t
        (not (char-set= (string->char-set "abcef12345")
                        (ucs-range->char-set 97 103 #t (string->char-set "12345")))))

  (test "SRFI-14.35" #t
        (char-set= (string->char-set "abcdef12345")
                   (ucs-range->char-set! 97 103 #t (string->char-set "12345"))))
  (test "SRFI-14.36" #t
        (not (char-set= (string->char-set "abcef12345")
                        (ucs-range->char-set! 97 103 #t (string->char-set "12345")))))


  (test "SRFI-14.37" #t
        (char-set= (->char-set #\x)
                   (->char-set "x")
                   (->char-set (char-set #\x))))

  (test "SRFI-14.38" #t
        (not (char-set= (->char-set #\x)
                        (->char-set "y")
                        (->char-set (char-set #\x)))))

  (test "SRFI-14.39" #t
        (= 10 (char-set-size (char-set-intersection char-set:ascii char-set:digit))))

  (test "SRFI-14.40" #t
        (= 5 (char-set-count vowel? char-set:ascii)))

  (test "SRFI-14.41" #t
        (equal? '(#\x) (char-set->list (char-set #\x))))
  (test "SRFI-14.42" #t
        (not (equal? '(#\X) (char-set->list (char-set #\x)))))

  (test "SRFI-14.43" #t
        (equal? "x" (char-set->string (char-set #\x))))
  (test "SRFI-14.44" #t
        (not (equal? "X" (char-set->string (char-set #\x)))))

  (test "SRFI-14.45" #t
        (char-set-contains? (->char-set "xyz") #\x))
  (test "SRFI-14.46" #t
        (not (char-set-contains? (->char-set "xyz") #\a)))

  (test "SRFI-14.47" #t
        (char-set-every char-lower-case? (->char-set "abcd")))
  (test "SRFI-14.48" #t
        (not (char-set-every char-lower-case? (->char-set "abcD"))))
  (test "SRFI-14.49" #t
        (char-set-any char-lower-case? (->char-set "abcd")))
  (test "SRFI-14.50" #t
        (not (char-set-any char-lower-case? (->char-set "ABCD"))))

  (test "SRFI-14.51" #t
        (char-set= (->char-set "ABCD")
                   (let ((cs (->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)))))))


  (test "SRFI-14.52" #t
        (char-set= (char-set-adjoin (->char-set "123") #\x #\a)
                   (->char-set "123xa")))
  (test "SRFI-14.53" #t
        (not (char-set= (char-set-adjoin (->char-set "123") #\x #\a)
                        (->char-set "123x"))))
  (test "SRFI-14.54" #t
        (char-set= (char-set-adjoin! (->char-set "123") #\x #\a)
                   (->char-set "123xa")))
  (test "SRFI-14.55" #t
        (not (char-set= (char-set-adjoin! (->char-set "123") #\x #\a)
                        (->char-set "123x"))))

  (test "SRFI-14.56" #t
        (char-set= (char-set-delete (->char-set "123") #\2 #\a #\2)
                   (->char-set "13")))
  (test "SRFI-14.57" #t
        (not (char-set= (char-set-delete (->char-set "123") #\2 #\a #\2)
                        (->char-set "13a"))))
  (test "SRFI-14.58" #t
        (char-set= (char-set-delete! (->char-set "123") #\2 #\a #\2)
                   (->char-set "13")))
  (test "SRFI-14.59" #t
        (not (char-set= (char-set-delete! (->char-set "123") #\2 #\a #\2)
                        (->char-set "13a"))))

  (test "SRFI-14.60" #t
        (char-set= (char-set-intersection char-set:hex-digit (char-set-complement char-set:digit))
                   (->char-set "abcdefABCDEF")))
  (test "SRFI-14.61" #t
        (char-set= (char-set-intersection! (char-set-complement! (->char-set "0123456789"))
                                           char-set:hex-digit)
                   (->char-set "abcdefABCDEF")))

  (test "SRFI-14.62" #t
        (char-set= (char-set-union char-set:hex-digit
                                   (->char-set "abcdefghijkl"))
                   (->char-set "abcdefABCDEFghijkl0123456789")))
  (test "SRFI-14.63" #t
        (char-set= (char-set-union! (->char-set "abcdefghijkl")
                                    char-set:hex-digit)
                   (->char-set "abcdefABCDEFghijkl0123456789")))

  (test "SRFI-14.64" #t
        (char-set= (char-set-difference (->char-set "abcdefghijklmn")
                                        char-set:hex-digit)
                   (->char-set "ghijklmn")))
  (test "SRFI-14.65" #t
        (char-set= (char-set-difference! (->char-set "abcdefghijklmn")
                                         char-set:hex-digit)
                   (->char-set "ghijklmn")))

  (test "SRFI-14.66" #t
        (char-set= (char-set-xor (->char-set "0123456789")
                                 char-set:hex-digit)
                   (->char-set "abcdefABCDEF")))
  (test "SRFI-14.67" #t
        (char-set= (char-set-xor! (->char-set "0123456789")
                                  char-set:hex-digit)
                   (->char-set "abcdefABCDEF")))

  (test "SRFI-14.68" #t
        (call-with-values (lambda ()
                            (char-set-diff+intersection char-set:hex-digit
                                                        char-set:letter))
          (lambda (d i)
            (and (char-set= d (->char-set "0123456789"))
                 (char-set= i (->char-set "abcdefABCDEF"))))))

  (test "SRFI-14.69" #t
        (call-with-values (lambda ()
                            (char-set-diff+intersection! (char-set-copy char-set:hex-digit)
                                                         (char-set-copy char-set:letter)))
          (lambda (d i)
            (and (char-set= d (->char-set "0123456789"))
                 (char-set= i (->char-set "abcdefABCDEF"))))))

)

