member.lsp 6.94 KB
Newer Older
1 2 3
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sat Mar 28 07:38:57 1998
4
;;;; Contains: Tests of MEMBER
5

6

7

8

9

10 11
(deftest member.1
  (let* ((x (copy-tree '(a b c d e f)))
sds's avatar
sds committed
12 13
         (xcopy (make-scaffold-copy x))
         (result (member 'c x)))
14 15 16
    (and
     (eqt result (cddr x))
     (check-scaffold-copy x xcopy)))
17 18
  t)

19 20
(deftest member.2
  (let* ((x (copy-tree '(a b c d e f)))
sds's avatar
sds committed
21 22
         (xcopy (make-scaffold-copy x))
         (result (member 'e x)))
23 24 25
    (and
     (eqt result (cddddr x))
     (check-scaffold-copy x xcopy)))
26 27
  t)

28 29
(deftest member.3
  (let* ((x (copy-tree '(1 2 3 4 5 6 7)))
sds's avatar
sds committed
30 31
         (xcopy (make-scaffold-copy x))
         (result (member 4 x)))
32 33 34
    (and
     (eqt result (cdddr x))
     (check-scaffold-copy x xcopy)))
35 36
  t)

37 38
(deftest member.4
  (let* ((x (copy-tree '(2 4 6 8 10 12)))
sds's avatar
sds committed
39 40
         (xcopy (make-scaffold-copy x))
         (result (member 9 x :key #'1+)))
41 42 43
    (and
     (eqt result (cdddr x))
     (check-scaffold-copy x xcopy)))
44 45
  t)

46 47
(deftest member.5
  (let* ((x (copy-tree '((a b) (c d) (e f) (g h))))
sds's avatar
sds committed
48 49
         (xcopy (make-scaffold-copy x))
         (result (member '(c d) x :test #'equal)))
50 51 52
    (and
     (eqt result (cdr x))
     (check-scaffold-copy x xcopy)))
53 54
  t)

55 56
(deftest member.6
  (let* ((x (copy-tree '((a b) (c d) (e f) (g h))))
sds's avatar
sds committed
57 58
         (xcopy (make-scaffold-copy x))
         (result (member 'c x :key #'car)))
59 60 61
    (and
     (eqt result (cdr x))
     (check-scaffold-copy x xcopy)))
62 63
  t)

64 65
(deftest member.7
  (let* ((x (copy-tree '((a b) (c d) (e f) (g h))))
sds's avatar
sds committed
66 67
         (xcopy (make-scaffold-copy x))
         (result (member 'c x :key #'car :test #'eq)))
68 69 70
    (and
     (eqt result (cdr x))
     (check-scaffold-copy x xcopy)))
71 72
  t)

73 74
(deftest member.8
  (let* ((x (copy-tree '((a b) (c d) (e f) (g h))))
sds's avatar
sds committed
75 76
         (xcopy (make-scaffold-copy x))
         (result (member 'c x :key #'car :test-not (complement #'eq))))
77 78 79
    (and
     (eqt result (cdr x))
     (check-scaffold-copy x xcopy)))
80 81
  t)

82 83
(deftest member.9
  (let* ((x (copy-tree '((a b) (c d) (e f) (g h))))
sds's avatar
sds committed
84 85
         (xcopy (make-scaffold-copy x))
         (result (member 'c x :key #'car :test #'eql)))
86 87 88
    (and
     (eqt result (cdr x))
     (check-scaffold-copy x xcopy)))
89 90
  t)

91 92
(deftest member.10
  (let* ((x (copy-tree '((a b) (c d) (e f) (g h))))
sds's avatar
sds committed
93 94
         (xcopy (make-scaffold-copy x))
         (result (member (list 'd) x :key #'cdr :test #'equal)))
95 96 97
    (and
     (eqt result (cdr x))
     (check-scaffold-copy x xcopy)))
98 99
  t)

100 101
(deftest member.11
  (member (copy-seq "cc") (copy-tree '("aa" "bb" "cc" "dd" "ee")))
102 103
  nil)

104 105
(deftest member.12
  (member 1 (copy-tree '(3 4 1 31 423)))
106 107
  (1 31 423))

108 109
(deftest member.13
  (member (copy-seq "cc") (copy-tree '("aa" "bb" "cc" "dd" "ee"))
sds's avatar
sds committed
110
          :test #'equal)
111 112
  ("cc" "dd" "ee"))

113
(deftest member.14
114 115 116
  (member 'a nil)
  nil)

117
(deftest member.15
118 119 120
  (member nil nil)
  nil)

121
(deftest member.16
122 123 124
  (member nil nil :test #'equal)
  nil)

125
(deftest member.16-a
126 127 128
  (member nil nil :test #'(lambda (x y) (error "Should not call this function")))
  nil)

129
(deftest member.17
130 131 132
  (member 'a nil :test #'(lambda (x y) (error "Should not call this function")))
  nil)

133 134
;; Check that a null key argument is ignored

135
(deftest member.18
136 137 138
  (member 'a '(c d a b e) :key nil)
  (a b e))

139
(deftest member.19
140 141 142
  (member 'z '(a b c d) :key nil)
  nil)

143 144 145 146 147 148 149 150
(deftest member.20
  (member 10 '(1 2 3 4 10 11 14 18) :test #'<)
  (11 14 18))

(deftest member.21
  (member 10 '(1 2 3 4 10 11 14 18) :test-not #'>=)
  (11 14 18))

151 152 153 154 155 156
(defharmless member.test-and-test-not.1
  (member 'b '(a b c) :test #'eql :test-not #'eql))

(defharmless member.test-and-test-not.2
  (member 'b '(a b c) :test-not #'eql :test #'eql))

157 158
;;; Order of evaluation

159
(deftest member.order.1
160 161 162
  (let ((i 0) x y)
    (values
     (member (progn (setf x (incf i)) 'c)
sds's avatar
sds committed
163
             (progn (setf y (incf i)) '(a b c d)))
164 165 166
     i x y))
  (c d) 2 1 2)

167
(deftest member.order.2
168 169 170
  (let ((i 0) x y z p)
    (values
     (member (progn (setf x (incf i)) 'c)
sds's avatar
sds committed
171 172 173
             (progn (setf y (incf i)) '(a b c d))
             :key (progn (setf z (incf i)) #'identity)
             :test (progn (setf p (incf i)) #'eq))
174 175 176
     i x y z p))
  (c d) 4 1 2 3 4)

177
(deftest member.order.3
178 179 180
  (let ((i 0) x y)
    (values
     (member (progn (setf x (incf i)) 'c)
sds's avatar
sds committed
181 182
             (progn (setf y (incf i)) '(a b c d))
             :test #'eq)
183 184 185
     i x y))
  (c d) 2 1 2)

186
(deftest member.order.4
187 188 189
  (let ((i 0) x y z p q)
    (values
     (member (progn (setf x (incf i)) 'c)
sds's avatar
sds committed
190 191 192 193
             (progn (setf y (incf i)) '(a b c d))
             :key (progn (setf z (incf i)) #'identity)
             :test (progn (setf p (incf i)) #'eq)
             :key (progn (setf q (incf i)) (constantly 'z)))
194 195 196
     i x y z p q))
  (c d) 5 1 2 3 4 5)

197
(deftest member.order.5
198 199 200
  (let ((i 0) x y z q)
    (values
     (member (progn (setf x (incf i)) 'c)
sds's avatar
sds committed
201 202 203 204
             (progn (setf y (incf i)) '(a b c d))
             :test #'eq
             :key (progn (setf z (incf i)) #'identity)
             :key (progn (setf q (incf i)) (constantly 'z)))
205 206 207 208
     i x y z q))
  (c d) 4 1 2 3 4)


209 210 211
;;; Keyword tests

(deftest member.allow-other-keys.1
212 213 214
  (member 'b '(a b c) :bad t :allow-other-keys t)
  (b c))

215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231
(deftest member.allow-other-keys.2
  (member 'b '(a b c) :allow-other-keys t :bad t)
  (b c))

(deftest member.allow-other-keys.3
  (member 'b '(a b c) :allow-other-keys t)
  (b c))

(deftest member.allow-other-keys.4
  (member 'b '(a b c) :allow-other-keys nil)
  (b c))

(deftest member.allow-other-keys.5
  (member 'b '(a b c) :allow-other-keys 17 :allow-other-keys nil '#:x t)
  (b c))

(deftest member.keywords.6
232 233 234 235 236 237
  (member 'b '(a b c) :test #'eq :test (complement #'eq))
  (b c))

;;; Error cases

(deftest member.error.1
pfdietz's avatar
pfdietz committed
238 239
  (check-type-error #'(lambda (x) (member 'a x)) #'listp)
  nil)
240

241
(deftest member.error.2
242 243
  (signals-error (member 'a 1.3) type-error)
  t)
244

245
(deftest member.error.3
246 247
  (signals-error (member 'a 1) type-error)
  t)
248

249
(deftest member.error.4
250 251
  (signals-error (member 'a 0) type-error)
  t)
252

253
(deftest member.error.5
254 255
  (signals-error (member 'a "abcde") type-error)
  t)
256

257
(deftest member.error.6
258 259
  (signals-error (member 'a #\w) type-error)
  t)
260

261
(deftest member.error.7
262 263
  (signals-error (member 'a t) type-error)
  t)
264

265
(deftest member.error.8
266 267
  (signals-error (member) program-error)
  t)
268

269
(deftest member.error.9
270 271
  (signals-error (member nil) program-error)
  t)
272

273
(deftest member.error.10
274 275
  (signals-error (member nil nil :bad t) program-error)
  t)
276 277

(deftest member.error.11
278 279
  (signals-error (member nil nil :test) program-error)
  t)
280 281

(deftest member.error.12
282
  (signals-error (member nil nil :bad t :allow-other-keys nil)
sds's avatar
sds committed
283
                 program-error)
284
  t)
285 286

(deftest member.error.13
287 288
  (signals-error (member nil nil nil) program-error)
  t)
289 290

(deftest member.error.14
291 292
  (signals-error (locally (member 'a t) t) type-error)
  t)
293 294

(deftest member.error.15
295 296
  (signals-error (member 'a '(a b c) :test #'identity) program-error)
  t)
297 298

(deftest member.error.16
299 300
  (signals-error (member 'a '(a b c) :test-not #'identity) program-error)
  t)
301 302

(deftest member.error.17
303 304
  (signals-error (member 'a '(a b c) :key #'cons) program-error)
  t)