source: trunk/source/tests/ansi-tests/destructuring-bind.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: 5.5 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Thu Oct 10 23:25:50 2002
4;;;; Contains: Tests for DESTRUCTURING-BIND
5
6(in-package :cl-test)
7
8;;; See the page for this in section 5.3
9;;; Also, see destructuring lambda lists in section 3.4.5
10
11(deftest destructuring-bind.1
12  (destructuring-bind (x y z) '(a b c) (values x y z))
13  a b c)
14
15(deftest destructuring-bind.2
16  (destructuring-bind (x y &rest z) '(a b c d) (values x y z))
17  a b (c d))
18
19(deftest destructuring-bind.3
20  (destructuring-bind (x y &optional z) '(a b c) (values x y z))
21  a b c)
22
23(deftest destructuring-bind.4
24  (destructuring-bind (x y &optional z) '(a b) (values x y z))
25  a b nil)
26
27(deftest destructuring-bind.5
28  (destructuring-bind (x y &optional (z 'w)) '(a b) (values x y z))
29  a b w)
30
31(deftest destructuring-bind.6
32  (destructuring-bind (x y &optional (z 'w z-p)) '(a b) (values x y z z-p))
33  a b w nil)
34
35(deftest destructuring-bind.7
36  (destructuring-bind (x y &optional (z 'w z-p)) '(a b c) (values x y z (notnot z-p)))
37  a b c t)
38
39(deftest destructuring-bind.7a
40  (destructuring-bind (x y &optional (z x z-p)) '(a b) (values x y z z-p))
41  a b a nil)
42
43(deftest destructuring-bind.8
44  (destructuring-bind (x y &optional z w) '(a b c) (values x y z w))
45  a b c nil)
46
47(deftest destructuring-bind.9
48  (destructuring-bind ((x y)) '((a b)) (values x y))
49  a b)
50
51(deftest destructuring-bind.10
52  (destructuring-bind (&whole w (x y)) '((a b)) (values x y w))
53  a b ((a b)))
54
55(deftest destructuring-bind.11
56  (destructuring-bind ((x . y) . w) '((a b) c) (values x y w))
57  a (b) (c))
58
59(deftest destructuring-bind.12
60  (destructuring-bind (x y &body z) '(a b c d) (values x y z))
61  a b (c d))
62
63(deftest destructuring-bind.12a
64  (destructuring-bind ((x y &body z)) '((a b c d)) (values x y z))
65  a b (c d))
66
67(deftest destructuring-bind.13
68  (destructuring-bind (&whole x y z) '(a b) (values x y z))
69  (a b) a b)
70
71(deftest destructuring-bind.14
72  (destructuring-bind (w (&whole x y z)) '(1 (a b)) (values w x y z))
73  1 (a b) a b)
74
75(deftest destructuring-bind.15
76  (destructuring-bind (&key a b c) '(:a 1) (values a b c))
77  1 nil nil)
78
79(deftest destructuring-bind.16
80  (destructuring-bind (&key a b c) '(:b 1) (values a b c))
81  nil 1 nil)
82
83(deftest destructuring-bind.17
84  (destructuring-bind (&key a b c) '(:c 1) (values a b c))
85  nil nil 1)
86
87(deftest destructuring-bind.17a
88  (destructuring-bind (&key (a 'foo) (b 'bar) c) '(:c 1) (values a b c))
89  foo bar 1)
90
91(deftest destructuring-bind.17c
92  (destructuring-bind (&key (a 'foo a-p) (b a b-p) (c 'zzz c-p)) '(:c 1)
93    (values a b c a-p b-p (notnot c-p)))
94  foo foo 1 nil nil t)
95
96(deftest destructuring-bind.18
97  (destructuring-bind ((&key a b c)) '((:c 1 :b 2)) (values a b c))
98  nil 2 1)
99
100;;; Test that destructuring-bind does not have a tagbody
101(deftest destructuring-bind.19
102  (block nil
103    (tagbody
104     (destructuring-bind (a . b) '(1 2) (go 10) 10 (return 'bad))
105     10
106     (return 'good)))
107  good)
108
109(deftest destructuring-bind.20
110  (destructuring-bind (&whole (a . b) c . d) '(1 . 2) (list a b c d))
111  (1 2 1 2))
112
113(deftest destructuring-bind.21
114  (destructuring-bind
115      (x &rest (y z))
116      '(1 2 3)
117    (values x y z))
118  1 2 3)
119
120(deftest destructuring-bind.22
121  (destructuring-bind (x y &key) '(1 2) (values x y))
122  1 2)
123
124(deftest destructuring-bind.23
125  (destructuring-bind (&rest x &key) '(:allow-other-keys 1) x)
126  (:allow-other-keys 1))
127
128(deftest destructuring-bind.24
129  (destructuring-bind (&rest x &key) nil x)
130  nil)
131
132(deftest destructuring-bind.25
133  (let ((x :bad))
134    (declare (special x))
135    (let ((x :good))
136      (destructuring-bind (y) (list x)
137        (declare (special x))
138        y)))
139  :good)
140
141(deftest destructuring-bind.26
142  (destructuring-bind (x) (list 1))
143  nil)
144
145(deftest destructuring-bind.27
146  (destructuring-bind (x) (list 1)
147    (declare (optimize)))
148  nil)
149
150(deftest destructuring-bind.28
151  (destructuring-bind (x) (list 1)
152    (declare (optimize))
153    (declare))
154  nil)
155
156(deftest destructuring-bind.29
157  (destructuring-bind (x &aux y) '(:foo) (values x y))
158  :foo nil)
159 
160(deftest destructuring-bind.30
161  (destructuring-bind (x &aux (y (list x))) '(:foo) (values x y))
162  :foo (:foo))
163
164;;; Test that explicit calls to macroexpand in subforms
165;;; are done in the correct environment
166
167(deftest destructuring-bind.31
168  (macrolet
169   ((%m (z) z))
170   (destructuring-bind (a b c) (expand-in-current-env (%m '(1 2 3))) (values a b c)))
171  1 2 3)
172
173;;; Error cases
174
175#|
176(deftest destructuring-bind.error.1
177  (signals-error (destructuring-bind (a b c) nil (list a b c))
178                 program-error)
179  t)
180
181(deftest destructuring-bind.error.2
182  (signals-error (destructuring-bind ((a b c)) nil (list a b c))
183                 program-error)
184  t)
185
186(deftest destructuring-bind.error.3
187  (signals-error (destructuring-bind (a b) 'x (list a b))
188                 program-error)
189  t)
190
191(deftest destructuring-bind.error.4
192  (signals-error (destructuring-bind (a . b) 'x (list a b))
193                 program-error)
194  t)
195|#
196
197;;; (deftest destructuring-bind.error.5
198;;;  (signals-error (destructuring-bind) program-error)
199;;;  t)
200;;;
201;;; (deftest destructuring-bind.error.6
202;;;  (signals-error (destructuring-bind x) program-error)
203;;;  t)
204
205(deftest destructuring-bind.error.7
206  (signals-error (funcall (macro-function 'destructuring-bind))
207                 program-error)
208  t)
209
210(deftest destructuring-bind.error.8
211  (signals-error (funcall (macro-function 'destructuring-bind)
212                           '(destructuring-bind (a . b) '(1 2) nil))
213                 program-error)
214  t)
215
216(deftest destructuring-bind.error.9
217  (signals-error (funcall (macro-function 'destructuring-bind)
218                           '(destructuring-bind (a . b) '(1 2) nil)
219                           nil nil)
220                 program-error)
221  t)
Note: See TracBrowser for help on using the repository browser.