character.lsp 12.4 KB
Newer Older
1
2
3
4
5
6
7
8
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sat Oct  5 12:52:18 2002
;;;; Contains: Tests associated with the class CHARACTER

(in-package :cl-test)

(deftest character-class.1
9
  (subtypep* 'character t)
10
11
12
  t t)

(deftest base-char.1
13
  (subtypep* 'base-char 'character)
14
15
16
  t t)

(deftest base-char.2
17
  (subtypep* 'base-char t)
18
19
20
21
22
23
24
  t t)

(deftest base-char.3
  (every #'(lambda (c) (typep c 'base-char)) +standard-chars+)
  t)

(deftest standard-char.1
25
  (subtypep* 'standard-char 'base-char)
26
27
28
  t t)

(deftest standard-char.2
29
  (subtypep* 'standard-char 'character)
30
31
32
  t t)

(deftest standard-char.3
33
  (subtypep* 'standard-char t)
34
35
36
37
38
39
40
  t t)

(deftest standard-char.4
  (every #'(lambda (c) (typep c 'standard-char)) +standard-chars+)
  t)

(deftest standard-char.5
41
  (standard-char.5.body)
42
  ())
43
44

(deftest extended-char.1
45
  (subtypep* 'extended-char 'character)
46
47
48
  t t)

(deftest extended-char.2
49
  (subtypep* 'extended-char t)
50
51
52
  t t)

(deftest extended-char.3
53
  (extended-char.3.body)
54
  ())
55

sds's avatar
sds committed
56
;;;
57
58

(deftest character.1
59
  (character.1.body)
60
  ())
61
62

(deftest character.2
63
  (character.2.body)
64
65
  nil)

66
67
68
69
70
71
72
73
(deftest character.order.1
  (let ((i 0))
    (values
     (character (progn (incf i) #\a))
     i))
  #\a 1)

(deftest character.error.1
74
75
  (signals-error (character) program-error)
  t)
76

77
(deftest character.error.2
78
79
  (signals-error (character #\a #\a) program-error)
  t)
80

81
82
;;;

83
84
85
86
87
(deftest characterp.1
  (every #'characterp +standard-chars+)
  t)

(deftest characterp.2
88
  (characterp.2.body)
89
  ())
90
91

(deftest characterp.3
92
  (characterp.3.body)
93
  ())
94

95
96
97
98
99
100
101
(deftest characterp.order.1
  (let ((i 0))
    (values
     (characterp (incf i))
     i))
  nil 1)

102
(deftest characterp.error.1
103
104
  (signals-error (characterp) program-error)
  t)
105
106

(deftest characterp.error.2
107
108
  (signals-error (characterp #\a #\b) program-error)
  t)
109
110


111
112
(deftest alpha-char-p.1
  (loop for c across +standard-chars+
113
114
115
116
        unless (or (find c +alpha-chars+)
                   (not (alpha-char-p c)))
        collect c)
  ())
117

118
119
;;;

120
121
122
123
124
(deftest alpha-char-p.2
  (every #'alpha-char-p +alpha-chars+)
  t)

(deftest alpha-char-p.3
125
  (char-type-error-check #'alpha-char-p)
126
127
  t)

128
129
130
131
(deftest alpha-char-p.4
  (macrolet ((%m (z) z)) (alpha-char-p (expand-in-current-env (%m #\?))))
  nil)

132
133
134
135
136
137
138
(deftest alpha-char-p.order.1
  (let ((i 0))
    (values
     (alpha-char-p (progn (incf i) #\8))
     i))
  nil 1)

139
(deftest alpha-char-p.error.1
140
141
  (signals-error (alpha-char-p) program-error)
  t)
142
143

(deftest alpha-char-p.error.2
144
145
  (signals-error (alpha-char-p #\a #\b) program-error)
  t)
146

147
148
;;;

149
150
(deftest alphanumericp.1
  (loop for c across +standard-chars+
151
152
153
154
        unless (or (find c +alphanumeric-chars+)
                   (not (alphanumericp c)))
        collect c)
  ())
155
156
157
158
159
160

(deftest alphanumericp.2
  (every #'alphanumericp +alphanumeric-chars+)
  t)

(deftest alphanumericp.3
161
  (char-type-error-check #'alphanumericp)
162
163
164
  t)

(deftest alphanumericp.4
165
  (alphanumericp.4.body)
166
  ())
167
168

(deftest alphanumericp.5
169
  (alphanumericp.5.body)
170
  ())
171

172
173
174
175
(deftest alphanumbericp.6
  (macrolet ((%m (z) z)) (alphanumericp (expand-in-current-env (%m #\=))))
  nil)

176
177
178
179
180
181
182
(deftest alphanumericp.order.1
  (let ((i 0))
    (values
     (alphanumericp (progn (incf i) #\?))
     i))
  nil 1)

183
(deftest alphanumericp.error.1
184
185
  (signals-error (alphanumericp) program-error)
  t)
186
187

(deftest alphanumericp.error.2
188
189
  (signals-error (alphanumericp #\a #\b) program-error)
  t)
190

191
192
;;;

193
(deftest digit-char.1
194
  (digit-char.1.body)
195
  nil)
196
197
198
199
200
201
202
203

(deftest digit-char.2
  (map 'list #'digit-char (loop for i from 0 to 39 collect i))
  (#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9
   nil nil nil nil nil nil nil nil nil nil
   nil nil nil nil nil nil nil nil nil nil
   nil nil nil nil nil nil nil nil nil nil))

204
205
206
207
208
209
210
211
212
213
214
215
216
217
(deftest digit-char.order.1
  (let ((i 0))
    (values
     (digit-char (incf i))
     i))
  #\1 1)

(deftest digit-char.order.2
  (let ((i 0) x)
    (values
     (digit-char (incf i) (progn (setf x (incf i)) 10))
     i x))
  #\1 2 2)

218
(deftest digit-char.error.1
219
220
  (signals-error (digit-char) program-error)
  t)
221
222

(deftest digit-char.error.2
223
224
  (signals-error (digit-char 0 10 'foo) program-error)
  t)
225

226
227
;;;

228
(deftest digit-char-p.1
229
  (digit-char-p.1.body)
230
  ())
231
232

(deftest digit-char-p.2
233
  (digit-char-p.2.body)
234
  ())
sds's avatar
sds committed
235

236
(deftest digit-char-p.3
237
  (digit-char-p.3.body)
238
  ())
239
240

(deftest digit-char-p.4
241
  (digit-char-p.4.body)
242
  ())
243
244
245

(deftest digit-char-p.5
  (loop for i from 10 to 35
sds's avatar
sds committed
246
        for c = (char +extended-digit-chars+ i)
247
248
249
250
        when (or (digit-char-p c)
                 (digit-char-p (char-downcase c)))
        collect c)
  ())
251
252
253

(deftest digit-char-p.6
  (loop for i from 0 below 10
sds's avatar
sds committed
254
        for c = (char +extended-digit-chars+ i)
255
256
257
        unless (eqlt (digit-char-p c) i)
        collect i)
  ())
258

259
260
261
262
263
264
265
266
267
268
269
(deftest digit-char-p.order.1
  (let ((i 0))
    (values
     (digit-char-p (progn (incf i) #\0))
     i))
  0 1)

(deftest digit-char-p.order.2
  (let ((i 0) x y)
    (values
     (digit-char-p (progn (setf x (incf i)) #\0)
sds's avatar
sds committed
270
                   (progn (setf y (incf i)) 10))
271
272
273
     i x y))
  0 2 1 2)

274
(deftest digit-char-p.error.1
275
276
  (signals-error (digit-char-p) program-error)
  t)
sds's avatar
sds committed
277

278
(deftest digit-char-p.error.2
279
280
  (signals-error (digit-char-p #\1 10 'foo) program-error)
  t)
281
282

;;;
283

284
285
(deftest graphic-char-p.1
  (loop for c across +standard-chars+
286
        unless (if (eqlt c #\Newline)
sds's avatar
sds committed
287
                   (not (graphic-char-p c))
288
289
290
                   (graphic-char-p c))
        collect c)
  ())
291

292
(deftest graphic-char-p.2
293
294
295
296
297
298
  (loop
   for name in '("Rubout" "Page" "Backspace" "Tab" "Linefeed" "Return")
   for c = (name-char name)
   when (and c (graphic-char-p c)) collect c)
  nil)

299
(deftest graphic-char-p.3
300
  (char-type-error-check #'graphic-char-p)
301
302
  t)

303
304
305
306
307
308
309
(deftest graphic-char-p.order.1
  (let ((i 0))
    (values
     (not (graphic-char-p (progn (incf i) #\a)))
     i))
  nil 1)

310
(deftest graphic-char-p.error.1
311
312
  (signals-error (graphic-char-p) program-error)
  t)
313
314

(deftest graphic-char-p.error.2
315
316
  (signals-error (graphic-char-p #\a #\a) program-error)
  t)
317

318
319
;;;

320
321
322
323
324
(deftest standard-char-p.1
  (every #'standard-char-p +standard-chars+)
  t)

(deftest standard-char-p.2
325
  (standard-char-p.2.body)
326
  ())
327

328
(deftest standard-char-p.2a
329
  (standard-char-p.2a.body)
330
  ())
331
332

(deftest standard-char-p.3
333
334
335
  (char-type-error-check #'standard-char-p)
  t)

336
337
338
339
340
341
342
(deftest standard-char-p.order.1
  (let ((i 0))
    (values
     (not (standard-char-p (progn (incf i) #\a)))
     i))
  nil 1)

343
(deftest standard-char-p.error.1
344
345
  (signals-error (standard-char-p) program-error)
  t)
sds's avatar
sds committed
346

347
(deftest standard-char-p.error.2
348
349
  (signals-error (standard-char-p #\a #\a) program-error)
  t)
350
351

;;;
352

353
354
355
356
357
358
359
360
;; based on http://unicode.org/faq/casemap_charprop.html#2
;; ABCL doesn't implement the pairwise case mappings
;; ABCL deems Unicode conformance more important than CLHS conformance
;; SBCL's solution to make these tests work is by declaring
;; characters to be without case, even though Unicode does declare
;; a case mapping
;;
;; this comment applies to char-upcase.1 and char-upcase.2
361
;; and char-downcase.1 and char-downcase.2
362
363

#-abcl
364
(deftest char-upcase.1
365
  (char-upcase.1.body)
366
  ())
367

368
#-abcl
369
(deftest char-upcase.2
370
  (char-upcase.2.body)
371
  ())
372
373
374
375
376
377
378

(deftest char-upcase.3
  (map 'string #'char-upcase +alpha-chars+)
  "ABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLMNOPQRSTUVWXYZ")

(deftest char-upcase.4
  (char-type-error-check #'char-upcase)
379
380
  t)

381
382
383
384
385
386
387
(deftest char-upcase.order.1
  (let ((i 0))
    (values
     (char-upcase (progn (incf i) #\a))
     i))
  #\A 1)

388
(deftest char-upcase.error.1
389
390
  (signals-error (char-upcase) program-error)
  t)
391
392

(deftest char-upcase.error.2
393
394
  (signals-error (char-upcase #\a #\a) program-error)
  t)
395

396
397
;;;

398
399
;; see char-upcase.1 why this test is commented out for ABCL
#-abcl
400
(deftest char-downcase.1
401
  (char-downcase.1.body)
402
  ())
403

404
#-abcl
405
(deftest char-downcase.2
406
  (char-downcase.2.body)
407
  ())
408
409
410
411
412
413
414
415
416

(deftest char-downcase.3
  (map 'string #'char-downcase +alpha-chars+)
  "abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz")

(deftest char-downcase.4
  (char-type-error-check #'char-downcase)
  t)

417
418
419
420
421
422
423
(deftest char-downcase.order.1
  (let ((i 0))
    (values
     (char-downcase (progn (incf i) #\A))
     i))
  #\a 1)

424
(deftest char-downcase.error.1
425
426
  (signals-error (char-downcase) program-error)
  t)
427
428

(deftest char-downcase.error.2
429
430
  (signals-error (char-downcase #\A #\A) program-error)
  t)
431

432
433
;;;

434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
(deftest upper-case-p.1
  (find-if-not #'upper-case-p +standard-chars+ :start 26 :end 52)
  nil)

(deftest upper-case-p.2
  (find-if #'upper-case-p +standard-chars+ :end 26)
  nil)

(deftest upper-case-p.3
  (find #'upper-case-p +standard-chars+ :start 52)
  nil)

(deftest upper-case-p.4
  (char-type-error-check #'upper-case-p)
  t)

450
451
452
453
454
455
456
(deftest upper-case-p.order.1
  (let ((i 0))
    (values
     (upper-case-p (progn (incf i) #\a))
     i))
  nil 1)

457
(deftest upper-case-p.error.1
458
459
  (signals-error (upper-case-p) program-error)
  t)
460
461

(deftest upper-case-p.error.2
462
463
  (signals-error (upper-case-p #\a #\A) program-error)
  t)
464

465
466
;;;

467
468
469
470
471
472
473
474
475
476
477
478
(deftest lower-case-p.1
  (find-if-not #'lower-case-p +standard-chars+ :end 26)
  nil)

(deftest lower-case-p.2
  (find-if #'lower-case-p +standard-chars+ :start 26)
  nil)

(deftest lower-case-p.3
  (char-type-error-check #'lower-case-p)
  t)

479
480
481
482
483
484
485
(deftest lower-case-p.order.1
  (let ((i 0))
    (values
     (lower-case-p (progn (incf i) #\A))
     i))
  nil 1)

486
(deftest lower-case-p.error.1
487
488
  (signals-error (lower-case-p) program-error)
  t)
489
490

(deftest lower-case-p.error.2
491
492
  (signals-error (lower-case-p #\a #\a) program-error)
  t)
493

494
495
;;;

496
(deftest both-case-p.1
497
  (both-case-p.1.body)
498
  ())
499
500

(deftest both-case-p.2
501
  (both-case-p.2.body)
502
  ())
503
504
505
506
507

(deftest both-case-p.3
  (char-type-error-check #'both-case-p)
  t)

508
509
510
511
(deftest both-case-p.4
  (notnot (macrolet ((%m (z) z)) (both-case-p (expand-in-current-env (%m #\a)))))
  t)

512
513
514
515
516
517
518
(deftest both-case-p.order.1
  (let ((i 0))
    (values
     (both-case-p (progn (incf i) #\5))
     i))
  nil 1)

519
(deftest both-case-p.error.1
520
521
  (signals-error (both-case-p) program-error)
  t)
522
523

(deftest both-case-p.error.2
524
525
  (signals-error (both-case-p #\a #\a) program-error)
  t)
526

527
528
;;;

529
530
531
532
533
(deftest char-code.1
  (char-type-error-check #'char-code)
  t)

(deftest char-code.2
534
  (char-code.2.body)
535
  ())
536

537
538
539
540
541
542
543
(deftest char-code.order.1
  (let ((i 0))
    (values
     (not (numberp (char-code (progn (incf i) #\a))))
     i))
  nil 1)

544
(deftest char-code.error.1
545
546
  (signals-error (char-code) program-error)
  t)
547
548

(deftest char-code.error.2
549
550
  (signals-error (char-code #\a #\a) program-error)
  t)
551

552
553
;;;

554
555
(deftest code-char.1
  (loop for x across +standard-chars+
556
557
558
        unless (eqlt (code-char (char-code x)) x)
        collect x)
  ())
559

560
561
562
563
564
565
566
(deftest code-char.order.1
  (let ((i 0))
    (values
     (code-char (progn (incf i) (char-code #\a)))
     i))
  #\a 1)

567
(deftest code-char.error.1
568
569
  (signals-error (code-char) program-error)
  t)
570
571

(deftest code-char.error.2
572
573
  (signals-error (code-char 1 1) program-error)
  t)
574

575
576
;;;

577
578
(deftest char-int.1
  (loop for x across +standard-chars+
579
580
581
        unless (eqlt (char-int x) (char-code x))
        collect x)
  ())
582
583
584

(deftest char-int.2
  (char-int.2.fn)
585
  nil)
586

587
588
589
590
591
592
593
(deftest char-int.order.1
  (let ((i 0))
    (values
     (code-char (char-int (progn (incf i) #\a)))
     i))
  #\a 1)

594
(deftest char-int.error.1
595
596
  (signals-error (char-int) program-error)
  t)
597
598

(deftest char-int.error.2
599
600
  (signals-error (char-int #\a #\a) program-error)
  t)
601

602
603
;;;

604
605
(deftest char-name.1
  (char-name.1.fn)
606
607
608
  t)

(deftest char-name.2
pfdietz's avatar
pfdietz committed
609
  (notnot-mv (string= (char-name #\Space) "Space"))
610
611
612
  t)

(deftest char-name.3
pfdietz's avatar
pfdietz committed
613
  (notnot-mv (string= (char-name #\Newline) "Newline"))
614
615
  t)

616
617
618
619
;;; Check that the names of various semi-standard characters are
;;; appropriate.  This is complicated by the possibility that two different
;;; names may refer to the same character (as is allowed by the standard,
;;; for example in the case of Newline and Linefeed).
sds's avatar
sds committed
620

621
622
(deftest char-name.4
  (loop for s in '("Rubout" "Page" "Backspace" "Return" "Tab" "Linefeed")
sds's avatar
sds committed
623
624
625
626
627
628
629
630
631
        for c = (name-char s)
        unless (or (not c)
                   ;; If the char-name is not even string-equal,
                   ;; assume we're sharing the character with some other
                   ;; name, and assume it's ok
                   (not (string-equal (char-name c) s))
                   (string= (char-name c) s))
        ;; Collect list of cases that failed
        collect (list s c (char-name c)))
632
633
634
635
636
637
  nil)

(deftest char-name.5
  (char-type-error-check #'char-name)
  t)

638
639
640
641
642
643
644
(deftest char-name.order.1
  (let ((i 0))
    (values
     (char-name (progn (incf i) #\Space))
     i))
  "Space" 1)

645
(deftest char-name.error.1
646
647
  (signals-error (char-name) program-error)
  t)
648
649

(deftest char-name.error.2
650
651
  (signals-error (char-name #\a #\a) program-error)
  t)