238 lines
7.4 KiB
Scheme
238 lines
7.4 KiB
Scheme
;;;
|
|
;;; <char-set-test.ss> ---- Test driver for the SRFI-14 port: char-set
|
|
;;; Time-stamp: <06/06/09 16:38:25 nhw>
|
|
;;;
|
|
;;; Copyright (C) 2002 by Francisco Solsona.
|
|
;;;
|
|
;;; This file is part of PLT SRFI.
|
|
|
|
;;; PLT SRFI 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 2.1 of the License, or (at your option) any later version.
|
|
|
|
;;; PLT SRFI 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 PLT SRFI; if not, write to the Free Software
|
|
;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
|
|
|
;;; Author: Francisco Solsona <solsona@acm.org>
|
|
;;
|
|
;;
|
|
;; Commentary:
|
|
|
|
(module char-set-test mzscheme
|
|
|
|
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
|
|
(lib "char-set.ss" "srfi" "14")
|
|
)
|
|
(provide char-set-tests)
|
|
|
|
(define char-set-tests
|
|
(test-suite
|
|
"Char-Set tests"
|
|
|
|
(test-case
|
|
"char-set? correct"
|
|
(check-false (char-set? null))
|
|
(check-true (char-set? (char-set #\a #\b #\c))))
|
|
|
|
(test-case
|
|
"char-set= equality"
|
|
(let ((abc (char-set #\a #\b #\c)))
|
|
(check-true (char-set= abc (char-set #\a #\b #\c)))))
|
|
|
|
(test-case
|
|
"char-set<= test 1 (strictly less than)"
|
|
(check-true (char-set<= (char-set #\a #\b #\c)
|
|
(char-set #\a #\b #\c #\d))))
|
|
|
|
(test-case
|
|
"char-set<= test 2 (equal)"
|
|
(check-true (char-set<= (char-set #\a #\b #\c)
|
|
(char-set #\a #\b #\c))))
|
|
|
|
(test-case
|
|
"Hash invariant (default bound)"
|
|
(check-eqv? (char-set-hash char-set:ascii)
|
|
(char-set-hash char-set:ascii)))
|
|
|
|
(test-case
|
|
"Char set cursor test"
|
|
(let ((abc (char-set #\a #\b #\c)))
|
|
(check-equal?
|
|
(let lp ((cur (char-set-cursor abc)) (ans '()))
|
|
(if (end-of-char-set? cur) ans
|
|
(lp (char-set-cursor-next abc cur)
|
|
(cons (char-set-ref abc cur) ans))))
|
|
'(#\c #\b #\a))))
|
|
|
|
(test-case
|
|
"char-set-fold test 1 (cs members)"
|
|
(check-equal? (char-set-fold cons '() (char-set #\a #\b #\c))
|
|
'(#\c #\b #\a)))
|
|
|
|
(test-case
|
|
"char-set-fold test 2 (cs size)"
|
|
(check-eqv? (char-set-fold (lambda (c i) (+ i 1)) 0 (char-set #\a #\b #\c))
|
|
3))
|
|
|
|
(test-case
|
|
"char-set-fold test 3 (how many vowels in cs)"
|
|
(check-eqv? (char-set-fold (lambda (c i) (if (vowel? c) (+ i 1) i))
|
|
0 (char-set #\a #\b #\c))
|
|
1))
|
|
|
|
(test-case
|
|
"char-set-unfold test 1 (string-port->char-set)"
|
|
(check-equal?
|
|
;; FIXME: We haven't see if char-set->string works, and we are using it.
|
|
(char-set->string
|
|
((lambda (sp)
|
|
(char-set-unfold eof-object? values
|
|
(lambda (x) (read-char sp))
|
|
(read-char sp)))
|
|
(open-input-string "This is a simple test string to generate a very simple char set!")))
|
|
"yvtsrponmlihgecaT! "))
|
|
|
|
(test-case
|
|
"char-set-for-each (dummy, really)"
|
|
(begin
|
|
(char-set-for-each (lambda (c)
|
|
(char? c)) (char-set #\a #\b #\c))
|
|
(check-true #t)))
|
|
|
|
(test-case
|
|
"char-set-map test 1 (downcase)"
|
|
(check-true
|
|
(char-set=
|
|
(char-set-map char-downcase (char-set #\A #\b #\C))
|
|
(char-set #\a #\b #\c))))
|
|
|
|
(test-case
|
|
"char-set-copy (copy constructor)"
|
|
(check-true
|
|
(let* ((orig (char-set #\a #\b #\c))
|
|
(copy (char-set-copy orig)))
|
|
(and (char-set= orig copy)
|
|
(not (char-set=
|
|
(char-set-difference orig (char-set #\a))
|
|
copy))))))
|
|
|
|
(test-case
|
|
"list->char-set test 1 (using empty char-set)"
|
|
(check-true
|
|
(char-set= (list->char-set '(#\a #\b #\c #\a #\b #\a))
|
|
(char-set #\a #\b #\c))))
|
|
|
|
(test-case
|
|
"list->char-set test 2 (adding to an existent char-set)"
|
|
(check-true
|
|
(let ((c (char-set #\a #\b)))
|
|
(and
|
|
(char-set= (list->char-set '(#\a #\b #\c #\a #\b #\a) c)
|
|
(char-set #\a #\b #\c))
|
|
;; It has to be non-destructive:
|
|
(char-set= c (char-set #\a #\b))))))
|
|
|
|
(test-case
|
|
"list->char-set! (destructive addition)"
|
|
(let ((c (char-set #\a #\b)))
|
|
(check
|
|
char-set=
|
|
(list->char-set! '(#\a #\b #\c #\a #\b #\a) c)
|
|
(char-set #\a #\b #\c))))
|
|
|
|
(test-case
|
|
"string->char-set test 1 (using empty char-set)"
|
|
(check-true
|
|
(char-set= (string->char-set "aaaabbaaccc")
|
|
(char-set #\a #\b #\c))))
|
|
|
|
(test-case
|
|
"string->char-set test 2 (using a non empty char-set)"
|
|
(check-true
|
|
(let ((c (char-set #\a #\b)))
|
|
(and
|
|
(char-set= (string->char-set "aaabbbaaaccc" c)
|
|
(char-set #\a #\b #\c))
|
|
;; It has to be non-destructive:
|
|
(char-set= c (char-set #\a #\b))))))
|
|
|
|
(test-case
|
|
"string->char-set! (destructive addition)"
|
|
(let ((c (char-set #\a #\b)))
|
|
(check
|
|
char-set=
|
|
(string->char-set! "aaabbbaaaccc" c)
|
|
(char-set #\a #\b #\c))))
|
|
|
|
(test-case
|
|
"char-set-filter test 1 (using an empty set)"
|
|
(check-true
|
|
(char-set= (char-set-filter vowel? (char-set #\a #\b #\a #\e #\i #\c #\c #\d))
|
|
(char-set #\a #\e #\i))))
|
|
|
|
(test-case
|
|
"char-set-filter test 2 (using a non empty char-set)"
|
|
(check-true
|
|
(let ((c (char-set #\a #\e)))
|
|
(and
|
|
(char-set= (char-set-filter vowel? (char-set #\a #\b #\a #\e #\i #\c #\c #\d) c)
|
|
(char-set #\a #\e #\i))
|
|
;; It has to be non destructive
|
|
(char-set= c (char-set #\a #\e))))))
|
|
|
|
(test-case
|
|
"char-set-filter! test (using a non empty char-set)"
|
|
(let ((c (char-set #\a #\e)))
|
|
(check
|
|
char-set=
|
|
(char-set-filter! vowel? (char-set #\a #\b #\a #\e #\i #\c #\c #\d) c)
|
|
(char-set #\a #\e #\i))))
|
|
|
|
;; MISSIGN:
|
|
;; ucs-range->char-set, ucs-range->char-set!
|
|
;; ->char-set
|
|
|
|
(test-case
|
|
"char-set-size test"
|
|
(check-true (= (char-set-size (char-set #\a #\b #\c)) 3)))
|
|
|
|
(test-case
|
|
"char-set-count test"
|
|
(check-true (= (char-set-count vowel? (char-set #\a #\b #\a #\e #\i #\z)) 3)))
|
|
|
|
(test-case
|
|
"char-set->list test"
|
|
(check-true
|
|
(let ((l (char-set->list (char-set #\a #\b #\c))))
|
|
(and (pair? l) (= (length l) 3)))))
|
|
(test-case
|
|
"char-set->string test"
|
|
(check-true
|
|
(string=? (char-set->string (char-set #\a #\b #\c)) "cba")))
|
|
|
|
(test-case
|
|
"char-set-contains? test (if there)"
|
|
(check-true (char-set-contains? (char-set #\a #\b #\c) #\b)))
|
|
|
|
(test-case
|
|
"char-set-contains? test (if not there)"
|
|
(check-true (not (char-set-contains? (char-set #\a #\b #\c) #\z))))
|
|
|
|
))
|
|
|
|
(define vowel?
|
|
(lambda (v)
|
|
(and (char? v)
|
|
(or (char=? v #\a) (char=? v #\e) (char=? v #\i) (char=? v #\o) (char=? v #\u)))))
|
|
|
|
)
|
|
|
|
;;; char-set-test.ss ends here
|