readtable-case.lsp 1.99 KB
Newer Older
pfdietz's avatar
pfdietz committed
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sat Jan  1 18:43:46 2005
;;;; Contains: Tests of READTABLE-CASE

(in-package :cl-test)

(deftest readtable-case.1
  (with-standard-io-syntax
   (readtable-case *readtable*))
  :upcase)

(deftest readtable-case.2
  (with-standard-io-syntax
   (let ((rt (copy-readtable)))
     (readtable-case rt)))
  :upcase)

(deftest readtable-case.3
  (let ((rt (copy-readtable)))
    (values
     (setf (readtable-case rt) :upcase)
     (readtable-case rt)))
  :upcase :upcase)

(deftest readtable-case.4
  (let ((rt (copy-readtable)))
    (values
     (setf (readtable-case rt) :downcase)
     (readtable-case rt)))
  :downcase :downcase)

(deftest readtable-case.5
  (let ((rt (copy-readtable)))
    (values
     (setf (readtable-case rt) :preserve)
     (readtable-case rt)))
  :preserve :preserve)

(deftest readtable-case.6
  (let ((rt (copy-readtable)))
    (values
     (setf (readtable-case rt) :invert)
     (readtable-case rt)))
  :invert :invert)

(deftest readtable-case.7
  (let ((rt (copy-readtable)))
    (loop for rtc in '(:upcase :downcase :preserve :invert)
sds's avatar
sds committed
50
51
52
53
          do (setf (readtable-case rt) rtc)
          nconc (let ((rt2 (copy-readtable rt)))
                  (unless (eq (readtable-case rt2) rtc)
                    (list rtc rt2)))))
pfdietz's avatar
pfdietz committed
54
55
56
57
58
59
60
61
62
63
64
65
66
  nil)

;;; Error cases

(deftest readtable-case.error.1
  (signals-error (readtable-case) program-error)
  t)

(deftest readtable-case.error.2
  (signals-error (readtable-case *readtable* nil) program-error)
  t)

(deftest readtable-case.error.3
pfdietz's avatar
pfdietz committed
67
  (check-type-error #'readtable-case (typef 'readtable))
pfdietz's avatar
pfdietz committed
68
69
70
  nil)

(deftest readtable-case.error.4
pfdietz's avatar
pfdietz committed
71
  (check-type-error #'(lambda (x)
sds's avatar
sds committed
72
73
74
                        (let ((rt (copy-readtable)))
                          (setf (readtable-case rt) x)))
                    (typef '(member :upcase :downcase :preserve :invert)))
pfdietz's avatar
pfdietz committed
75
76
77
  nil)

(deftest readtable-case.error.5
pfdietz's avatar
pfdietz committed
78
  (check-type-error #'(lambda (x) (setf (readtable-case x) :upcase))
sds's avatar
sds committed
79
                    (typef 'readtable))
pfdietz's avatar
pfdietz committed
80
  nil)
pfdietz's avatar
pfdietz committed
81