source: trunk/source/tests/ansi-tests/character.lsp @ 8991

Last change on this file since 8991 was 8991, checked in by gz, 11 years ago

Check in the gcl ansi test suite (original, in preparation for making local changes)

File size: 11.5 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sat Oct  5 12:52:18 2002
4;;;; Contains: Tests associated with the class CHARACTER
5
6(in-package :cl-test)
7
8(deftest character-class.1
9  (subtypep* 'character t)
10  t t)
11
12(deftest base-char.1
13  (subtypep* 'base-char 'character)
14  t t)
15
16(deftest base-char.2
17  (subtypep* 'base-char t)
18  t t)
19
20(deftest base-char.3
21  (every #'(lambda (c) (typep c 'base-char)) +standard-chars+)
22  t)
23
24(deftest standard-char.1
25  (subtypep* 'standard-char 'base-char)
26  t t)
27
28(deftest standard-char.2
29  (subtypep* 'standard-char 'character)
30  t t)
31
32(deftest standard-char.3
33  (subtypep* 'standard-char t)
34  t t)
35
36(deftest standard-char.4
37  (every #'(lambda (c) (typep c 'standard-char)) +standard-chars+)
38  t)
39
40(deftest standard-char.5
41  (standard-char.5.body)
42  t)
43
44(deftest extended-char.1
45  (subtypep* 'extended-char 'character)
46  t t)
47
48(deftest extended-char.2
49  (subtypep* 'extended-char t)
50  t t)
51
52(deftest extended-char.3
53  (extended-char.3.body)
54  t)
55
56;;;
57
58(deftest character.1
59  (character.1.body)
60  t)
61
62(deftest character.2
63  (character.2.body)
64  nil)
65
66(deftest character.order.1
67  (let ((i 0))
68    (values
69     (character (progn (incf i) #\a))
70     i))
71  #\a 1)
72
73(deftest character.error.1
74  (signals-error (character) program-error)
75  t)
76
77(deftest character.error.2
78  (signals-error (character #\a #\a) program-error)
79  t)
80
81;;;
82
83(deftest characterp.1
84  (every #'characterp +standard-chars+)
85  t)
86
87(deftest characterp.2
88  (characterp.2.body)
89  t)
90
91(deftest characterp.3
92  (characterp.3.body)
93  t)
94
95(deftest characterp.order.1
96  (let ((i 0))
97    (values
98     (characterp (incf i))
99     i))
100  nil 1)
101
102(deftest characterp.error.1
103  (signals-error (characterp) program-error)
104  t)
105
106(deftest characterp.error.2
107  (signals-error (characterp #\a #\b) program-error)
108  t)
109
110
111(deftest alpha-char-p.1
112  (loop for c across +standard-chars+
113        always
114        (or (find c +alpha-chars+)
115            (not (alpha-char-p c))))
116  t)
117
118;;;
119
120(deftest alpha-char-p.2
121  (every #'alpha-char-p +alpha-chars+)
122  t)
123
124(deftest alpha-char-p.3
125  (char-type-error-check #'alpha-char-p)
126  t)
127
128(deftest alpha-char-p.4
129  (macrolet ((%m (z) z)) (alpha-char-p (expand-in-current-env (%m #\?))))
130  nil)
131
132(deftest alpha-char-p.order.1
133  (let ((i 0))
134    (values
135     (alpha-char-p (progn (incf i) #\8))
136     i))
137  nil 1)
138
139(deftest alpha-char-p.error.1
140  (signals-error (alpha-char-p) program-error)
141  t)
142
143(deftest alpha-char-p.error.2
144  (signals-error (alpha-char-p #\a #\b) program-error)
145  t)
146
147;;;
148
149(deftest alphanumericp.1
150  (loop for c across +standard-chars+
151        always
152        (or (find c +alphanumeric-chars+)
153            (not (alphanumericp c))))
154  t)
155
156(deftest alphanumericp.2
157  (every #'alphanumericp +alphanumeric-chars+)
158  t)
159
160(deftest alphanumericp.3
161  (char-type-error-check #'alphanumericp)
162  t)
163
164(deftest alphanumericp.4
165  (alphanumericp.4.body)
166  t)
167
168(deftest alphanumericp.5
169  (alphanumericp.5.body)
170  t)
171
172(deftest alphanumbericp.6
173  (macrolet ((%m (z) z)) (alphanumericp (expand-in-current-env (%m #\=))))
174  nil)
175
176(deftest alphanumericp.order.1
177  (let ((i 0))
178    (values
179     (alphanumericp (progn (incf i) #\?))
180     i))
181  nil 1)
182
183(deftest alphanumericp.error.1
184  (signals-error (alphanumericp) program-error)
185  t)
186
187(deftest alphanumericp.error.2
188  (signals-error (alphanumericp #\a #\b) program-error)
189  t)
190
191;;;
192
193(deftest digit-char.1
194  (digit-char.1.body)
195  nil)
196
197(deftest digit-char.2
198  (map 'list #'digit-char (loop for i from 0 to 39 collect i))
199  (#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9
200   nil nil nil nil nil nil nil nil nil nil
201   nil nil nil nil nil nil nil nil nil nil
202   nil nil nil nil nil nil nil nil nil nil))
203
204(deftest digit-char.order.1
205  (let ((i 0))
206    (values
207     (digit-char (incf i))
208     i))
209  #\1 1)
210
211(deftest digit-char.order.2
212  (let ((i 0) x)
213    (values
214     (digit-char (incf i) (progn (setf x (incf i)) 10))
215     i x))
216  #\1 2 2)
217
218(deftest digit-char.error.1
219  (signals-error (digit-char) program-error)
220  t)
221
222(deftest digit-char.error.2
223  (signals-error (digit-char 0 10 'foo) program-error)
224  t)
225
226;;;
227
228(deftest digit-char-p.1
229  (digit-char-p.1.body)
230  t)
231
232(deftest digit-char-p.2
233  (digit-char-p.2.body)
234  t)
235                   
236(deftest digit-char-p.3
237  (digit-char-p.3.body)
238  t)
239
240(deftest digit-char-p.4
241  (digit-char-p.4.body)
242  t)
243
244(deftest digit-char-p.5
245  (loop for i from 10 to 35
246        for c = (char +extended-digit-chars+ i)
247        never (or (digit-char-p c)
248                  (digit-char-p (char-downcase c))))
249  t)
250
251(deftest digit-char-p.6
252  (loop for i from 0 below 10
253        for c = (char +extended-digit-chars+ i)
254        always (eqlt (digit-char-p c) i))
255  t)
256
257(deftest digit-char-p.order.1
258  (let ((i 0))
259    (values
260     (digit-char-p (progn (incf i) #\0))
261     i))
262  0 1)
263
264(deftest digit-char-p.order.2
265  (let ((i 0) x y)
266    (values
267     (digit-char-p (progn (setf x (incf i)) #\0)
268                   (progn (setf y (incf i)) 10))
269     i x y))
270  0 2 1 2)
271
272(deftest digit-char-p.error.1
273  (signals-error (digit-char-p) program-error)
274  t)
275 
276(deftest digit-char-p.error.2
277  (signals-error (digit-char-p #\1 10 'foo) program-error)
278  t)
279
280;;;
281
282(deftest graphic-char-p.1
283  (loop for c across +standard-chars+
284        always (if (eqlt c #\Newline)
285                   (not (graphic-char-p c))
286                 (graphic-char-p c)))
287  t)
288
289(deftest graphic-char-p.2
290  (loop
291   for name in '("Rubout" "Page" "Backspace" "Tab" "Linefeed" "Return")
292   for c = (name-char name)
293   when (and c (graphic-char-p c)) collect c)
294  nil)
295
296(deftest graphic-char-p.3
297  (char-type-error-check #'graphic-char-p)
298  t)
299
300(deftest graphic-char-p.order.1
301  (let ((i 0))
302    (values
303     (not (graphic-char-p (progn (incf i) #\a)))
304     i))
305  nil 1)
306
307(deftest graphic-char-p.error.1
308  (signals-error (graphic-char-p) program-error)
309  t)
310
311(deftest graphic-char-p.error.2
312  (signals-error (graphic-char-p #\a #\a) program-error)
313  t)
314
315;;;
316
317(deftest standard-char-p.1
318  (every #'standard-char-p +standard-chars+)
319  t)
320
321(deftest standard-char-p.2
322  (standard-char-p.2.body)
323  t)
324
325(deftest standard-char-p.2a
326  (standard-char-p.2a.body)
327  t)
328
329(deftest standard-char-p.3
330  (char-type-error-check #'standard-char-p)
331  t)
332
333(deftest standard-char-p.order.1
334  (let ((i 0))
335    (values
336     (not (standard-char-p (progn (incf i) #\a)))
337     i))
338  nil 1)
339
340(deftest standard-char-p.error.1
341  (signals-error (standard-char-p) program-error)
342  t)
343 
344(deftest standard-char-p.error.2
345  (signals-error (standard-char-p #\a #\a) program-error)
346  t)
347
348;;;
349
350(deftest char-upcase.1
351  (char-upcase.1.body)
352  t)
353
354(deftest char-upcase.2
355  (char-upcase.2.body)
356  t)
357
358(deftest char-upcase.3
359  (map 'string #'char-upcase +alpha-chars+)
360  "ABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLMNOPQRSTUVWXYZ")
361
362(deftest char-upcase.4
363  (char-type-error-check #'char-upcase)
364  t)
365
366(deftest char-upcase.order.1
367  (let ((i 0))
368    (values
369     (char-upcase (progn (incf i) #\a))
370     i))
371  #\A 1)
372
373(deftest char-upcase.error.1
374  (signals-error (char-upcase) program-error)
375  t)
376
377(deftest char-upcase.error.2
378  (signals-error (char-upcase #\a #\a) program-error)
379  t)
380
381;;;
382
383(deftest char-downcase.1
384  (char-downcase.1.body)
385  t)
386
387(deftest char-downcase.2
388  (char-downcase.2.body)
389  t)
390
391(deftest char-downcase.3
392  (map 'string #'char-downcase +alpha-chars+)
393  "abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz")
394
395(deftest char-downcase.4
396  (char-type-error-check #'char-downcase)
397  t)
398
399(deftest char-downcase.order.1
400  (let ((i 0))
401    (values
402     (char-downcase (progn (incf i) #\A))
403     i))
404  #\a 1)
405
406(deftest char-downcase.error.1
407  (signals-error (char-downcase) program-error)
408  t)
409
410(deftest char-downcase.error.2
411  (signals-error (char-downcase #\A #\A) program-error)
412  t)
413
414;;;
415
416(deftest upper-case-p.1
417  (find-if-not #'upper-case-p +standard-chars+ :start 26 :end 52)
418  nil)
419
420(deftest upper-case-p.2
421  (find-if #'upper-case-p +standard-chars+ :end 26)
422  nil)
423
424(deftest upper-case-p.3
425  (find #'upper-case-p +standard-chars+ :start 52)
426  nil)
427
428(deftest upper-case-p.4
429  (char-type-error-check #'upper-case-p)
430  t)
431
432(deftest upper-case-p.order.1
433  (let ((i 0))
434    (values
435     (upper-case-p (progn (incf i) #\a))
436     i))
437  nil 1)
438
439(deftest upper-case-p.error.1
440  (signals-error (upper-case-p) program-error)
441  t)
442
443(deftest upper-case-p.error.2
444  (signals-error (upper-case-p #\a #\A) program-error)
445  t)
446
447;;;
448
449(deftest lower-case-p.1
450  (find-if-not #'lower-case-p +standard-chars+ :end 26)
451  nil)
452
453(deftest lower-case-p.2
454  (find-if #'lower-case-p +standard-chars+ :start 26)
455  nil)
456
457(deftest lower-case-p.3
458  (char-type-error-check #'lower-case-p)
459  t)
460
461(deftest lower-case-p.order.1
462  (let ((i 0))
463    (values
464     (lower-case-p (progn (incf i) #\A))
465     i))
466  nil 1)
467
468(deftest lower-case-p.error.1
469  (signals-error (lower-case-p) program-error)
470  t)
471
472(deftest lower-case-p.error.2
473  (signals-error (lower-case-p #\a #\a) program-error)
474  t)
475
476;;;
477
478(deftest both-case-p.1
479  (both-case-p.1.body)
480  t)
481
482(deftest both-case-p.2
483  (both-case-p.2.body)
484  t)
485
486(deftest both-case-p.3
487  (char-type-error-check #'both-case-p)
488  t)
489
490(deftest both-case-p.4
491  (notnot (macrolet ((%m (z) z)) (both-case-p (expand-in-current-env (%m #\a)))))
492  t)
493
494(deftest both-case-p.order.1
495  (let ((i 0))
496    (values
497     (both-case-p (progn (incf i) #\5))
498     i))
499  nil 1)
500
501(deftest both-case-p.error.1
502  (signals-error (both-case-p) program-error)
503  t)
504
505(deftest both-case-p.error.2
506  (signals-error (both-case-p #\a #\a) program-error)
507  t)
508
509;;;
510
511(deftest char-code.1
512  (char-type-error-check #'char-code)
513  t)
514
515(deftest char-code.2
516  (char-code.2.body)
517  t)
518
519(deftest char-code.order.1
520  (let ((i 0))
521    (values
522     (not (numberp (char-code (progn (incf i) #\a))))
523     i))
524  nil 1)
525
526(deftest char-code.error.1
527  (signals-error (char-code) program-error)
528  t)
529
530(deftest char-code.error.2
531  (signals-error (char-code #\a #\a) program-error)
532  t)
533
534;;;
535
536(deftest code-char.1
537  (loop for x across +standard-chars+
538        always (eqlt (code-char (char-code x)) x))
539  t)
540
541(deftest code-char.order.1
542  (let ((i 0))
543    (values
544     (code-char (progn (incf i) (char-code #\a)))
545     i))
546  #\a 1)
547
548(deftest code-char.error.1
549  (signals-error (code-char) program-error)
550  t)
551
552(deftest code-char.error.2
553  (signals-error (code-char 1 1) program-error)
554  t)
555
556;;;
557
558(deftest char-int.1
559  (loop for x across +standard-chars+
560        always (eqlt (char-int x) (char-code x)))
561  t)
562
563(deftest char-int.2
564  (char-int.2.fn)
565  nil)
566
567(deftest char-int.order.1
568  (let ((i 0))
569    (values
570     (code-char (char-int (progn (incf i) #\a)))
571     i))
572  #\a 1)
573
574(deftest char-int.error.1
575  (signals-error (char-int) program-error)
576  t)
577
578(deftest char-int.error.2
579  (signals-error (char-int #\a #\a) program-error)
580  t)
581
582;;;
583
584(deftest char-name.1
585  (char-name.1.fn)
586  t)
587
588(deftest char-name.2
589  (notnot-mv (string= (char-name #\Space) "Space"))
590  t)
591
592(deftest char-name.3
593  (notnot-mv (string= (char-name #\Newline) "Newline"))
594  t)
595
596;;; Check that the names of various semi-standard characters are
597;;; appropriate.  This is complicated by the possibility that two different
598;;; names may refer to the same character (as is allowed by the standard,
599;;; for example in the case of Newline and Linefeed).
600 
601(deftest char-name.4
602  (loop for s in '("Rubout" "Page" "Backspace" "Return" "Tab" "Linefeed")
603        for c = (name-char s)
604        unless (or (not c)
605                   ;; If the char-name is not even string-equal,
606                   ;; assume we're sharing the character with some other
607                   ;; name, and assume it's ok
608                   (not (string-equal (char-name c) s))
609                   (string= (char-name c) s))
610        ;; Collect list of cases that failed
611        collect (list s c (char-name c)))
612  nil)
613
614(deftest char-name.5
615  (char-type-error-check #'char-name)
616  t)
617
618(deftest char-name.order.1
619  (let ((i 0))
620    (values
621     (char-name (progn (incf i) #\Space))
622     i))
623  "Space" 1)
624
625(deftest char-name.error.1
626  (signals-error (char-name) program-error)
627  t)
628
629(deftest char-name.error.2
630  (signals-error (char-name #\a #\a) program-error)
631  t)
Note: See TracBrowser for help on using the repository browser.