1;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2;;;
3;;; Tests these (scheme char) procedures:
4;;;
5;;;     char-downcase
6;;;     char-foldcase
7;;;     char-upcase
8;;;
9;;;     char-ci<=?
10;;;     char-ci<?
11;;;     char-ci=?
12;;;     char-ci>=?
13;;;     char-ci>?
14;;;
15;;;     char-alphabetic?
16;;;     char-lower-case?
17;;;     char-numeric?
18;;;     char-upper-case?
19;;;     char-whitespace?
20;;;
21;;;     digit-value
22;;;
23;;;     string-ci<=?
24;;;     string-ci<?
25;;;     string-ci=?
26;;;     string-ci>=?
27;;;     string-ci>?
28;;;
29;;;     string-downcase
30;;;     string-foldcase
31;;;     string-upcase
32
33
34(define-library (tests scheme char)
35  (export run-char-tests)
36  (import (scheme base)
37          (scheme char)
38          (tests scheme test))
39
40  ;; For slow implementations, it might be faster to
41  ;; generate each Unicode character only once.
42
43  (cond-expand
44   ((and (or kawa)                      ; list slow implementations here
45         full-unicode)
46    (include "char.body-alt.scm"))
47   (full-unicode
48    (include "char.body.scm"))
49   ((not full-unicode)
50    (begin
51     (define (run-char-tests-for-unicode) #t))))
52
53  (begin
54
55   (define (run-char-tests)
56
57     (test (char-upcase #\i) #\I)
58     (test (char-downcase #\i) #\i)
59     (test (char-foldcase #\i) #\i)
60
61     (test (char-ci<? #\z #\Z) #f)
62     (test (char-ci<? #\Z #\z) #f)
63     (test (char-ci<? #\a #\Z) #t)
64     (test (char-ci<? #\Z #\a) #f)
65     (test (char-ci<=? #\z #\Z) #t)
66     (test (char-ci<=? #\Z #\z) #t)
67     (test (char-ci<=? #\a #\Z) #t)
68     (test (char-ci<=? #\Z #\a) #f)
69     (test (char-ci=? #\z #\a) #f)
70     (test (char-ci=? #\z #\Z) #t)
71     (test (char-ci>? #\z #\Z) #f)
72     (test (char-ci>? #\Z #\z) #f)
73     (test (char-ci>? #\a #\Z) #f)
74     (test (char-ci>? #\Z #\a) #t)
75     (test (char-ci>=? #\Z #\z) #t)
76     (test (char-ci>=? #\z #\Z) #t)
77     (test (char-ci>=? #\z #\Z) #t)
78     (test (char-ci>=? #\a #\z) #f)
79
80     (test (char-alphabetic? #\a) #t)
81     (test (char-alphabetic? #\1) #f)
82     (test (char-numeric? #\1) #t)
83     (test (char-numeric? #\a) #f)
84     (test (char-whitespace? #\space) #t)
85     (test (char-whitespace? #\a) #f)
86     (test (char-upper-case? #\a) #f)
87     (test (char-upper-case? #\A) #t)
88     (test (char-lower-case? #\a) #t)
89     (test (char-lower-case? #\A) #f)
90
91     (test (string-upcase "Hi") "HI")
92     (test (string-upcase "HI") "HI")
93     (test (string-downcase "Hi") "hi")
94     (test (string-downcase "hi") "hi")
95     (test (string-foldcase "Hi") "hi")
96     (test (string-foldcase "HI") "hi")
97     (test (string-foldcase "hi") "hi")
98
99     (test (string-downcase "STRASSE")  "strasse")
100
101     (test (string-ci<? "a" "Z") #t)
102     (test (string-ci<? "A" "z") #t)
103     (test (string-ci<? "Z" "a") #f)
104     (test (string-ci<? "z" "A") #f)
105     (test (string-ci<? "z" "Z") #f)
106     (test (string-ci<? "Z" "z") #f)
107     (test (string-ci>? "a" "Z") #f)
108     (test (string-ci>? "A" "z") #f)
109     (test (string-ci>? "Z" "a") #t)
110     (test (string-ci>? "z" "A") #t)
111     (test (string-ci>? "z" "Z") #f)
112     (test (string-ci>? "Z" "z") #f)
113     (test (string-ci=? "z" "Z") #t)
114     (test (string-ci=? "z" "a") #f)
115     (test (string-ci<=? "a" "Z") #t)
116     (test (string-ci<=? "A" "z") #t)
117     (test (string-ci<=? "Z" "a") #f)
118     (test (string-ci<=? "z" "A") #f)
119     (test (string-ci<=? "z" "Z") #t)
120     (test (string-ci<=? "Z" "z") #t)
121     (test (string-ci>=? "a" "Z") #f)
122     (test (string-ci>=? "A" "z") #f)
123     (test (string-ci>=? "Z" "a") #t)
124     (test (string-ci>=? "z" "A") #t)
125     (test (string-ci>=? "z" "Z") #t)
126     (test (string-ci>=? "Z" "z") #t)
127
128     (let* ((w #\a)
129            (x #\N)
130            (y #\z)
131            (z (integer->char (+ 13 (char->integer w)))))
132
133       (test (char-ci=? x y z)                          #f)
134       (test (char-ci=? x x z)                          #t)
135       (test (char-ci=? w x y)                          #f)
136       (test (char-ci=? y x w)                          #f)
137
138       (test (char-ci<? x y z)                          #f)
139       (test (char-ci<? x x z)                          #f)
140       (test (char-ci<? w x y)                          #t)
141       (test (char-ci<? y x w)                          #f)
142
143       (test (char-ci>? x y z)                          #f)
144       (test (char-ci>? x x z)                          #f)
145       (test (char-ci>? w x y)                          #f)
146       (test (char-ci>? y x w)                          #t)
147
148       (test (char-ci<=? x y z)                         #f)
149       (test (char-ci<=? x x z)                         #t)
150       (test (char-ci<=? w x y)                         #t)
151       (test (char-ci<=? y x w)                         #f)
152
153       (test (char-ci>=? x y z)                         #f)
154       (test (char-ci>=? x x z)                         #t)
155       (test (char-ci>=? w x y)                         #f)
156       (test (char-ci>=? y x w)                         #t)
157
158
159       (test (char-ci=? x x)                            #t)
160       (test (char-ci=? w x)                            #f)
161       (test (char-ci=? y x)                            #f)
162
163       (test (char-ci<? x x)                            #f)
164       (test (char-ci<? w x)                            #t)
165       (test (char-ci<? y x)                            #f)
166
167       (test (char-ci>? x x)                            #f)
168       (test (char-ci>? w x)                            #f)
169       (test (char-ci>? y x)                            #t)
170
171       (test (char-ci<=? x x)                           #t)
172       (test (char-ci<=? w x)                           #t)
173       (test (char-ci<=? y x)                           #f)
174
175       (test (char-ci>=? x x)                           #t)
176       (test (char-ci>=? w x)                           #f)
177       (test (char-ci>=? y x)                           #t))
178
179     (test (map digit-value (string->list "0123456789abcDEF"))
180           '(0 1 2 3 4 5 6 7 8 9 #f #f #f #f #f #f))
181
182     (run-char-tests-for-unicode)
183
184     ;;
185     )))
186