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