1 ;;; map-tests.el --- Tests for map.el -*- lexical-binding:t -*-
3 ;; Copyright (C) 2015-2018 Free Software Foundation, Inc.
5 ;; Author: Nicolas Petton <nicolas@petton.fr>
6 ;; Maintainer: emacs-devel@gnu.org
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software: you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation, either version 3 of the License, or
13 ;; (at your option) any later version.
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
32 (defmacro with-maps-do
(var &rest body
)
33 "Successively bind VAR to an alist, vector and hash-table.
34 Each map is built from the following alist data:
35 '((0 . 3) (1 . 4) (2 . 5)).
36 Evaluate BODY for each created map.
39 (declare (indent 1) (debug (symbolp body
)))
40 (let ((alist (make-symbol "alist"))
41 (vec (make-symbol "vec"))
42 (ht (make-symbol "ht")))
43 `(let ((,alist
(list (cons 0 3)
47 (,ht
(make-hash-table)))
51 (dolist (,var
(list ,alist
,vec
,ht
))
54 (ert-deftest test-map-elt
()
56 (should (= 3 (map-elt map
0)))
57 (should (= 4 (map-elt map
1)))
58 (should (= 5 (map-elt map
2)))
59 (should (null (map-elt map -
1)))
60 (should (null (map-elt map
4)))))
62 (ert-deftest test-map-elt-default
()
64 (should (= 5 (map-elt map
7 5)))))
66 (ert-deftest test-map-elt-testfn
()
67 (let ((map (list (cons "a" 1) (cons "b" 2)))
68 ;; Make sure to use a non-eq "a", even when compiled.
69 (noneq-key (string ?a
)))
70 (should-not (map-elt map noneq-key
))
71 (should (map-elt map noneq-key nil
'equal
))))
73 (ert-deftest test-map-elt-with-nil-value
()
74 (should (null (map-elt '((a .
1)
79 (ert-deftest test-map-put
()
81 (setf (map-elt map
2) 'hello
)
82 (should (eq (map-elt map
2) 'hello
)))
84 (map-put map
2 'hello
)
85 (should (eq (map-elt map
2) 'hello
)))
86 (let ((ht (make-hash-table)))
87 (setf (map-elt ht
2) 'a
)
88 (should (eq (map-elt ht
2)
90 (let ((alist '((0 . a
) (1 . b
) (2 . c
))))
91 (setf (map-elt alist
2) 'a
)
92 (should (eq (map-elt alist
2)
95 (should-error (setf (map-elt vec
3) 6))))
97 (ert-deftest test-map-put-alist-new-key
()
98 "Regression test for Bug#23105."
99 (let ((alist '((0 . a
))))
101 (should (eq (map-elt alist
2)
104 (ert-deftest test-map-put-testfn-alist
()
105 (let ((alist (list (cons "a" 1) (cons "b" 2)))
106 ;; Make sure to use a non-eq "a", even when compiled.
107 (noneq-key (string ?a
)))
108 (map-put alist noneq-key
3 'equal
)
109 (should-not (cddr alist
))
110 (map-put alist noneq-key
9)
111 (should (cddr alist
))))
113 (ert-deftest test-map-put-return-value
()
114 (let ((ht (make-hash-table)))
115 (should (eq (map-put ht
'a
'hello
) 'hello
))))
117 (ert-deftest test-map-delete
()
120 (should (null (map-elt map
1))))
123 (should (null (map-elt map -
2)))))
125 (ert-deftest test-map-delete-return-value
()
126 (let ((ht (make-hash-table)))
127 (should (eq (map-delete ht
'a
) ht
))))
129 (ert-deftest test-map-nested-elt
()
130 (let ((vec [a b
[c d
[e f
]]]))
131 (should (eq (map-nested-elt vec
'(2 2 0)) 'e
)))
132 (let ((alist '((a .
1)
137 (should (eq (map-nested-elt alist
'(b e f
))
139 (let ((ht (make-hash-table)))
140 (setf (map-elt ht
'a
) 1)
141 (setf (map-elt ht
'b
) (make-hash-table))
142 (setf (map-elt (map-elt ht
'b
) 'c
) 2)
143 (should (eq (map-nested-elt ht
'(b c
))
146 (ert-deftest test-map-nested-elt-default
()
147 (let ((vec [a b
[c d
]]))
148 (should (null (map-nested-elt vec
'(2 3))))
149 (should (null (map-nested-elt vec
'(2 1 1))))
150 (should (= 4 (map-nested-elt vec
'(2 1 1) 4)))))
152 (ert-deftest test-mapp
()
154 (should (mapp '((a . b
) (c . d
))))
155 (should (mapp '(a b c d
)))
157 (should (mapp [1 2 3]))
158 (should (mapp (make-hash-table)))
159 (should (mapp "hello"))
160 (should (not (mapp 1)))
161 (should (not (mapp 'hello
))))
163 (ert-deftest test-map-keys
()
165 (should (equal (map-keys map
) '(0 1 2))))
166 (should (null (map-keys nil
)))
167 (should (null (map-keys []))))
169 (ert-deftest test-map-values
()
171 (should (equal (map-values map
) '(3 4 5)))))
173 (ert-deftest test-map-pairs
()
175 (should (equal (map-pairs map
) '((0 .
3)
179 (ert-deftest test-map-length
()
180 (let ((ht (make-hash-table)))
185 (should (= 0 (map-length nil
)))
186 (should (= 0 (map-length [])))
187 (should (= 0 (map-length (make-hash-table))))
188 (should (= 5 (map-length [0 1 2 3 4])))
189 (should (= 2 (map-length '((a .
1) (b .
2)))))
190 (should (= 4 (map-length ht
)))))
192 (ert-deftest test-map-copy
()
194 (let ((copy (map-copy map
)))
195 (should (equal (map-keys map
) (map-keys copy
)))
196 (should (equal (map-values map
) (map-values copy
)))
197 (should (not (eq map copy
))))))
199 (ert-deftest test-map-apply
()
201 (should (equal (map-apply (lambda (k v
) (cons (int-to-string k
) v
))
203 '(("0" .
3) ("1" .
4) ("2" .
5)))))
205 (should (equal (map-apply (lambda (k v
) (cons (1+ k
) v
))
211 (ert-deftest test-map-do
()
214 (map-do (lambda (k v
)
215 (add-to-list 'result
(list (int-to-string k
) v
)))
217 (should (equal result
'(("2" 5) ("1" 4) ("0" 3)))))))
219 (ert-deftest test-map-keys-apply
()
221 (should (equal (map-keys-apply (lambda (k) (int-to-string k
))
225 (should (equal (map-keys-apply (lambda (k) (1+ k
))
229 (ert-deftest test-map-values-apply
()
231 (should (equal (map-values-apply (lambda (v) (1+ v
))
235 (should (equal (map-values-apply (lambda (v) (symbol-name v
))
239 (ert-deftest test-map-filter
()
241 (should (equal (map-keys (map-filter (lambda (_k v
)
245 (should (null (map-filter (lambda (k _v
)
248 (should (null (map-filter (lambda (_k v
)
251 (should (equal (map-filter (lambda (k _v
)
256 (ert-deftest test-map-remove
()
258 (should (equal (map-keys (map-remove (lambda (_k v
)
262 (should (equal (map-keys (map-remove (lambda (k _v
)
266 (should (equal (map-remove (lambda (_k v
)
273 (should (null (map-remove (lambda (k _v
)
277 (ert-deftest test-map-empty-p
()
278 (should (map-empty-p nil
))
279 (should (not (map-empty-p '((a . b
) (c . d
)))))
280 (should (map-empty-p []))
281 (should (not (map-empty-p [1 2 3])))
282 (should (map-empty-p (make-hash-table)))
283 (should (not (map-empty-p "hello")))
284 (should (map-empty-p "")))
286 (ert-deftest test-map-contains-key
()
287 (should (map-contains-key '((a .
1) (b .
2)) 'a
))
288 (should (not (map-contains-key '((a .
1) (b .
2)) 'c
)))
289 (should (map-contains-key '(("a" .
1)) "a"))
290 (should (not (map-contains-key '(("a" .
1)) "a" #'eq
)))
291 (should (map-contains-key [a b c
] 2))
292 (should (not (map-contains-key [a b c
] 3))))
294 (ert-deftest test-map-some
()
296 (should (map-some (lambda (k _v
)
299 (should-not (map-some (lambda (k _v
)
303 (should (map-some (lambda (k _v
)
306 (should-not (map-some (lambda (k _v
)
310 (ert-deftest test-map-every-p
()
312 (should (map-every-p (lambda (k _v
)
315 (should (not (map-every-p (lambda (_k _v
)
319 (should (map-every-p (lambda (k _v
)
322 (should (not (map-every-p (lambda (k _v
)
326 (ert-deftest test-map-into
()
327 (let* ((alist '((a .
1) (b .
2)))
328 (ht (map-into alist
'hash-table
)))
329 (should (hash-table-p ht
))
330 (should (equal (map-into (map-into alist
'hash-table
) 'list
)
332 (should (listp (map-into ht
'list
)))
333 (should (equal (map-keys (map-into (map-into ht
'list
) 'hash-table
))
335 (should (equal (map-values (map-into (map-into ht
'list
) 'hash-table
))
337 (should (null (map-into nil
'list
)))
338 (should (map-empty-p (map-into nil
'hash-table
)))
339 (should-error (map-into [1 2 3] 'string
))))
341 (ert-deftest test-map-let
()
342 (map-let (foo bar baz
) '((foo .
1) (bar .
2))
349 '((foo .
1) (bar .
2))
354 (ert-deftest test-map-merge-with
()
355 (should (equal (map-merge-with 'list
#'+
358 '((1 .
1) (2 .
5) (3 .
0)))
359 '((3 .
0) (2 .
9) (1 .
6)))))
362 ;;; map-tests.el ends here