← Back to branch summary

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

« back to all changes in this revision

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