10 |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
11 |
;;; member |
;;; member |
12 |
|
|
13 |
(deftest member-1 |
(deftest member.1 |
14 |
(let* ((x (copy-tree '(a b c d e f))) |
(let* ((x (copy-tree '(a b c d e f))) |
15 |
(xcopy (make-scaffold-copy x)) |
(xcopy (make-scaffold-copy x)) |
16 |
(result (member 'c x))) |
(result (member 'c x))) |
17 |
(and |
(and |
18 |
(eqt result (cddr x)) |
(eqt result (cddr x)) |
19 |
(check-scaffold-copy x xcopy))) |
(check-scaffold-copy x xcopy))) |
20 |
t) |
t) |
21 |
|
|
22 |
(deftest member-2 |
(deftest member.2 |
23 |
(let* ((x (copy-tree '(a b c d e f))) |
(let* ((x (copy-tree '(a b c d e f))) |
24 |
(xcopy (make-scaffold-copy x)) |
(xcopy (make-scaffold-copy x)) |
25 |
(result (member 'e x))) |
(result (member 'e x))) |
26 |
(and |
(and |
27 |
(eqt result (cddddr x)) |
(eqt result (cddddr x)) |
28 |
(check-scaffold-copy x xcopy))) |
(check-scaffold-copy x xcopy))) |
29 |
t) |
t) |
30 |
|
|
31 |
(deftest member-3 |
(deftest member.3 |
32 |
(let* ((x (copy-tree '(1 2 3 4 5 6 7))) |
(let* ((x (copy-tree '(1 2 3 4 5 6 7))) |
33 |
(xcopy (make-scaffold-copy x)) |
(xcopy (make-scaffold-copy x)) |
34 |
(result (member 4 x))) |
(result (member 4 x))) |
35 |
(and |
(and |
36 |
(eqt result (cdddr x)) |
(eqt result (cdddr x)) |
37 |
(check-scaffold-copy x xcopy))) |
(check-scaffold-copy x xcopy))) |
38 |
t) |
t) |
39 |
|
|
40 |
(deftest member-4 |
(deftest member.4 |
41 |
(let* ((x (copy-tree '(2 4 6 8 10 12))) |
(let* ((x (copy-tree '(2 4 6 8 10 12))) |
42 |
(xcopy (make-scaffold-copy x)) |
(xcopy (make-scaffold-copy x)) |
43 |
(result (member 9 x :key #'1+))) |
(result (member 9 x :key #'1+))) |
44 |
(and |
(and |
45 |
(eqt result (cdddr x)) |
(eqt result (cdddr x)) |
46 |
(check-scaffold-copy x xcopy))) |
(check-scaffold-copy x xcopy))) |
47 |
t) |
t) |
48 |
|
|
49 |
(deftest member-5 |
(deftest member.5 |
50 |
(let* ((x (copy-tree '((a b) (c d) (e f) (g h)))) |
(let* ((x (copy-tree '((a b) (c d) (e f) (g h)))) |
51 |
(xcopy (make-scaffold-copy x)) |
(xcopy (make-scaffold-copy x)) |
52 |
(result (member '(c d) x :test #'equal))) |
(result (member '(c d) x :test #'equal))) |
53 |
(and |
(and |
54 |
(eqt result (cdr x)) |
(eqt result (cdr x)) |
55 |
(check-scaffold-copy x xcopy))) |
(check-scaffold-copy x xcopy))) |
56 |
t) |
t) |
57 |
|
|
58 |
(deftest member-6 |
(deftest member.6 |
59 |
(let* ((x (copy-tree '((a b) (c d) (e f) (g h)))) |
(let* ((x (copy-tree '((a b) (c d) (e f) (g h)))) |
60 |
(xcopy (make-scaffold-copy x)) |
(xcopy (make-scaffold-copy x)) |
61 |
(result (member 'c x :key #'car))) |
(result (member 'c x :key #'car))) |
62 |
(and |
(and |
63 |
(eqt result (cdr x)) |
(eqt result (cdr x)) |
64 |
(check-scaffold-copy x xcopy))) |
(check-scaffold-copy x xcopy))) |
65 |
t) |
t) |
66 |
|
|
67 |
(deftest member-7 |
(deftest member.7 |
68 |
(let* ((x (copy-tree '((a b) (c d) (e f) (g h)))) |
(let* ((x (copy-tree '((a b) (c d) (e f) (g h)))) |
69 |
(xcopy (make-scaffold-copy x)) |
(xcopy (make-scaffold-copy x)) |
70 |
(result (member 'c x :key #'car :test #'eq))) |
(result (member 'c x :key #'car :test #'eq))) |
71 |
(and |
(and |
72 |
(eqt result (cdr x)) |
(eqt result (cdr x)) |
73 |
(check-scaffold-copy x xcopy))) |
(check-scaffold-copy x xcopy))) |
74 |
t) |
t) |
75 |
|
|
76 |
(deftest member-8 |
(deftest member.8 |
77 |
(let* ((x (copy-tree '((a b) (c d) (e f) (g h)))) |
(let* ((x (copy-tree '((a b) (c d) (e f) (g h)))) |
78 |
(xcopy (make-scaffold-copy x)) |
(xcopy (make-scaffold-copy x)) |
79 |
(result (member 'c x :key #'car :test-not (complement #'eq)))) |
(result (member 'c x :key #'car :test-not (complement #'eq)))) |
80 |
(and |
(and |
81 |
(eqt result (cdr x)) |
(eqt result (cdr x)) |
82 |
(check-scaffold-copy x xcopy))) |
(check-scaffold-copy x xcopy))) |
83 |
t) |
t) |
84 |
|
|
85 |
(deftest member-9 |
(deftest member.9 |
86 |
(let* ((x (copy-tree '((a b) (c d) (e f) (g h)))) |
(let* ((x (copy-tree '((a b) (c d) (e f) (g h)))) |
87 |
(xcopy (make-scaffold-copy x)) |
(xcopy (make-scaffold-copy x)) |
88 |
(result (member 'c x :key #'car :test #'eql))) |
(result (member 'c x :key #'car :test #'eql))) |
89 |
(and |
(and |
90 |
(eqt result (cdr x)) |
(eqt result (cdr x)) |
91 |
(check-scaffold-copy x xcopy))) |
(check-scaffold-copy x xcopy))) |
92 |
t) |
t) |
93 |
|
|
94 |
(deftest member-10 |
(deftest member.10 |
95 |
(let* ((x (copy-tree '((a b) (c d) (e f) (g h)))) |
(let* ((x (copy-tree '((a b) (c d) (e f) (g h)))) |
96 |
(xcopy (make-scaffold-copy x)) |
(xcopy (make-scaffold-copy x)) |
97 |
(result (member (list 'd) x :key #'cdr :test #'equal))) |
(result (member (list 'd) x :key #'cdr :test #'equal))) |
98 |
(and |
(and |
99 |
(eqt result (cdr x)) |
(eqt result (cdr x)) |
100 |
(check-scaffold-copy x xcopy))) |
(check-scaffold-copy x xcopy))) |
101 |
t) |
t) |
102 |
|
|
103 |
(deftest member-11 |
(deftest member.11 |
104 |
(member (copy-seq "cc") (copy-tree '("aa" "bb" "cc" "dd" "ee"))) |
(member (copy-seq "cc") (copy-tree '("aa" "bb" "cc" "dd" "ee"))) |
105 |
nil) |
nil) |
106 |
|
|
107 |
(deftest member-12 |
(deftest member.12 |
108 |
(member 1 (copy-tree '(3 4 1 31 423))) |
(member 1 (copy-tree '(3 4 1 31 423))) |
109 |
(1 31 423)) |
(1 31 423)) |
110 |
|
|
111 |
(deftest member-13 |
(deftest member.13 |
112 |
(member (copy-seq "cc") (copy-tree '("aa" "bb" "cc" "dd" "ee")) |
(member (copy-seq "cc") (copy-tree '("aa" "bb" "cc" "dd" "ee")) |
113 |
:test #'equal) |
:test #'equal) |
114 |
("cc" "dd" "ee")) |
("cc" "dd" "ee")) |
115 |
|
|
116 |
(deftest member-14 |
(deftest member.14 |
117 |
(member 'a nil) |
(member 'a nil) |
118 |
nil) |
nil) |
119 |
|
|
120 |
(deftest member-15 |
(deftest member.15 |
121 |
(member nil nil) |
(member nil nil) |
122 |
nil) |
nil) |
123 |
|
|
124 |
(deftest member-16 |
(deftest member.16 |
125 |
(member nil nil :test #'equal) |
(member nil nil :test #'equal) |
126 |
nil) |
nil) |
127 |
|
|
128 |
(deftest member-16-a |
(deftest member.16-a |
129 |
(member nil nil :test #'(lambda (x y) (error "Should not call this function"))) |
(member nil nil :test #'(lambda (x y) (error "Should not call this function"))) |
130 |
nil) |
nil) |
131 |
|
|
132 |
(deftest member-17 |
(deftest member.17 |
133 |
(member 'a nil :test #'(lambda (x y) (error "Should not call this function"))) |
(member 'a nil :test #'(lambda (x y) (error "Should not call this function"))) |
134 |
nil) |
nil) |
135 |
|
|
136 |
;; Check that a null key argument is ignored |
;; Check that a null key argument is ignored |
137 |
|
|
138 |
(deftest member-18 |
(deftest member.18 |
139 |
(member 'a '(c d a b e) :key nil) |
(member 'a '(c d a b e) :key nil) |
140 |
(a b e)) |
(a b e)) |
141 |
|
|
142 |
(deftest member-19 |
(deftest member.19 |
143 |
(member 'z '(a b c d) :key nil) |
(member 'z '(a b c d) :key nil) |
144 |
nil) |
nil) |
145 |
|
|
146 |
|
;;; Order of evaluation |
147 |
|
|
148 |
|
(deftest member.20 |
149 |
|
(let ((i 0) x y) |
150 |
|
(values |
151 |
|
(member (progn (setf x (incf i)) 'c) |
152 |
|
(progn (setf y (incf i)) '(a b c d))) |
153 |
|
i x y)) |
154 |
|
(c d) 2 1 2) |
155 |
|
|
156 |
|
(deftest member.21 |
157 |
|
(let ((i 0) x y z p) |
158 |
|
(values |
159 |
|
(member (progn (setf x (incf i)) 'c) |
160 |
|
(progn (setf y (incf i)) '(a b c d)) |
161 |
|
:key (progn (setf z (incf i)) #'identity) |
162 |
|
:test (progn (setf p (incf i)) #'eq)) |
163 |
|
i x y z p)) |
164 |
|
(c d) 4 1 2 3 4) |
165 |
|
|
166 |
|
(deftest member.22 |
167 |
|
(let ((i 0) x y) |
168 |
|
(values |
169 |
|
(member (progn (setf x (incf i)) 'c) |
170 |
|
(progn (setf y (incf i)) '(a b c d)) |
171 |
|
:test #'eq) |
172 |
|
i x y)) |
173 |
|
(c d) 2 1 2) |
174 |
|
|
175 |
|
(deftest member.23 |
176 |
|
(let ((i 0) x y z p q) |
177 |
|
(values |
178 |
|
(member (progn (setf x (incf i)) 'c) |
179 |
|
(progn (setf y (incf i)) '(a b c d)) |
180 |
|
:key (progn (setf z (incf i)) #'identity) |
181 |
|
:test (progn (setf p (incf i)) #'eq) |
182 |
|
:key (progn (setf q (incf i)) (constantly 'z))) |
183 |
|
i x y z p q)) |
184 |
|
(c d) 5 1 2 3 4 5) |
185 |
|
|
186 |
|
(deftest member.24 |
187 |
|
(let ((i 0) x y z q) |
188 |
|
(values |
189 |
|
(member (progn (setf x (incf i)) 'c) |
190 |
|
(progn (setf y (incf i)) '(a b c d)) |
191 |
|
:test #'eq |
192 |
|
:key (progn (setf z (incf i)) #'identity) |
193 |
|
:key (progn (setf q (incf i)) (constantly 'z))) |
194 |
|
i x y z q)) |
195 |
|
(c d) 4 1 2 3 4) |
196 |
|
|
197 |
|
|
198 |
;;; Keyword tests |
;;; Keyword tests |
199 |
|
|
200 |
(deftest member.allow-other-keys.1 |
(deftest member.allow-other-keys.1 |