1 ;;; cl-lib-tests.el --- tests for emacs-lisp/cl-lib.el -*- lexical-binding:t -*-
3 ;; Copyright (C) 2013-2018 Free Software Foundation, Inc.
5 ;; This file is part of GNU Emacs.
7 ;; This program is free software: you can redistribute it and/or
8 ;; modify it under the terms of the GNU General Public License as
9 ;; published by the Free Software Foundation, either version 3 of the
10 ;; License, or (at your option) any later version.
12 ;; This program is distributed in the hope that it will be useful, but
13 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15 ;; 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 `https://www.gnu.org/licenses/'.
22 ;; Extracted from ert-tests.el, back when ert used to reimplement some
30 (ert-deftest cl-lib-test-remprop
()
31 (let ((x (cl-gensym)))
32 (should (equal (symbol-plist x
) '()))
33 ;; Remove nonexistent property on empty plist.
35 (should (equal (symbol-plist x
) '()))
37 (should (equal (symbol-plist x
) '(a 1)))
38 ;; Remove nonexistent property on nonempty plist.
40 (should (equal (symbol-plist x
) '(a 1)))
44 (should (equal (symbol-plist x
) '(a 1 b
2 c
3 d
4)))
45 ;; Remove property that is neither first nor last.
47 (should (equal (symbol-plist x
) '(a 1 b
2 d
4)))
48 ;; Remove last property from a plist of length >1.
50 (should (equal (symbol-plist x
) '(a 1 b
2)))
51 ;; Remove first property from a plist of length >1.
53 (should (equal (symbol-plist x
) '(b 2)))
54 ;; Remove property when there is only one.
56 (should (equal (symbol-plist x
) '()))))
58 (ert-deftest cl-lib-test-remove-if-not
()
59 (let ((list (list 'a
'b
'c
'd
))
61 (let ((result (cl-remove-if-not (lambda (x)
62 (should (eql x
(nth i list
)))
67 (should (equal result
'(b c
)))
68 (should (equal list
'(a b c d
)))))
70 (cl-remove-if-not (lambda (_x) (should nil
)) '()))))
72 (ert-deftest cl-lib-test-remove
()
73 (let ((list (list 'a
'b
'c
'd
))
79 (should (eql x
(nth key-index list
)))
86 (should (equal b
(list test-index
87 (nth test-index list
))))
89 (member test-index
'(2 3))))))
90 (should (equal key-index
4))
91 (should (equal test-index
4))
92 (should (equal result
'(a d
)))
93 (should (equal list
'(a b c d
)))))
94 (let ((x (cons nil nil
))
96 (should (equal (cl-remove x
(list x y
))
97 ;; or (list x), since we use `equal' -- the
98 ;; important thing is that only one element got
99 ;; removed, this proves that the default test is
100 ;; `eql', not `equal'
104 (ert-deftest cl-lib-test-set-functions
()
105 (let ((c1 (cons nil nil
))
107 (sym (make-symbol "a")))
109 (a (list 'a
'b sym nil
"" "x" c1 c2
))
110 (b (list c1
'y
'b sym
'x
)))
111 (should (equal (cl-set-difference e e
) e
))
112 (should (equal (cl-set-difference a e
) a
))
113 (should (equal (cl-set-difference e a
) e
))
114 (should (equal (cl-set-difference a a
) e
))
115 (should (equal (cl-set-difference b e
) b
))
116 (should (equal (cl-set-difference e b
) e
))
117 (should (equal (cl-set-difference b b
) e
))
118 ;; Note: this test (and others) is sensitive to the order of the
119 ;; result, which is not documented.
120 (should (equal (cl-set-difference a b
) (list 'a nil
"" "x" c2
)))
121 (should (equal (cl-set-difference b a
) (list 'y
'x
)))
123 ;; We aren't testing whether this is really using `eq' rather than `eql'.
124 (should (equal (cl-set-difference e e
:test
'eq
) e
))
125 (should (equal (cl-set-difference a e
:test
'eq
) a
))
126 (should (equal (cl-set-difference e a
:test
'eq
) e
))
127 (should (equal (cl-set-difference a a
:test
'eq
) e
))
128 (should (equal (cl-set-difference b e
:test
'eq
) b
))
129 (should (equal (cl-set-difference e b
:test
'eq
) e
))
130 (should (equal (cl-set-difference b b
:test
'eq
) e
))
131 (should (equal (cl-set-difference a b
:test
'eq
) (list 'a nil
"" "x" c2
)))
132 (should (equal (cl-set-difference b a
:test
'eq
) (list 'y
'x
)))
134 (should (equal (cl-union e e
) e
))
135 (should (equal (cl-union a e
) a
))
136 (should (equal (cl-union e a
) a
))
137 (should (equal (cl-union a a
) a
))
138 (should (equal (cl-union b e
) b
))
139 (should (equal (cl-union e b
) b
))
140 (should (equal (cl-union b b
) b
))
141 (should (equal (cl-union a b
) (list 'x
'y
'a
'b sym nil
"" "x" c1 c2
)))
143 (should (equal (cl-union b a
) (list 'x
'y
'a
'b sym nil
"" "x" c1 c2
)))
145 (should (equal (cl-intersection e e
) e
))
146 (should (equal (cl-intersection a e
) e
))
147 (should (equal (cl-intersection e a
) e
))
148 (should (equal (cl-intersection a a
) a
))
149 (should (equal (cl-intersection b e
) e
))
150 (should (equal (cl-intersection e b
) e
))
151 (should (equal (cl-intersection b b
) b
))
152 (should (equal (cl-intersection a b
) (list sym
'b c1
)))
153 (should (equal (cl-intersection b a
) (list sym
'b c1
))))))
155 (ert-deftest cl-lib-test-gensym
()
156 ;; Since the expansion of `should' calls `cl-gensym' and thus has a
157 ;; side-effect on `cl--gensym-counter', we have to make sure all
158 ;; macros in our test body are expanded before we rebind
159 ;; `cl--gensym-counter' and run the body. Otherwise, the test would
160 ;; fail if run interpreted.
161 (let ((body (byte-compile
163 (should (equal (symbol-name (cl-gensym)) "G0"))
164 (should (equal (symbol-name (cl-gensym)) "G1"))
165 (should (equal (symbol-name (cl-gensym)) "G2"))
166 (should (equal (symbol-name (cl-gensym "foo")) "foo3"))
167 (should (equal (symbol-name (cl-gensym "bar")) "bar4"))
168 (should (equal cl--gensym-counter
5))))))
169 (let ((cl--gensym-counter 0))
172 (ert-deftest cl-lib-test-coerce-to-vector
()
177 (should (eql (cl-coerce a
'vector
) a
))
178 (should (eql (cl-coerce b
'vector
) b
))
179 (should (equal (cl-coerce c
'vector
) (vector)))
180 (should (equal (cl-coerce d
'vector
) (vector b a
)))))
182 (ert-deftest cl-lib-test-string-position
()
183 (should (eql (cl-position ?x
"") nil
))
184 (should (eql (cl-position ?a
"abc") 0))
185 (should (eql (cl-position ?b
"abc") 1))
186 (should (eql (cl-position ?c
"abc") 2))
187 (should (eql (cl-position ?d
"abc") nil
))
188 (should (eql (cl-position ?A
"abc") nil
)))
190 (ert-deftest cl-lib-test-mismatch
()
191 (should (eql (cl-mismatch "" "") nil
))
192 (should (eql (cl-mismatch "" "a") 0))
193 (should (eql (cl-mismatch "a" "a") nil
))
194 (should (eql (cl-mismatch "ab" "a") 1))
195 (should (eql (cl-mismatch "Aa" "aA") 0))
196 (should (eql (cl-mismatch '(a b c
) '(a b d
)) 2)))
198 (ert-deftest cl-lib-keyword-names-versus-values
()
200 (funcall (cl-function (lambda (&key a b
) (list a b
)))
204 (ert-deftest cl-lib-empty-keyargs
()
205 (should-error (funcall (cl-function (lambda (&key
) 1))
208 (cl-defstruct (mystruct
209 (:constructor cl-lib--con-1
(&aux
(abc 1)))
210 (:constructor cl-lib--con-2
(&optional def
) "Constructor docstring."))
212 (abc 5 :readonly t
) (def nil
))
213 (ert-deftest cl-lib-struct-accessors
()
214 (let ((x (make-mystruct :abc
1 :def
2)))
215 (should (eql (cl-struct-slot-value 'mystruct
'abc x
) 1))
216 (should (eql (cl-struct-slot-value 'mystruct
'def x
) 2))
217 (setf (cl-struct-slot-value 'mystruct
'def x
) -
1)
218 (should (eql (cl-struct-slot-value 'mystruct
'def x
) -
1))
219 (should (eql (cl-struct-slot-offset 'mystruct
'abc
) 1))
220 (should-error (cl-struct-slot-offset 'mystruct
'marypoppins
))
221 (should (pcase (cl-struct-slot-info 'mystruct
)
222 (`((cl-tag-slot) (abc 5 :readonly t
)
223 (def .
,(or `nil
`(nil))))
225 (ert-deftest cl-lib-struct-constructors
()
226 (should (string-match "\\`Constructor docstring."
227 (documentation 'cl-lib--con-2 t
)))
228 (should (mystruct-p (cl-lib--con-1)))
229 (should (mystruct-p (cl-lib--con-2))))
231 (ert-deftest cl-lib-arglist-performance
()
232 ;; An `&aux' should not cause lambda's arglist to be turned into an &rest
233 ;; that's parsed by hand.
234 (should (equal () (help-function-arglist 'cl-lib--con-1
)))
235 (should (pcase (help-function-arglist 'cl-lib--con-2
)
236 (`(&optional
,_
) t
))))
238 (ert-deftest cl-the
()
239 (should (eql (cl-the integer
42) 42))
240 (should-error (cl-the integer
"abc"))
241 (let ((side-effect 0))
242 (should (= (cl-the integer
(cl-incf side-effect
)) 1))
243 (should (= side-effect
1))))
245 (ert-deftest cl-lib-test-plusp
()
246 (should-not (cl-plusp -
1.0e
+INF
))
247 (should-not (cl-plusp -
1.5e2
))
248 (should-not (cl-plusp -
3.14))
249 (should-not (cl-plusp -
1))
250 (should-not (cl-plusp -
0.0))
251 (should-not (cl-plusp 0))
252 (should-not (cl-plusp 0.0))
253 (should-not (cl-plusp -
0.0e
+NaN
))
254 (should-not (cl-plusp 0.0e
+NaN
))
255 (should (cl-plusp 1))
256 (should (cl-plusp 3.14))
257 (should (cl-plusp 1.5e2
))
258 (should (cl-plusp 1.0e
+INF
))
259 (should-error (cl-plusp "42") :type
'wrong-type-argument
))
261 (ert-deftest cl-lib-test-minusp
()
262 (should (cl-minusp -
1.0e
+INF
))
263 (should (cl-minusp -
1.5e2
))
264 (should (cl-minusp -
3.14))
265 (should (cl-minusp -
1))
266 (should-not (cl-minusp -
0.0))
267 (should-not (cl-minusp 0))
268 (should-not (cl-minusp 0.0))
269 (should-not (cl-minusp -
0.0e
+NaN
))
270 (should-not (cl-minusp 0.0e
+NaN
))
271 (should-not (cl-minusp 1))
272 (should-not (cl-minusp 3.14))
273 (should-not (cl-minusp 1.5e2
))
274 (should-not (cl-minusp 1.0e
+INF
))
275 (should-error (cl-minusp "-42") :type
'wrong-type-argument
))
277 (ert-deftest cl-lib-test-oddp
()
278 (should (cl-oddp -
3))
280 (should-not (cl-oddp -
2))
281 (should-not (cl-oddp 0))
282 (should-not (cl-oddp 2))
283 (should-error (cl-oddp 3.0e
+NaN
) :type
'wrong-type-argument
)
284 (should-error (cl-oddp 3.0) :type
'wrong-type-argument
)
285 (should-error (cl-oddp "3") :type
'wrong-type-argument
))
287 (ert-deftest cl-lib-test-evenp
()
288 (should (cl-evenp -
2))
289 (should (cl-evenp 0))
290 (should (cl-evenp 2))
291 (should-not (cl-evenp -
3))
292 (should-not (cl-evenp 3))
293 (should-error (cl-evenp 2.0e
+NaN
) :type
'wrong-type-argument
)
294 (should-error (cl-evenp 2.0) :type
'wrong-type-argument
)
295 (should-error (cl-evenp "2") :type
'wrong-type-argument
))
297 (ert-deftest cl-digit-char-p
()
298 (should (eql 3 (cl-digit-char-p ?
3)))
299 (should (eql 10 (cl-digit-char-p ?a
11)))
300 (should (eql 10 (cl-digit-char-p ?A
11)))
301 (should-not (cl-digit-char-p ?a
))
302 (should (eql 32 (cl-digit-char-p ?w
36)))
303 (should-error (cl-digit-char-p ?a
37) :type
'args-out-of-range
)
304 (should-error (cl-digit-char-p ?a
1) :type
'args-out-of-range
))
306 (ert-deftest cl-lib-test-first
()
307 (should (null (cl-first '())))
308 (should (= 4 (cl-first '(4))))
309 (should (= 4 (cl-first '(4 2))))
310 (should-error (cl-first "42") :type
'wrong-type-argument
))
312 (ert-deftest cl-lib-test-second
()
313 (should (null (cl-second '())))
314 (should (null (cl-second '(4))))
315 (should (= 2 (cl-second '(1 2))))
316 (should (= 2 (cl-second '(1 2 3))))
317 (should-error (cl-second "1 2 3") :type
'wrong-type-argument
))
319 (ert-deftest cl-lib-test-third
()
320 (should (null (cl-third '())))
321 (should (null (cl-third '(1 2))))
322 (should (= 3 (cl-third '(1 2 3))))
323 (should (= 3 (cl-third '(1 2 3 4))))
324 (should-error (cl-third "123") :type
'wrong-type-argument
))
326 (ert-deftest cl-lib-test-fourth
()
327 (should (null (cl-fourth '())))
328 (should (null (cl-fourth '(1 2 3))))
329 (should (= 4 (cl-fourth '(1 2 3 4))))
330 (should (= 4 (cl-fourth '(1 2 3 4 5))))
331 (should-error (cl-fourth "1234") :type
'wrong-type-argument
))
333 (ert-deftest cl-lib-test-fifth
()
334 (should (null (cl-fifth '())))
335 (should (null (cl-fifth '(1 2 3 4))))
336 (should (= 5 (cl-fifth '(1 2 3 4 5))))
337 (should (= 5 (cl-fifth '(1 2 3 4 5 6))))
338 (should-error (cl-fifth "12345") :type
'wrong-type-argument
))
340 (ert-deftest cl-lib-test-fifth
()
341 (should (null (cl-fifth '())))
342 (should (null (cl-fifth '(1 2 3 4))))
343 (should (= 5 (cl-fifth '(1 2 3 4 5))))
344 (should (= 5 (cl-fifth '(1 2 3 4 5 6))))
345 (should-error (cl-fifth "12345") :type
'wrong-type-argument
))
347 (ert-deftest cl-lib-test-sixth
()
348 (should (null (cl-sixth '())))
349 (should (null (cl-sixth '(1 2 3 4 5))))
350 (should (= 6 (cl-sixth '(1 2 3 4 5 6))))
351 (should (= 6 (cl-sixth '(1 2 3 4 5 6 7))))
352 (should-error (cl-sixth "123456") :type
'wrong-type-argument
))
354 (ert-deftest cl-lib-test-seventh
()
355 (should (null (cl-seventh '())))
356 (should (null (cl-seventh '(1 2 3 4 5 6))))
357 (should (= 7 (cl-seventh '(1 2 3 4 5 6 7))))
358 (should (= 7 (cl-seventh '(1 2 3 4 5 6 7 8))))
359 (should-error (cl-seventh "1234567") :type
'wrong-type-argument
))
361 (ert-deftest cl-lib-test-eighth
()
362 (should (null (cl-eighth '())))
363 (should (null (cl-eighth '(1 2 3 4 5 6 7))))
364 (should (= 8 (cl-eighth '(1 2 3 4 5 6 7 8))))
365 (should (= 8 (cl-eighth '(1 2 3 4 5 6 7 8 9))))
366 (should-error (cl-eighth "12345678") :type
'wrong-type-argument
))
368 (ert-deftest cl-lib-test-ninth
()
369 (should (null (cl-ninth '())))
370 (should (null (cl-ninth '(1 2 3 4 5 6 7 8))))
371 (should (= 9 (cl-ninth '(1 2 3 4 5 6 7 8 9))))
372 (should (= 9 (cl-ninth '(1 2 3 4 5 6 7 8 9 10))))
373 (should-error (cl-ninth "123456789") :type
'wrong-type-argument
))
375 (ert-deftest cl-lib-test-tenth
()
376 (should (null (cl-tenth '())))
377 (should (null (cl-tenth '(1 2 3 4 5 6 7 8 9))))
378 (should (= 10 (cl-tenth '(1 2 3 4 5 6 7 8 9 10))))
379 (should (= 10 (cl-tenth '(1 2 3 4 5 6 7 8 9 10 11))))
380 (should-error (cl-tenth "1234567890") :type
'wrong-type-argument
))
382 (ert-deftest cl-lib-test-endp
()
383 (should (cl-endp '()))
384 (should-not (cl-endp '(1)))
385 (should-error (cl-endp 1) :type
'wrong-type-argument
)
386 (should-error (cl-endp [1]) :type 'wrong-type-argument))
388 (ert-deftest cl-lib-test-nth-value ()
389 (let ((vals (cl-values 2 3)))
390 (should (= (cl-nth-value 0 vals) 2))
391 (should (= (cl-nth-value 1 vals) 3))
392 (should (null (cl-nth-value 2 vals)))
393 (should-error (cl-nth-value 0.0 vals) :type 'wrong-type-argument)))
395 (ert-deftest cl-lib-nth-value-test-multiple-values ()
396 "While CL multiple values are an alias to list, these won't work."
397 :expected-result :failed
398 (should (eq (cl-nth-value 0 '(2 3)) '(2 3)))
399 (should (= (cl-nth-value 0 1) 1))
400 (should (null (cl-nth-value 1 1)))
401 (should-error (cl-nth-value -1 (cl-values 2 3)) :type 'args-out-of-range)
402 (should (string= (cl-nth-value 0 "only lists") "only lists")))
404 (ert-deftest cl-test-caaar ()
405 (should (null (cl-caaar '())))
406 (should (null (cl-caaar '(() (2)))))
407 (should (null (cl-caaar '((() (2)) (a b)))))
408 (should-error (cl-caaar '(1 2)) :type 'wrong-type-argument)
409 (should-error (cl-caaar '((1 2))) :type 'wrong-type-argument)
410 (should (= 1 (cl-caaar '(((1 2) (3 4))))))
411 (should (null (cl-caaar '((() (3 4)))))))
413 (ert-deftest cl-test-caadr ()
414 (should (null (cl-caadr '())))
415 (should (null (cl-caadr '(1))))
416 (should-error (cl-caadr '(1 2)) :type 'wrong-type-argument)
417 (should (= 2 (cl-caadr '(1 (2 3)))))
418 (should (equal '((2) (3)) (cl-caadr '((1) (((2) (3))) (4))))))
420 (ert-deftest cl-test-ldiff ()
422 (should (null (cl-ldiff '() '())))
423 (should (null (cl-ldiff '() l)))
424 (should (null (cl-ldiff l l)))
425 (should (equal l (cl-ldiff l '())))
426 ;; must be part of the list
427 (should (equal l (cl-ldiff l '(2 3))))
428 (should (equal '(1) (cl-ldiff l (nthcdr 1 l))))
429 ;; should return a copy
430 (should-not (eq (cl-ldiff l '()) l))))
432 (ert-deftest cl-lib-adjoin-test ()
435 ;; add non-existing item to the front
436 (should (equal '(3 1 2) (cl-adjoin 3 nums)))
437 ;; just add - don't copy rest
438 (should (eq nums (cdr (cl-adjoin 3 nums))))
439 ;; add only when not already there
440 (should (eq nums (cl-adjoin 2 nums)))
441 (should (equal '(2 1 (2)) (cl-adjoin 2 '(1 (2)))))
442 ;; default test function is eql
443 (should (equal '(1.0 1 2) (cl-adjoin 1.0 nums)))
444 ;; own :test function - returns true if match
445 (should (equal '(1.0 1 2) (cl-adjoin 1.0 nums :test nil))) ;defaults to eql
446 (should (eq nums (cl-adjoin 2 nums :test myfn-p))) ;match
447 (should (equal '(3 1 2) (cl-adjoin 3 nums :test myfn-p))) ;no match
448 ;; own :test-not function - returns false if match
449 (should (equal '(1.0 1 2) (cl-adjoin 1.0 nums :test-not nil))) ;defaults to eql
450 (should (equal '(2 2) (cl-adjoin 2 '(2) :test-not myfn-p))) ; no match
451 (should (eq nums (cl-adjoin 2 nums :test-not myfn-p))) ; 1 matches
452 (should (eq nums (cl-adjoin 3 nums :test-not myfn-p))) ; 1 and 2 matches
454 ;; according to CLtL2 passing both :test and :test-not should signal error
455 ;;(should-error (cl-adjoin 3 nums :test 'myfn-p :test-not myfn-p))
458 (should (eq nums (cl-adjoin 3 nums :key (lambda (x) (if (cl-evenp x) (1+ x) x)))))
459 (should (equal '(3 1 2) (cl-adjoin 3 nums :key (lambda (x) (if (cl-evenp x) (+ 2 x) x)))))
461 ;; convert using :key, then compare with :test
462 (should (eq nums (cl-adjoin 1 nums :key 'int-to-string :test 'string=)))
463 (should (equal '(3 1 2) (cl-adjoin 3 nums :key 'int-to-string :test 'string=)))
464 (should-error (cl-adjoin 3 nums :key 'int-to-string :test myfn-p)
465 :type 'wrong-type-argument)
467 ;; convert using :key, then compare with :test-not
468 (should (eq nums (cl-adjoin 3 nums :key 'int-to-string :test-not 'string=)))
469 (should (equal '(1 1) (cl-adjoin 1 '(1) :key 'int-to-string :test-not 'string=)))
470 (should-error (cl-adjoin 1 nums :key 'int-to-string :test-not myfn-p)
471 :type 'wrong-type-argument)))
473 (ert-deftest cl-parse-integer ()
474 (should-error (cl-parse-integer "abc"))
475 (should (null (cl-parse-integer "abc" :junk-allowed t)))
476 (should (null (cl-parse-integer "" :junk-allowed t)))
477 (should (= 342391 (cl-parse-integer "0123456789" :radix 8 :junk-allowed t)))
478 (should-error (cl-parse-integer "0123456789" :radix 8))
479 (should (= -239 (cl-parse-integer "-efz" :radix 16 :junk-allowed t)))
480 (should-error (cl-parse-integer "efz" :radix 16))
481 (should (= 239 (cl-parse-integer "zzef" :radix 16 :start 2)))
482 (should (= -123 (cl-parse-integer " -123 "))))
484 (ert-deftest cl-flet-test ()
485 (should (equal (cl-flet ((f1 (x) x)) (let ((x #'f1)) (funcall x 5))) 5)))
487 (ert-deftest cl-lib-test-typep ()
488 (cl-deftype cl-lib-test-type (&optional x) `(member ,x))
489 ;; Make sure we correctly implement the rule that deftype's optional args
490 ;; default to `*' rather than to nil.
491 (should (cl-typep '* 'cl-lib-test-type))
492 (should-not (cl-typep 1 'cl-lib-test-type)))
494 (ert-deftest cl-lib-symbol-macrolet ()
496 (should (equal (cl-flet ((f (x) (+ x 5)))
499 ;; Go through `eval', otherwise the macro-expansion
500 ;; error prevents running the whole test suite :-(
501 (eval '(cl-symbol-macrolet ((f (+ x 6)))
502 (cl-flet ((f (x) (+ x 5)))
507 (defmacro cl-lib-symbol-macrolet-4+5 ()
510 (s1 (make-symbol sname))
511 (s2 (make-symbol sname)))
512 `(cl-symbol-macrolet ((,s1 4)
516 (ert-deftest cl-lib-symbol-macrolet-2 ()
517 (should (equal (cl-lib-symbol-macrolet-4+5) (+ 4 5))))
520 (ert-deftest cl-lib-symbol-macrolet-hide ()
521 ;; bug#26325, bug#26073
522 (should (equal (let ((y 5))
523 (cl-symbol-macrolet ((x y))
525 (let ((x 6)) (list x y))
526 (cl-letf ((x 6)) (list x y))
527 (apply (lambda (x) (+ x 1)) (list 8)))))
528 '(5 (6 5) (6 6) 9))))
530 (defun cl-lib-tests--dummy-function ()
531 ;; Dummy function to see if the file is compiled.
534 (ert-deftest cl-lib-defstruct-record ()
535 ;; This test fails when compiled, see Bug#24402/27718.
536 :expected-result (if (byte-code-function-p
537 (symbol-function 'cl-lib-tests--dummy-function))
540 (let ((x (make-foo :x 42)))
542 (should (eq (type-of x) 'foo))
543 (should (eql (foo-x x) 42))))
545 (ert-deftest old-struct ()
547 (let ((x [cl-struct-foo])
548 (saved cl-old-struct-compat-mode))
549 (cl-old-struct-compat-mode -1)
550 (should (eq (type-of x) 'vector))
552 (cl-old-struct-compat-mode 1)
553 (let ((cl-struct-foo (cl--struct-get-class 'foo)))
554 (setf (symbol-function 'cl-struct-foo) :quick-object-witness-check)
555 (should (eq (type-of x) 'foo))
556 (should (eq (type-of [foo]) 'vector)))
558 (cl-old-struct-compat-mode (if saved 1 -1))))
560 (ert-deftest cl-lib-old-struct ()
561 (let ((saved cl-old-struct-compat-mode))
562 (cl-old-struct-compat-mode -1)
563 (cl-struct-define 'foo "" 'cl-structure-object nil nil nil
564 'cl-struct-foo-tags 'cl-struct-foo t)
565 (should cl-old-struct-compat-mode)
566 (cl-old-struct-compat-mode (if saved 1 -1))))
568 ;;; cl-lib-tests.el ends here