← Back to branch summary

~ubuntu-branches/ubuntu/quantal/gclcvs/quantal

« back to all changes in this revision

Viewing changes to ansi-tests/character.lsp

  • Committer: Bazaar Package Importer
  • Author(s): Camm Maguire
  • Date: 2004-06-24 15:13:46 UTC
  • Revision ID: james.westby@ubuntu.com-20040624151346-xh0xaaktyyp7aorc
Tags: 2.7.0-26
C_GC_OFFSET is 2 on m68k-linux

Show diffs side-by-side

added added

removed removed

Lines of Context:
ansi-tests/character.lsp
 
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.order.1
 
129
  (let ((i 0))
 
130
    (values
 
131
     (alpha-char-p (progn (incf i) #\8))
 
132
     i))
 
133
  nil 1)
 
134
 
 
135
(deftest alpha-char-p.error.1
 
136
  (signals-error (alpha-char-p) program-error)
 
137
  t)
 
138
 
 
139
(deftest alpha-char-p.error.2
 
140
  (signals-error (alpha-char-p #\a #\b) program-error)
 
141
  t)
 
142
 
 
143
;;;
 
144
 
 
145
(deftest alphanumericp.1
 
146
  (loop for c across +standard-chars+
 
147
        always
 
148
        (or (find c +alphanumeric-chars+)
 
149
            (not (alphanumericp c))))
 
150
  t)
 
151
 
 
152
(deftest alphanumericp.2
 
153
  (every #'alphanumericp +alphanumeric-chars+)
 
154
  t)
 
155
 
 
156
(deftest alphanumericp.3
 
157
  (char-type-error-check #'alphanumericp)
 
158
  t)
 
159
 
 
160
(deftest alphanumericp.4
 
161
  (alphanumericp.4.body)
 
162
  t)
 
163
 
 
164
(deftest alphanumericp.5
 
165
  (alphanumericp.5.body)
 
166
  t)
 
167
 
 
168
(deftest alphanumericp.order.1
 
169
  (let ((i 0))
 
170
    (values
 
171
     (alphanumericp (progn (incf i) #\?))
 
172
     i))
 
173
  nil 1)
 
174
 
 
175
(deftest alphanumericp.error.1
 
176
  (signals-error (alphanumericp) program-error)
 
177
  t)
 
178
 
 
179
(deftest alphanumericp.error.2
 
180
  (signals-error (alphanumericp #\a #\b) program-error)
 
181
  t)
 
182
 
 
183
;;;
 
184
 
 
185
(deftest digit-char.1
 
186
  (digit-char.1.body)
 
187
  t)
 
188
 
 
189
(deftest digit-char.2
 
190
  (map 'list #'digit-char (loop for i from 0 to 39 collect i))
 
191
  (#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9
 
192
   nil nil nil nil nil nil nil nil nil nil
 
193
   nil nil nil nil nil nil nil nil nil nil
 
194
   nil nil nil nil nil nil nil nil nil nil))
 
195
 
 
196
(deftest digit-char.order.1
 
197
  (let ((i 0))
 
198
    (values
 
199
     (digit-char (incf i))
 
200
     i))
 
201
  #\1 1)
 
202
 
 
203
(deftest digit-char.order.2
 
204
  (let ((i 0) x)
 
205
    (values
 
206
     (digit-char (incf i) (progn (setf x (incf i)) 10))
 
207
     i x))
 
208
  #\1 2 2)
 
209
 
 
210
(deftest digit-char.error.1
 
211
  (signals-error (digit-char) program-error)
 
212
  t)
 
213
 
 
214
(deftest digit-char.error.2
 
215
  (signals-error (digit-char 0 10 'foo) program-error)
 
216
  t)
 
217
 
 
218
;;;
 
219
 
 
220
(deftest digit-char-p.1
 
221
  (digit-char-p.1.body)
 
222
  t)
 
223
 
 
224
(deftest digit-char-p.2
 
225
  (digit-char-p.2.body)
 
226
  t)
 
227
                   
 
228
(deftest digit-char-p.3
 
229
  (digit-char-p.3.body)
 
230
  t)
 
231
 
 
232
(deftest digit-char-p.4
 
233
  (digit-char-p.4.body)
 
234
  t)
 
235
 
 
236
(deftest digit-char-p.5
 
237
  (loop for i from 10 to 35
 
238
        for c = (char +extended-digit-chars+ i)
 
239
        never (or (digit-char-p c)
 
240
                  (digit-char-p (char-downcase c))))
 
241
  t)
 
242
 
 
243
(deftest digit-char-p.6
 
244
  (loop for i from 0 below 10
 
245
        for c = (char +extended-digit-chars+ i)
 
246
        always (eqlt (digit-char-p c) i))
 
247
  t)
 
248
 
 
249
(deftest digit-char-p.order.1
 
250
  (let ((i 0))
 
251
    (values
 
252
     (digit-char-p (progn (incf i) #\0))
 
253
     i))
 
254
  0 1)
 
255
 
 
256
(deftest digit-char-p.order.2
 
257
  (let ((i 0) x y)
 
258
    (values
 
259
     (digit-char-p (progn (setf x (incf i)) #\0)
 
260
                   (progn (setf y (incf i)) 10))
 
261
     i x y))
 
262
  0 2 1 2)
 
263
 
 
264
(deftest digit-char-p.error.1
 
265
  (signals-error (digit-char-p) program-error)
 
266
  t)
 
267
  
 
268
(deftest digit-char-p.error.2
 
269
  (signals-error (digit-char-p #\1 10 'foo) program-error)
 
270
  t)
 
271
 
 
272
;;;
 
273
 
 
274
(deftest graphic-char-p.1
 
275
  (loop for c across +standard-chars+
 
276
        always (if (eqlt c #\Newline)
 
277
                   (not (graphic-char-p c))
 
278
                 (graphic-char-p c)))
 
279
  t)
 
280
 
 
281
(deftest graphic-char-p.2
 
282
  (loop
 
283
   for name in '("Rubout" "Page" "Backspace" "Tab" "Linefeed" "Return")
 
284
   for c = (name-char name)
 
285
   when (and c (graphic-char-p c)) collect c)
 
286
  nil)
 
287
 
 
288
(deftest graphic-char-p.3
 
289
  (char-type-error-check #'graphic-char-p)
 
290
  t)
 
291
 
 
292
(deftest graphic-char-p.order.1
 
293
  (let ((i 0))
 
294
    (values
 
295
     (not (graphic-char-p (progn (incf i) #\a)))
 
296
     i))
 
297
  nil 1)
 
298
 
 
299
(deftest graphic-char-p.error.1
 
300
  (signals-error (graphic-char-p) program-error)
 
301
  t)
 
302
 
 
303
(deftest graphic-char-p.error.2
 
304
  (signals-error (graphic-char-p #\a #\a) program-error)
 
305
  t)
 
306
 
 
307
;;;
 
308
 
 
309
(deftest standard-char-p.1
 
310
  (every #'standard-char-p +standard-chars+)
 
311
  t)
 
312
 
 
313
(deftest standard-char-p.2
 
314
  (standard-char-p.2.body)
 
315
  t)
 
316
 
 
317
(deftest standard-char-p.2a
 
318
  (standard-char-p.2a.body)
 
319
  t)
 
320
 
 
321
(deftest standard-char-p.3
 
322
  (char-type-error-check #'standard-char-p)
 
323
  t)
 
324
 
 
325
(deftest standard-char-p.order.1
 
326
  (let ((i 0))
 
327
    (values
 
328
     (not (standard-char-p (progn (incf i) #\a)))
 
329
     i))
 
330
  nil 1)
 
331
 
 
332
(deftest standard-char-p.error.1
 
333
  (signals-error (standard-char-p) program-error)
 
334
  t)
 
335
  
 
336
(deftest standard-char-p.error.2
 
337
  (signals-error (standard-char-p #\a #\a) program-error)
 
338
  t)
 
339
 
 
340
;;;
 
341
 
 
342
(deftest char-upcase.1
 
343
  (char-upcase.1.body)
 
344
  t)
 
345
 
 
346
(deftest char-upcase.2
 
347
  (char-upcase.2.body)
 
348
  t)
 
349
 
 
350
(deftest char-upcase.3
 
351
  (map 'string #'char-upcase +alpha-chars+)
 
352
  "ABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLMNOPQRSTUVWXYZ")
 
353
 
 
354
(deftest char-upcase.4
 
355
  (char-type-error-check #'char-upcase)
 
356
  t)
 
357
 
 
358
(deftest char-upcase.order.1
 
359
  (let ((i 0))
 
360
    (values
 
361
     (char-upcase (progn (incf i) #\a))
 
362
     i))
 
363
  #\A 1)
 
364
 
 
365
(deftest char-upcase.error.1
 
366
  (signals-error (char-upcase) program-error)
 
367
  t)
 
368
 
 
369
(deftest char-upcase.error.2
 
370
  (signals-error (char-upcase #\a #\a) program-error)
 
371
  t)
 
372
 
 
373
;;;
 
374
 
 
375
(deftest char-downcase.1
 
376
  (char-downcase.1.body)
 
377
  t)
 
378
 
 
379
(deftest char-downcase.2
 
380
  (char-downcase.2.body)
 
381
  t)
 
382
 
 
383
(deftest char-downcase.3
 
384
  (map 'string #'char-downcase +alpha-chars+)
 
385
  "abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz")
 
386
 
 
387
(deftest char-downcase.4
 
388
  (char-type-error-check #'char-downcase)
 
389
  t)
 
390
 
 
391
(deftest char-downcase.order.1
 
392
  (let ((i 0))
 
393
    (values
 
394
     (char-downcase (progn (incf i) #\A))
 
395
     i))
 
396
  #\a 1)
 
397
 
 
398
(deftest char-downcase.error.1
 
399
  (signals-error (char-downcase) program-error)
 
400
  t)
 
401
 
 
402
(deftest char-downcase.error.2
 
403
  (signals-error (char-downcase #\A #\A) program-error)
 
404
  t)
 
405
 
 
406
;;;
 
407
 
 
408
(deftest upper-case-p.1
 
409
  (find-if-not #'upper-case-p +standard-chars+ :start 26 :end 52)
 
410
  nil)
 
411
 
 
412
(deftest upper-case-p.2
 
413
  (find-if #'upper-case-p +standard-chars+ :end 26)
 
414
  nil)
 
415
 
 
416
(deftest upper-case-p.3
 
417
  (find #'upper-case-p +standard-chars+ :start 52)
 
418
  nil)
 
419
 
 
420
(deftest upper-case-p.4
 
421
  (char-type-error-check #'upper-case-p)
 
422
  t)
 
423
 
 
424
(deftest upper-case-p.order.1
 
425
  (let ((i 0))
 
426
    (values
 
427
     (upper-case-p (progn (incf i) #\a))
 
428
     i))
 
429
  nil 1)
 
430
 
 
431
(deftest upper-case-p.error.1
 
432
  (signals-error (upper-case-p) program-error)
 
433
  t)
 
434
 
 
435
(deftest upper-case-p.error.2
 
436
  (signals-error (upper-case-p #\a #\A) program-error)
 
437
  t)
 
438
 
 
439
;;;
 
440
 
 
441
(deftest lower-case-p.1
 
442
  (find-if-not #'lower-case-p +standard-chars+ :end 26)
 
443
  nil)
 
444
 
 
445
(deftest lower-case-p.2
 
446
  (find-if #'lower-case-p +standard-chars+ :start 26)
 
447
  nil)
 
448
 
 
449
(deftest lower-case-p.3
 
450
  (char-type-error-check #'lower-case-p)
 
451
  t)
 
452
 
 
453
(deftest lower-case-p.order.1
 
454
  (let ((i 0))
 
455
    (values
 
456
     (lower-case-p (progn (incf i) #\A))
 
457
     i))
 
458
  nil 1)
 
459
 
 
460
(deftest lower-case-p.error.1
 
461
  (signals-error (lower-case-p) program-error)
 
462
  t)
 
463
 
 
464
(deftest lower-case-p.error.2
 
465
  (signals-error (lower-case-p #\a #\a) program-error)
 
466
  t)
 
467
 
 
468
;;;
 
469
 
 
470
(deftest both-case-p.1
 
471
  (both-case-p.1.body)
 
472
  t)
 
473
 
 
474
(deftest both-case-p.2
 
475
  (both-case-p.2.body)
 
476
  t)
 
477
 
 
478
(deftest both-case-p.3
 
479
  (char-type-error-check #'both-case-p)
 
480
  t)
 
481
 
 
482
(deftest both-case-p.order.1
 
483
  (let ((i 0))
 
484
    (values
 
485
     (both-case-p (progn (incf i) #\5))
 
486
     i))
 
487
  nil 1)
 
488
 
 
489
(deftest both-case-p.error.1
 
490
  (signals-error (both-case-p) program-error)
 
491
  t)
 
492
 
 
493
(deftest both-case-p.error.2
 
494
  (signals-error (both-case-p #\a #\a) program-error)
 
495
  t)
 
496
 
 
497
;;;
 
498
 
 
499
(deftest char-code.1
 
500
  (char-type-error-check #'char-code)
 
501
  t)
 
502
 
 
503
(deftest char-code.2
 
504
  (char-code.2.body)
 
505
  t)
 
506
 
 
507
(deftest char-code.order.1
 
508
  (let ((i 0))
 
509
    (values
 
510
     (not (numberp (char-code (progn (incf i) #\a))))
 
511
     i))
 
512
  nil 1)
 
513
 
 
514
(deftest char-code.error.1
 
515
  (signals-error (char-code) program-error)
 
516
  t)
 
517
 
 
518
(deftest char-code.error.2
 
519
  (signals-error (char-code #\a #\a) program-error)
 
520
  t)
 
521
 
 
522
;;;
 
523
 
 
524
(deftest code-char.1
 
525
  (loop for x across +standard-chars+
 
526
        always (eqlt (code-char (char-code x)) x))
 
527
  t)
 
528
 
 
529
(deftest code-char.order.1
 
530
  (let ((i 0))
 
531
    (values
 
532
     (code-char (progn (incf i) (char-code #\a)))
 
533
     i))
 
534
  #\a 1)
 
535
 
 
536
(deftest code-char.error.1
 
537
  (signals-error (code-char) program-error)
 
538
  t)
 
539
 
 
540
(deftest code-char.error.2
 
541
  (signals-error (code-char 1 1) program-error)
 
542
  t)
 
543
 
 
544
;;;
 
545
 
 
546
(deftest char-int.1
 
547
  (loop for x across +standard-chars+
 
548
        always (eqlt (char-int x) (char-code x)))
 
549
  t)
 
550
 
 
551
(deftest char-int.2
 
552
  (char-int.2.fn)
 
553
  t)
 
554
 
 
555
(deftest char-int.order.1
 
556
  (let ((i 0))
 
557
    (values
 
558
     (code-char (char-int (progn (incf i) #\a)))
 
559
     i))
 
560
  #\a 1)
 
561
 
 
562
(deftest char-int.error.1
 
563
  (signals-error (char-int) program-error)
 
564
  t)
 
565
 
 
566
(deftest char-int.error.2
 
567
  (signals-error (char-int #\a #\a) program-error)
 
568
  t)
 
569
 
 
570
;;;
 
571
 
 
572
(deftest char-name.1
 
573
  (char-name.1.fn)
 
574
  t)
 
575
 
 
576
(deftest char-name.2
 
577
  (notnot-mv (string= (char-name #\Space) "Space"))
 
578
  t)
 
579
 
 
580
(deftest char-name.3
 
581
  (notnot-mv (string= (char-name #\Newline) "Newline"))
 
582
  t)
 
583
 
 
584
;;; Check that the names of various semi-standard characters are
 
585
;;; appropriate.  This is complicated by the possibility that two different
 
586
;;; names may refer to the same character (as is allowed by the standard,
 
587
;;; for example in the case of Newline and Linefeed).
 
588
 
 
589
(deftest char-name.4
 
590
  (loop for s in '("Rubout" "Page" "Backspace" "Return" "Tab" "Linefeed")
 
591
        for c = (name-char s)
 
592
        unless (or (not c)
 
593
                   ;; If the char-name is not even string-equal,
 
594
                   ;; assume we're sharing the character with some other
 
595
                   ;; name, and assume it's ok
 
596
                   (not (string-equal (char-name c) s))
 
597
                   (string= (char-name c) s))
 
598
        ;; Collect list of cases that failed
 
599
        collect (list s c (char-name c)))
 
600
  nil)
 
601
 
 
602
(deftest char-name.5
 
603
  (char-type-error-check #'char-name)
 
604
  t)
 
605
 
 
606
(deftest char-name.order.1
 
607
  (let ((i 0))
 
608
    (values
 
609
     (char-name (progn (incf i) #\Space))
 
610
     i))
 
611
  "Space" 1)
 
612
 
 
613
(deftest char-name.error.1
 
614
  (signals-error (char-name) program-error)
 
615
  t)
 
616
 
 
617
(deftest char-name.error.2
 
618
  (signals-error (char-name #\a #\a) program-error)
 
619
  t)
 
620
 
 
621
;;;
 
622
 
 
623
(deftest name-char.1
 
624
  (name-char.1.body)
 
625
  t)
 
626
 
 
627
(deftest name-char.2
 
628
  (loop for s in '("RubOut" "PAGe" "BacKspace" "RetUrn" "Tab" "LineFeed"
 
629
                   "SpaCE" "NewLine")
 
630
        always
 
631
        (let ((c1 (name-char (string-upcase s)))
 
632
              (c2 (name-char (string-downcase s)))
 
633
              (c3 (name-char (string-capitalize s)))
 
634
              (c4 (name-char s)))
 
635
          (and (eqlt c1 c2) (eqlt c2 c3) (eqlt c3 c4))))
 
636
  t)
 
637
 
 
638
(deftest name-char.order.1
 
639
  (let ((i 0))
 
640
    (values
 
641
     (name-char (progn (incf i) "Space"))
 
642
     i))
 
643
  #\Space 1)
 
644
 
 
645
(deftest name-char.error.1
 
646
  (signals-error (name-char) program-error)
 
647
  t)
 
648
 
 
649
(deftest name-char.error.2
 
650
  (signals-error (name-char "space" "space") program-error)
 
651
  t)