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

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

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

File size: 3.7 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Fri Oct 18 21:06:45 2002
4;;;; Contains: Tests of CCASE
5
6(in-package :cl-test)
7
8(deftest ccase.1
9  (let ((x 'b))
10    (ccase x (a 1) (b 2) (c 3)))
11  2)
12
13(deftest ccase.2
14  (signals-type-error x 1 (ccase x))
15  t)
16
17(deftest ccase.3
18  (signals-type-error x 1 (ccase x (a 1) (b 2) (c 3)))
19  t)
20
21;;; It is legal to use T or OTHERWISE as key designators
22;;; in CCASE forms.  They have no special meaning here.
23
24(deftest ccase.4
25  (signals-type-error x 1 (ccase x (t nil)))
26  t)
27
28(deftest ccase.5
29  (signals-type-error x 1 (ccase x (otherwise nil)))
30  t)
31
32(deftest ccase.6
33  (let ((x 'b))
34    (ccase x ((a z) 1) ((y b w) 2) ((b c) 3)))
35  2)
36
37(deftest ccase.7
38  (let ((x 'z))
39    (ccase x
40           ((a b c) 1)
41           ((d e) 2)
42           ((f z g) 3)))
43  3)
44
45(deftest ccase.8
46  (let ((x (1+ most-positive-fixnum)))
47    (ccase x (#.(1+ most-positive-fixnum) 'a)))
48  a)
49
50(deftest ccase.9
51  (signals-type-error x nil (ccase x (nil 'a)))
52  t)
53
54(deftest ccase.10
55  (let (x)
56    (ccase x ((nil) 'a)))
57  a)
58
59(deftest ccase.11
60  (let ((x 'a))
61    (ccase x (b 0) (a (values 1 2 3)) (c nil)))
62  1 2 3)
63
64(deftest ccase.12
65  (signals-type-error x t (ccase x (a 10)))
66  t)
67
68(deftest ccase.13
69  (let ((x t))
70    (ccase x ((t) 10) (t 20)))
71  10)
72
73(deftest ccase.14
74  (let ((x (list 'a 'b)))
75    (eval `(let ((y (quote ,x))) (ccase y ((,x) 1) (a 2)))))
76  1)
77
78(deftest ccase.15
79  (signals-type-error x 'otherwise (ccase x ((t) 10)))
80  t)
81
82(deftest ccase.16
83  (signals-type-error x t (ccase x ((otherwise) 10)))
84  t)
85
86(deftest ccase.17
87  (signals-type-error x 'a (ccase x (b 0) (c 1) (otherwise 2)))
88  t)
89
90(deftest ccase.19
91  (signals-type-error x 'a (ccase x (b 0) (c 1) ((t) 2)))
92  t)
93
94(deftest ccase.20
95  (let ((x #\a))
96    (ccase x
97           ((#\b #\c) 10)
98           ((#\d #\e #\A) 20)
99           (() 30)
100           ((#\z #\a #\y) 40)))
101  40)
102
103(deftest ccase.21 (let ((x 1)) (ccase x (1 (values)) (2 'a))))
104
105(deftest ccase.23 (let ((x 1)) (ccase x (1 (values 'a 'b 'c))))
106  a b c)
107
108;;; Show that the key expression is evaluated only once.
109(deftest ccase.25
110  (let ((a (vector 'a 'b 'c 'd 'e))
111        (i 1))
112    (values
113     (ccase (aref a (incf i))
114       (a 1)
115       (b 2)
116       (c 3)
117       (d 4))
118     i))
119  3 2)
120
121;;; Repeated keys are allowed (all but the first are ignored)
122
123(deftest ccase.26
124  (let ((x 'b))
125    (ccase x ((a b c) 10) (b 20)))
126  10)
127
128(deftest ccase.27
129  (let ((x 'b))
130    (ccase x (b 20) ((a b c) 10)))
131  20)
132
133(deftest ccase.28
134  (let ((x 'b))
135    (ccase x (b 20) (b 10) (d 0)))
136  20)
137
138;;; There are implicit progns
139
140(deftest ccase.29
141  (let ((x nil) (y 2))
142    (values
143     (ccase y
144       (1 (setq x 'a) 'w)
145       (2 (setq x 'b) 'y)
146       (3 (setq x 'c) 'z))
147     x))
148  y b)
149
150(deftest ccase.30
151  (let ((x 'a))
152    (ccase x (a)))
153  nil)
154
155(deftest ccase.31
156  (handler-bind
157   ((type-error #'(lambda (c) (store-value 7 c))))
158   (let ((x 0))
159     (ccase x
160      (1 :bad)
161      (7 :good)
162      (2 nil))))
163  :good)
164
165;;; No implicit tagbody
166(deftest ccase.32
167  (block done
168    (tagbody
169     (let ((x 'a))
170       (ccase x (a (go 10)
171                   10
172                   (return-from done 'bad))))
173     10
174     (return-from done 'good)))
175  good)
176
177;;; Test that explicit calls to macroexpand in subforms
178;;; are done in the correct environment
179
180(deftest ccase.33
181  (let ((x :b))
182    (macrolet
183     ((%m (z) z))
184     (ccase (expand-in-current-env (%m x))
185            (:a :bad1)
186            (:b :good)
187            (:c :bad2))))
188  :good)
189
190
191
192;;; (deftest ccase.error.1
193;;;  (signals-error (ccase) program-error)
194;;;  t)
195
196(deftest ccase.error.1
197  (signals-error (funcall (macro-function 'ccase))
198                 program-error)
199  t)
200
201(deftest ccase.error.2
202  (signals-error (funcall (macro-function 'ccase) '(ccase t))
203                 program-error)
204  t)
205
206(deftest ccase.error.3
207  (signals-error (funcall (macro-function 'ccase) '(ccase t) nil nil)
208                 program-error)
209  t)
Note: See TracBrowser for help on using the repository browser.