1 ;;; Test handling of cyclic and dotted lists -*- lexical-binding: t; -*-
3 ;; Copyright 2017 Free Software Foundation, Inc.
5 ;; Written by Paul Eggert
7 ;; This program is free software; you can redistribute it and/or modify
8 ;; it under the terms of the GNU General Public License as published by
9 ;; the Free Software Foundation, either version 3 of the License, or
10 ;; (at your option) any later version.
12 ;; This program is distributed in the hope that it will be useful,
13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 ;; GNU General Public License for more details.
17 ;; You should have received a copy of the GNU General Public License
18 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
23 (let ((ls (make-list 10 a
)))
27 (let ((ls1 (make-list 10 a
))
28 (ls2 (make-list 1000 b
)))
34 (let ((ls (make-list 10 a
)))
38 (let ((ls1 (make-list 10 a
))
39 (ls2 (make-list 10 b
)))
44 (ert-deftest test-cycle-length
()
45 (should-error (length (cyc1 1)) :type
'circular-list
)
46 (should-error (length (cyc2 1 2)) :type
'circular-list
)
47 (should-error (length (dot1 1)) :type
'wrong-type-argument
)
48 (should-error (length (dot2 1 2)) :type
'wrong-type-argument
))
50 (ert-deftest test-cycle-safe-length
()
51 (should (<= 10 (safe-length (cyc1 1))))
52 (should (<= 1010 (safe-length (cyc2 1 2))))
53 (should (= 10 (safe-length (dot1 1))))
54 (should (= 20 (safe-length (dot2 1 2)))))
56 (ert-deftest test-cycle-member
()
61 (should (member 1 c1
))
62 (should (member 1 c2
))
63 (should (member 1 d1
))
64 (should (member 1 d2
))
65 (should-error (member 2 c1
) :type
'circular-list
)
66 (should (member 2 c2
))
67 (should-error (member 2 d1
) :type
'wrong-type-argument
)
68 (should (member 2 d2
))
69 (should-error (member 3 c1
) :type
'circular-list
)
70 (should-error (member 3 c2
) :type
'circular-list
)
71 (should-error (member 3 d1
) :type
'wrong-type-argument
)
72 (should-error (member 3 d2
) :type
'wrong-type-argument
)))
74 (ert-deftest test-cycle-memq
()
83 (should-error (memq 2 c1
) :type
'circular-list
)
85 (should-error (memq 2 d1
) :type
'wrong-type-argument
)
87 (should-error (memq 3 c1
) :type
'circular-list
)
88 (should-error (memq 3 c2
) :type
'circular-list
)
89 (should-error (memq 3 d1
) :type
'wrong-type-argument
)
90 (should-error (memq 3 d2
) :type
'wrong-type-argument
)))
92 (ert-deftest test-cycle-memql
()
100 (should (memql 1 d2
))
101 (should-error (memql 2 c1
) :type
'circular-list
)
102 (should (memql 2 c2
))
103 (should-error (memql 2 d1
) :type
'wrong-type-argument
)
104 (should (memql 2 d2
))
105 (should-error (memql 3 c1
) :type
'circular-list
)
106 (should-error (memql 3 c2
) :type
'circular-list
)
107 (should-error (memql 3 d1
) :type
'wrong-type-argument
)
108 (should-error (memql 3 d2
) :type
'wrong-type-argument
)))
110 (ert-deftest test-cycle-assq
()
111 (let ((c1 (cyc1 '(1)))
112 (c2 (cyc2 '(1) '(2)))
114 (d2 (dot2 '(1) '(2))))
119 (should-error (assq 2 c1
) :type
'circular-list
)
121 (should-error (assq 2 d1
) :type
'wrong-type-argument
)
123 (should-error (assq 3 c1
) :type
'circular-list
)
124 (should-error (assq 3 c2
) :type
'circular-list
)
125 (should-error (assq 3 d1
) :type
'wrong-type-argument
)
126 (should-error (assq 3 d2
) :type
'wrong-type-argument
)))
128 (ert-deftest test-cycle-assoc
()
129 (let ((c1 (cyc1 '(1)))
130 (c2 (cyc2 '(1) '(2)))
132 (d2 (dot2 '(1) '(2))))
133 (should (assoc 1 c1
))
134 (should (assoc 1 c2
))
135 (should (assoc 1 d1
))
136 (should (assoc 1 d2
))
137 (should-error (assoc 2 c1
) :type
'circular-list
)
138 (should (assoc 2 c2
))
139 (should-error (assoc 2 d1
) :type
'wrong-type-argument
)
140 (should (assoc 2 d2
))
141 (should-error (assoc 3 c1
) :type
'circular-list
)
142 (should-error (assoc 3 c2
) :type
'circular-list
)
143 (should-error (assoc 3 d1
) :type
'wrong-type-argument
)
144 (should-error (assoc 3 d2
) :type
'wrong-type-argument
)))
146 (ert-deftest test-cycle-rassq
()
147 (let ((c1 (cyc1 '(0 .
1)))
148 (c2 (cyc2 '(0 .
1) '(0 .
2)))
150 (d2 (dot2 '(0 .
1) '(0 .
2))))
151 (should (rassq 1 c1
))
152 (should (rassq 1 c2
))
153 (should (rassq 1 d1
))
154 (should (rassq 1 d2
))
155 (should-error (rassq 2 c1
) :type
'circular-list
)
156 (should (rassq 2 c2
))
157 (should-error (rassq 2 d1
) :type
'wrong-type-argument
)
158 (should (rassq 2 d2
))
159 (should-error (rassq 3 c1
) :type
'circular-list
)
160 (should-error (rassq 3 c2
) :type
'circular-list
)
161 (should-error (rassq 3 d1
) :type
'wrong-type-argument
)
162 (should-error (rassq 3 d2
) :type
'wrong-type-argument
)))
164 (ert-deftest test-cycle-rassoc
()
165 (let ((c1 (cyc1 '(0 .
1)))
166 (c2 (cyc2 '(0 .
1) '(0 .
2)))
168 (d2 (dot2 '(0 .
1) '(0 .
2))))
169 (should (rassoc 1 c1
))
170 (should (rassoc 1 c2
))
171 (should (rassoc 1 d1
))
172 (should (rassoc 1 d2
))
173 (should-error (rassoc 2 c1
) :type
'circular-list
)
174 (should (rassoc 2 c2
))
175 (should-error (rassoc 2 d1
) :type
'wrong-type-argument
)
176 (should (rassoc 2 d2
))
177 (should-error (rassoc 3 c1
) :type
'circular-list
)
178 (should-error (rassoc 3 c2
) :type
'circular-list
)
179 (should-error (rassoc 3 d1
) :type
'wrong-type-argument
)
180 (should-error (rassoc 3 d2
) :type
'wrong-type-argument
)))
182 (ert-deftest test-cycle-delq
()
183 (should-error (delq 1 (cyc1 1)) :type
'circular-list
)
184 (should-error (delq 1 (cyc2 1 2)) :type
'circular-list
)
185 (should-error (delq 1 (dot1 1)) :type
'wrong-type-argument
)
186 (should-error (delq 1 (dot2 1 2)) :type
'wrong-type-argument
)
187 (should-error (delq 2 (cyc1 1)) :type
'circular-list
)
188 (should-error (delq 2 (cyc2 1 2)) :type
'circular-list
)
189 (should-error (delq 2 (dot1 1)) :type
'wrong-type-argument
)
190 (should-error (delq 2 (dot2 1 2)) :type
'wrong-type-argument
)
191 (should-error (delq 3 (cyc1 1)) :type
'circular-list
)
192 (should-error (delq 3 (cyc2 1 2)) :type
'circular-list
)
193 (should-error (delq 3 (dot1 1)) :type
'wrong-type-argument
)
194 (should-error (delq 3 (dot2 1 2)) :type
'wrong-type-argument
))
196 (ert-deftest test-cycle-delete
()
197 (should-error (delete 1 (cyc1 1)) :type
'circular-list
)
198 (should-error (delete 1 (cyc2 1 2)) :type
'circular-list
)
199 (should-error (delete 1 (dot1 1)) :type
'wrong-type-argument
)
200 (should-error (delete 1 (dot2 1 2)) :type
'wrong-type-argument
)
201 (should-error (delete 2 (cyc1 1)) :type
'circular-list
)
202 (should-error (delete 2 (cyc2 1 2)) :type
'circular-list
)
203 (should-error (delete 2 (dot1 1)) :type
'wrong-type-argument
)
204 (should-error (delete 2 (dot2 1 2)) :type
'wrong-type-argument
)
205 (should-error (delete 3 (cyc1 1)) :type
'circular-list
)
206 (should-error (delete 3 (cyc2 1 2)) :type
'circular-list
)
207 (should-error (delete 3 (dot1 1)) :type
'wrong-type-argument
)
208 (should-error (delete 3 (dot2 1 2)) :type
'wrong-type-argument
))
210 (ert-deftest test-cycle-reverse
()
211 (should-error (reverse (cyc1 1)) :type
'circular-list
)
212 (should-error (reverse (cyc2 1 2)) :type
'circular-list
)
213 (should-error (reverse (dot1 1)) :type
'wrong-type-argument
)
214 (should-error (reverse (dot2 1 2)) :type
'wrong-type-argument
))
216 (ert-deftest test-cycle-plist-get
()
221 (should (plist-get c1
1))
222 (should (plist-get c2
1))
223 (should (plist-get d1
1))
224 (should (plist-get d2
1))
225 (should-not (plist-get c1
2))
226 (should (plist-get c2
2))
227 (should-not (plist-get d1
2))
228 (should (plist-get d2
2))
229 (should-not (plist-get c1
3))
230 (should-not (plist-get c2
3))
231 (should-not (plist-get d1
3))
232 (should-not (plist-get d2
3))))
234 (ert-deftest test-cycle-lax-plist-get
()
239 (should (lax-plist-get c1
1))
240 (should (lax-plist-get c2
1))
241 (should (lax-plist-get d1
1))
242 (should (lax-plist-get d2
1))
243 (should-error (lax-plist-get c1
2) :type
'circular-list
)
244 (should (lax-plist-get c2
2))
245 (should-not (lax-plist-get d1
2))
246 (should (lax-plist-get d2
2))
247 (should-error (lax-plist-get c1
3) :type
'circular-list
)
248 (should-error (lax-plist-get c2
3) :type
'circular-list
)
249 (should-not (lax-plist-get d1
3))
250 (should-not (lax-plist-get d2
3))))
252 (ert-deftest test-cycle-plist-member
()
257 (should (plist-member c1
1))
258 (should (plist-member c2
1))
259 (should (plist-member d1
1))
260 (should (plist-member d2
1))
261 (should-error (plist-member c1
2) :type
'circular-list
)
262 (should (plist-member c2
2))
263 (should-error (plist-member d1
2) :type
'wrong-type-argument
)
264 (should (plist-member d2
2))
265 (should-error (plist-member c1
3) :type
'circular-list
)
266 (should-error (plist-member c2
3) :type
'circular-list
)
267 (should-error (plist-member d1
3) :type
'wrong-type-argument
)
268 (should-error (plist-member d2
3) :type
'wrong-type-argument
)))
270 (ert-deftest test-cycle-plist-put
()
275 (should (plist-put c1
1 1))
276 (should (plist-put c2
1 1))
277 (should (plist-put d1
1 1))
278 (should (plist-put d2
1 1))
279 (should-error (plist-put c1
2 2) :type
'circular-list
)
280 (should (plist-put c2
2 2))
281 (should (plist-put d1
2 2))
282 (should (plist-put d2
2 2))
283 (should-error (plist-put c1
3 3) :type
'circular-list
)
284 (should-error (plist-put c2
3 3) :type
'circular-list
)
285 (should (plist-put d1
3 3))
286 (should (plist-put d2
3 3))))
288 (ert-deftest test-cycle-lax-plist-put
()
293 (should (lax-plist-put c1
1 1))
294 (should (lax-plist-put c2
1 1))
295 (should (lax-plist-put d1
1 1))
296 (should (lax-plist-put d2
1 1))
297 (should-error (lax-plist-put c1
2 2) :type
'circular-list
)
298 (should (lax-plist-put c2
2 2))
299 (should (lax-plist-put d1
2 2))
300 (should (lax-plist-put d2
2 2))
301 (should-error (lax-plist-put c1
3 3) :type
'circular-list
)
302 (should-error (lax-plist-put c2
3 3) :type
'circular-list
)
303 (should (lax-plist-put d1
3 3))
304 (should (lax-plist-put d2
3 3))))
306 (ert-deftest test-cycle-equal
()
307 (should-error (equal (cyc1 1) (cyc1 1)))
308 (should-error (equal (cyc2 1 2) (cyc2 1 2))))
310 (ert-deftest test-cycle-nconc
()
311 (should-error (nconc (cyc1 1) 'tail
) :type
'circular-list
)
312 (should-error (nconc (cyc2 1 2) 'tail
) :type
'circular-list
))
314 (provide 'cycle-tests
)