destructuring-bind.lsp 5.64 KB
Newer Older
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
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Thu Oct 10 23:25:50 2002
;;;; Contains: Tests for DESTRUCTURING-BIND

(in-package :cl-test)

;;; See the page for this in section 5.3
;;; Also, see destructuring lambda lists in section 3.4.5

(deftest destructuring-bind.1
  (destructuring-bind (x y z) '(a b c) (values x y z))
  a b c)

(deftest destructuring-bind.2
  (destructuring-bind (x y &rest z) '(a b c d) (values x y z))
  a b (c d))

(deftest destructuring-bind.3
  (destructuring-bind (x y &optional z) '(a b c) (values x y z))
  a b c)

(deftest destructuring-bind.4
  (destructuring-bind (x y &optional z) '(a b) (values x y z))
  a b nil)

(deftest destructuring-bind.5
  (destructuring-bind (x y &optional (z 'w)) '(a b) (values x y z))
  a b w)

(deftest destructuring-bind.6
  (destructuring-bind (x y &optional (z 'w z-p)) '(a b) (values x y z z-p))
  a b w nil)

(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 38
  a b c t)

39 40 41 42
(deftest destructuring-bind.7a
  (destructuring-bind (x y &optional (z x z-p)) '(a b) (values x y z z-p))
  a b a nil)

43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62
(deftest destructuring-bind.8
  (destructuring-bind (x y &optional z w) '(a b c) (values x y z w))
  a b c nil)

(deftest destructuring-bind.9
  (destructuring-bind ((x y)) '((a b)) (values x y))
  a b)

(deftest destructuring-bind.10
  (destructuring-bind (&whole w (x y)) '((a b)) (values x y w))
  a b ((a b)))

(deftest destructuring-bind.11
  (destructuring-bind ((x . y) . w) '((a b) c) (values x y w))
  a (b) (c))

(deftest destructuring-bind.12
  (destructuring-bind (x y &body z) '(a b c d) (values x y z))
  a b (c d))

63 64 65 66
(deftest destructuring-bind.12a
  (destructuring-bind ((x y &body z)) '((a b c d)) (values x y z))
  a b (c d))

67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86
(deftest destructuring-bind.13
  (destructuring-bind (&whole x y z) '(a b) (values x y z))
  (a b) a b)

(deftest destructuring-bind.14
  (destructuring-bind (w (&whole x y z)) '(1 (a b)) (values w x y z))
  1 (a b) a b)

(deftest destructuring-bind.15
  (destructuring-bind (&key a b c) '(:a 1) (values a b c))
  1 nil nil)

(deftest destructuring-bind.16
  (destructuring-bind (&key a b c) '(:b 1) (values a b c))
  nil 1 nil)

(deftest destructuring-bind.17
  (destructuring-bind (&key a b c) '(:c 1) (values a b c))
  nil nil 1)

87 88 89 90 91 92 93 94 95
(deftest destructuring-bind.17a
  (destructuring-bind (&key (a 'foo) (b 'bar) c) '(:c 1) (values a b c))
  foo bar 1)

(deftest destructuring-bind.17c
  (destructuring-bind (&key (a 'foo a-p) (b a b-p) (c 'zzz c-p)) '(:c 1)
    (values a b c a-p b-p (notnot c-p)))
  foo foo 1 nil nil t)

96 97 98 99
(deftest destructuring-bind.18
  (destructuring-bind ((&key a b c)) '((:c 1 :b 2)) (values a b c))
  nil 2 1)

100 101 102 103 104 105 106 107 108
;;; Test that destructuring-bind does not have a tagbody
(deftest destructuring-bind.19
  (block nil
    (tagbody
     (destructuring-bind (a . b) '(1 2) (go 10) 10 (return 'bad))
     10
     (return 'good)))
  good)

109 110 111 112 113 114 115 116 117 118 119
(deftest destructuring-bind.20
  (destructuring-bind (&whole (a . b) c . d) '(1 . 2) (list a b c d))
  (1 2 1 2))

(deftest destructuring-bind.21
  (destructuring-bind
      (x &rest (y z))
      '(1 2 3)
    (values x y z))
  1 2 3)

120
(deftest destructuring-bind.22
pfdietz's avatar
pfdietz committed
121 122
  (destructuring-bind (x y &key) '(1 2) (values x y))
  1 2)
123 124

(deftest destructuring-bind.23
125 126
  (destructuring-bind (&rest x &key) '(:allow-other-keys 1) x)
  (:allow-other-keys 1))
127

pfdietz's avatar
pfdietz committed
128 129 130 131
(deftest destructuring-bind.24
  (destructuring-bind (&rest x &key) nil x)
  nil)

pfdietz's avatar
pfdietz committed
132 133 134 135 136
(deftest destructuring-bind.25
  (let ((x :bad))
    (declare (special x))
    (let ((x :good))
      (destructuring-bind (y) (list x)
sds's avatar
sds committed
137 138
        (declare (special x))
        y)))
pfdietz's avatar
pfdietz committed
139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155
  :good)

(deftest destructuring-bind.26
  (destructuring-bind (x) (list 1))
  nil)

(deftest destructuring-bind.27
  (destructuring-bind (x) (list 1)
    (declare (optimize)))
  nil)

(deftest destructuring-bind.28
  (destructuring-bind (x) (list 1)
    (declare (optimize))
    (declare))
  nil)

156 157 158
(deftest destructuring-bind.29
  (destructuring-bind (x &aux y) '(:foo) (values x y))
  :foo nil)
sds's avatar
sds committed
159

160 161 162 163
(deftest destructuring-bind.30
  (destructuring-bind (x &aux (y (list x))) '(:foo) (values x y))
  :foo (:foo))

164 165 166 167 168 169 170 171 172
;;; Test that explicit calls to macroexpand in subforms
;;; are done in the correct environment

(deftest destructuring-bind.31
  (macrolet
   ((%m (z) z))
   (destructuring-bind (a b c) (expand-in-current-env (%m '(1 2 3))) (values a b c)))
  1 2 3)

173
;;; Error cases
174

175
#|
176
(deftest destructuring-bind.error.1
177
  (signals-error (destructuring-bind (a b c) nil (list a b c))
sds's avatar
sds committed
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))
sds's avatar
sds committed
183
                 program-error)
184
  t)
185

186
(deftest destructuring-bind.error.3
187
  (signals-error (destructuring-bind (a b) 'x (list a b))
sds's avatar
sds committed
188
                 program-error)
189
  t)
190

191
(deftest destructuring-bind.error.4
192
  (signals-error (destructuring-bind (a . b) 'x (list a b))
sds's avatar
sds committed
193
                 program-error)
194
  t)
195
|#
196

197
;;; (deftest destructuring-bind.error.5
198 199
;;;  (signals-error (destructuring-bind) program-error)
;;;  t)
200 201
;;;
;;; (deftest destructuring-bind.error.6
202 203
;;;  (signals-error (destructuring-bind x) program-error)
;;;  t)
204

205
(deftest destructuring-bind.error.7
206
  (signals-error (funcall (macro-function 'destructuring-bind))
sds's avatar
sds committed
207
                 program-error)
208
  t)
209 210

(deftest destructuring-bind.error.8
211
  (signals-error (funcall (macro-function 'destructuring-bind)
sds's avatar
sds committed
212 213
                           '(destructuring-bind (a . b) '(1 2) nil))
                 program-error)
214
  t)
215 216

(deftest destructuring-bind.error.9
217
  (signals-error (funcall (macro-function 'destructuring-bind)
sds's avatar
sds committed
218 219 220
                           '(destructuring-bind (a . b) '(1 2) nil)
                           nil nil)
                 program-error)
221
  t)