aboutsummaryrefslogtreecommitdiffstats
path: root/test
diff options
context:
space:
mode:
authorAndrea Corallo2021-03-09 10:03:47 +0100
committerAndrea Corallo2021-03-09 10:03:47 +0100
commit43b0df62cd5922df5495b3f4aee5b7beca14384f (patch)
tree3c0bfa9526d08c9c85e646cd355467e3dfb439ac /test
parent380ba045c48bfbb160da288b1bd50f82d3f999f0 (diff)
parent9cbdf20316e1cec835a7dfe28877142e437976f4 (diff)
downloademacs-43b0df62cd5922df5495b3f4aee5b7beca14384f.tar.gz
emacs-43b0df62cd5922df5495b3f4aee5b7beca14384f.zip
Merge commit '9cbdf20316' into native-comp
Diffstat (limited to 'test')
-rw-r--r--test/lisp/calc/calc-tests.el76
-rw-r--r--test/lisp/custom-tests.el160
-rw-r--r--test/lisp/emacs-lisp/bindat-tests.el133
-rw-r--r--test/lisp/emacs-lisp/bytecomp-tests.el23
-rw-r--r--test/lisp/emacs-lisp/cconv-tests.el9
-rw-r--r--test/lisp/emacs-lisp/checkdoc-tests.el42
-rw-r--r--test/lisp/emacs-lisp/map-tests.el474
-rw-r--r--test/lisp/emacs-lisp/pcase-tests.el27
-rw-r--r--test/lisp/emacs-lisp/rx-tests.el8
-rw-r--r--test/lisp/erc/erc-tests.el64
-rw-r--r--test/lisp/json-tests.el194
-rw-r--r--test/lisp/minibuffer-tests.el6
-rw-r--r--test/lisp/net/puny-tests.el6
-rw-r--r--test/lisp/obsolete/inversion-tests.el (renamed from test/lisp/cedet/inversion-tests.el)0
-rw-r--r--test/src/keymap-tests.el58
15 files changed, 848 insertions, 432 deletions
diff --git a/test/lisp/calc/calc-tests.el b/test/lisp/calc/calc-tests.el
index bdcf78e020a..c5aa5a31eb2 100644
--- a/test/lisp/calc/calc-tests.el
+++ b/test/lisp/calc/calc-tests.el
@@ -707,6 +707,82 @@ An existing calc stack is reused, otherwise a new one is created."
707 (var c var-c)))))) 707 (var c var-c))))))
708 (calc-set-language nil))) 708 (calc-set-language nil)))
709 709
710(defvar var-g)
711
712;; Test `let'.
713(defmath test1 (x)
714 (let ((x (+ x 1))
715 (y (+ x 3)))
716 (let ((z (+ y 6)))
717 (* x y z g))))
718
719;; Test `let*'.
720(defmath test2 (x)
721 (let* ((y (+ x 1))
722 (z (+ y 3)))
723 (let* ((u (+ z 6)))
724 (* x y z u g))))
725
726;; Test `for'.
727(defmath test3 (x)
728 (let ((s 0))
729 (for ((ii 1 x)
730 (jj 1 ii))
731 (setq s (+ s (* ii jj))))
732 s))
733
734;; Test `for' with non-unit stride.
735(defmath test4 (x)
736 (let ((l nil))
737 (for ((ii 1 x 1)
738 (jj 1 10 ii))
739 (setq l ('cons jj l))) ; Use Lisp `cons', not `calcFunc-cons'.
740 (reverse l)))
741
742;; Test `foreach'.
743(defmath test5 (x)
744 (let ((s 0))
745 (foreach ((a x)
746 (b a))
747 (setq s (+ s b)))
748 s))
749
750;; Test `break'.
751(defmath test6 (x)
752 (let ((a (for ((ii 1 10))
753 (when (= ii x)
754 (break (* ii 2)))))
755 (b (foreach ((e '(9 3 6)))
756 (when (= e x)
757 (break (- e 1))))))
758 (* a b)))
759
760;; Test `return' from `for'.
761(defmath test7 (x)
762 (for ((ii 1 10))
763 (when (= ii x)
764 (return (* ii 2))))
765 5)
766
767(ert-deftest calc-defmath ()
768 (let ((var-g 17))
769 (should (equal (calcFunc-test1 2) (* 3 5 11 17)))
770 (should (equal (calcFunc-test2 2) (* 2 3 6 12 17))))
771 (should (equal (calcFunc-test3 3)
772 (+ (* 1 1)
773 (* 2 1) (* 2 2)
774 (* 3 1) (* 3 2) (* 3 3))))
775 (should (equal (calcFunc-test4 5)
776 '( 1 2 3 4 5 6 7 8 9 10
777 1 3 5 7 9
778 1 4 7 10
779 1 5 9
780 1 6)))
781 (should (equal (calcFunc-test5 '((2 3) (5) (7 11 13)))
782 (+ 2 3 5 7 11 13)))
783 (should (equal (calcFunc-test6 3) (* (* 3 2) (- 3 1))))
784 (should (equal (calcFunc-test7 3) (* 3 2))))
785
710(provide 'calc-tests) 786(provide 'calc-tests)
711;;; calc-tests.el ends here 787;;; calc-tests.el ends here
712 788
diff --git a/test/lisp/custom-tests.el b/test/lisp/custom-tests.el
index 09f79c1a089..02a9239824d 100644
--- a/test/lisp/custom-tests.el
+++ b/test/lisp/custom-tests.el
@@ -24,70 +24,108 @@
24 24
25(require 'wid-edit) 25(require 'wid-edit)
26(require 'cus-edit) 26(require 'cus-edit)
27(require 'seq) ; For `seq-find'. 27
28(defmacro custom-tests--with-temp-dir (&rest body)
29 "Eval BODY with `temporary-file-directory' bound to a fresh directory.
30Ensure the directory is recursively deleted after the fact."
31 (declare (debug t) (indent 0))
32 (let ((dir (make-symbol "dir")))
33 `(let ((,dir (file-name-as-directory (make-temp-file "custom-tests-" t))))
34 (unwind-protect
35 (let ((temporary-file-directory ,dir))
36 ,@body)
37 (delete-directory ,dir t)))))
28 38
29(ert-deftest custom-theme--load-path () 39(ert-deftest custom-theme--load-path ()
30 "Test `custom-theme--load-path' behavior." 40 "Test `custom-theme--load-path' behavior."
31 (let ((tmpdir (file-name-as-directory (make-temp-file "custom-tests-" t)))) 41 (custom-tests--with-temp-dir
32 (unwind-protect 42 ;; Path is empty.
33 ;; Create all temporary files under the same deletable parent. 43 (let ((custom-theme-load-path ()))
34 (let ((temporary-file-directory tmpdir)) 44 (should (null (custom-theme--load-path))))
35 ;; Path is empty. 45
36 (let ((custom-theme-load-path ())) 46 ;; Path comprises non-existent file.
37 (should (null (custom-theme--load-path)))) 47 (let* ((name (make-temp-name temporary-file-directory))
38 48 (custom-theme-load-path (list name)))
39 ;; Path comprises non-existent file. 49 (should (not (file-exists-p name)))
40 (let* ((name (make-temp-name tmpdir)) 50 (should (null (custom-theme--load-path))))
41 (custom-theme-load-path (list name))) 51
42 (should (not (file-exists-p name))) 52 ;; Path comprises existing file.
43 (should (null (custom-theme--load-path)))) 53 (let* ((file (make-temp-file "file"))
44 54 (custom-theme-load-path (list file)))
45 ;; Path comprises existing file. 55 (should (file-exists-p file))
46 (let* ((file (make-temp-file "file")) 56 (should (not (file-directory-p file)))
47 (custom-theme-load-path (list file))) 57 (should (null (custom-theme--load-path))))
48 (should (file-exists-p file)) 58
49 (should (not (file-directory-p file))) 59 ;; Path comprises existing directory.
50 (should (null (custom-theme--load-path)))) 60 (let* ((dir (make-temp-file "dir" t))
51 61 (custom-theme-load-path (list dir)))
52 ;; Path comprises existing directory. 62 (should (file-directory-p dir))
53 (let* ((dir (make-temp-file "dir" t)) 63 (should (equal (custom-theme--load-path) custom-theme-load-path)))
54 (custom-theme-load-path (list dir))) 64
55 (should (file-directory-p dir)) 65 ;; Expand `custom-theme-directory' path element.
56 (should (equal (custom-theme--load-path) custom-theme-load-path))) 66 (let ((custom-theme-load-path '(custom-theme-directory)))
57 67 (let ((custom-theme-directory (make-temp-name temporary-file-directory)))
58 ;; Expand `custom-theme-directory' path element. 68 (should (not (file-exists-p custom-theme-directory)))
59 (let ((custom-theme-load-path '(custom-theme-directory))) 69 (should (null (custom-theme--load-path))))
60 (let ((custom-theme-directory (make-temp-name tmpdir))) 70 (let ((custom-theme-directory (make-temp-file "file")))
61 (should (not (file-exists-p custom-theme-directory))) 71 (should (file-exists-p custom-theme-directory))
62 (should (null (custom-theme--load-path)))) 72 (should (not (file-directory-p custom-theme-directory)))
63 (let ((custom-theme-directory (make-temp-file "file"))) 73 (should (null (custom-theme--load-path))))
64 (should (file-exists-p custom-theme-directory)) 74 (let ((custom-theme-directory (make-temp-file "dir" t)))
65 (should (not (file-directory-p custom-theme-directory))) 75 (should (file-directory-p custom-theme-directory))
66 (should (null (custom-theme--load-path)))) 76 (should (equal (custom-theme--load-path)
67 (let ((custom-theme-directory (make-temp-file "dir" t))) 77 (list custom-theme-directory)))))
68 (should (file-directory-p custom-theme-directory)) 78
69 (should (equal (custom-theme--load-path) 79 ;; Expand t path element.
70 (list custom-theme-directory))))) 80 (let ((custom-theme-load-path '(t)))
71 81 (let ((data-directory (make-temp-name temporary-file-directory)))
72 ;; Expand t path element. 82 (should (not (file-exists-p data-directory)))
73 (let ((custom-theme-load-path '(t))) 83 (should (null (custom-theme--load-path))))
74 (let ((data-directory (make-temp-name tmpdir))) 84 (let ((data-directory temporary-file-directory)
75 (should (not (file-exists-p data-directory))) 85 (themedir (expand-file-name "themes" temporary-file-directory)))
76 (should (null (custom-theme--load-path)))) 86 (should (not (file-exists-p themedir)))
77 (let ((data-directory tmpdir) 87 (should (null (custom-theme--load-path)))
78 (themedir (expand-file-name "themes" tmpdir))) 88 (with-temp-file themedir)
79 (should (not (file-exists-p themedir))) 89 (should (file-exists-p themedir))
80 (should (null (custom-theme--load-path))) 90 (should (not (file-directory-p themedir)))
81 (with-temp-file themedir) 91 (should (null (custom-theme--load-path)))
82 (should (file-exists-p themedir)) 92 (delete-file themedir)
83 (should (not (file-directory-p themedir))) 93 (make-directory themedir)
84 (should (null (custom-theme--load-path))) 94 (should (file-directory-p themedir))
85 (delete-file themedir) 95 (should (equal (custom-theme--load-path) (list themedir)))))))
86 (make-directory themedir) 96
87 (should (file-directory-p themedir)) 97(ert-deftest custom-tests-require-theme ()
88 (should (equal (custom-theme--load-path) (list themedir)))))) 98 "Test `require-theme'."
89 (when (file-directory-p tmpdir) 99 (custom-tests--with-temp-dir
90 (delete-directory tmpdir t))))) 100 (let* ((default-directory temporary-file-directory)
101 (custom-theme-load-path (list default-directory))
102 (load-path ()))
103 ;; Generate some `.el' and `.elc' files.
104 (with-temp-file "custom-tests--a.el"
105 (insert "(provide 'custom-tests--a)"))
106 (make-empty-file "custom-tests--b.el")
107 (with-temp-file "custom-tests--b.elc"
108 (byte-compile-insert-header nil (current-buffer))
109 (insert "(provide 'custom-tests--b)"))
110 (make-empty-file "custom-tests--c.el")
111 (with-temp-file "custom-tests--d.elc"
112 (byte-compile-insert-header nil (current-buffer)))
113 ;; Load them.
114 (dolist (feature '(a b c d e))
115 (should-not (featurep (intern (format "custom-tests--%s" feature)))))
116 (should (eq (require-theme 'custom-tests--a) 'custom-tests--a))
117 (delete-file "custom-tests--a.el")
118 (dolist (feature '(custom-tests--a custom-tests--b))
119 (should (eq (require-theme feature) feature))
120 (should (featurep feature)))
121 (dolist (feature '(custom-tests--c custom-tests--d))
122 (dolist (noerror '(nil t))
123 (let ((err (should-error (require-theme feature noerror))))
124 (should (string-search "failed to provide feature" (cadr err))))))
125 (should-error (require-theme 'custom-tests--e) :type 'file-missing)
126 (should-not (require-theme 'custom-tests--e t))
127 (dolist (feature '(custom-tests--c custom-tests--d custom-tests--e))
128 (should-not (featurep feature))))))
91 129
92(defcustom custom--test-user-option 'foo 130(defcustom custom--test-user-option 'foo
93 "User option for test." 131 "User option for test."
diff --git a/test/lisp/emacs-lisp/bindat-tests.el b/test/lisp/emacs-lisp/bindat-tests.el
index 72883fc2ec7..911a5f0c7b1 100644
--- a/test/lisp/emacs-lisp/bindat-tests.el
+++ b/test/lisp/emacs-lisp/bindat-tests.el
@@ -1,4 +1,4 @@
1;;; bindat-tests.el --- tests for bindat.el -*- lexical-binding: t; coding: utf-8; -*- 1;;; bindat-tests.el --- tests for bindat.el -*- lexical-binding: t -*-
2 2
3;; Copyright (C) 2019-2021 Free Software Foundation, Inc. 3;; Copyright (C) 2019-2021 Free Software Foundation, Inc.
4 4
@@ -23,47 +23,50 @@
23(require 'bindat) 23(require 'bindat)
24(require 'cl-lib) 24(require 'cl-lib)
25 25
26(defvar header-bindat-spec 26(bindat-defmacro ip () "An IPv4 address" '(vec 4 byte))
27 (bindat-spec 27
28(defconst header-bindat-spec
29 (bindat-type
28 (dest-ip ip) 30 (dest-ip ip)
29 (src-ip ip) 31 (src-ip ip)
30 (dest-port u16) 32 (dest-port uint 16)
31 (src-port u16))) 33 (src-port uint 16)))
32 34
33(defvar data-bindat-spec 35(defconst data-bindat-spec
34 (bindat-spec 36 (bindat-type
35 (type u8) 37 (type u8)
36 (opcode u8) 38 (opcode u8)
37 (length u16r) ;; little endian order 39 (length uintr 16) ;; little endian order
38 (id strz 8) 40 (id strz 8)
39 (data vec (length)) 41 (data vec length)
40 (align 4))) 42 (_ align 4)))
43
41 44
42(defvar packet-bindat-spec 45(defconst packet-bindat-spec
43 (bindat-spec 46 (bindat-type
44 (header struct header-bindat-spec) 47 (header type header-bindat-spec)
45 (items u8) 48 (items u8)
46 (fill 3) 49 (_ fill 3)
47 (item repeat (items) 50 (item repeat items
48 (struct data-bindat-spec)))) 51 (_ type data-bindat-spec))))
49 52
50(defvar struct-bindat 53(defconst struct-bindat
51 '((header 54 '((header
52 (dest-ip . [192 168 1 100]) 55 (dest-ip . [192 168 1 100])
53 (src-ip . [192 168 1 101]) 56 (src-ip . [192 168 1 101])
54 (dest-port . 284) 57 (dest-port . 284)
55 (src-port . 5408)) 58 (src-port . 5408))
56 (items . 2) 59 (items . 2)
57 (item ((data . [1 2 3 4 5]) 60 (item ((type . 2)
58 (id . "ABCDEF")
59 (length . 5)
60 (opcode . 3) 61 (opcode . 3)
61 (type . 2)) 62 (length . 5)
62 ((data . [6 7 8 9 10 11 12]) 63 (id . "ABCDEF")
63 (id . "BCDEFG") 64 (data . [1 2 3 4 5]))
64 (length . 7) 65 ((type . 1)
65 (opcode . 4) 66 (opcode . 4)
66 (type . 1))))) 67 (length . 7)
68 (id . "BCDEFG")
69 (data . [6 7 8 9 10 11 12])))))
67 70
68(ert-deftest bindat-test-pack () 71(ert-deftest bindat-test-pack ()
69 (should (equal 72 (should (equal
@@ -77,27 +80,7 @@
77 (should (equal 80 (should (equal
78 (bindat-unpack packet-bindat-spec 81 (bindat-unpack packet-bindat-spec
79 (bindat-pack packet-bindat-spec struct-bindat)) 82 (bindat-pack packet-bindat-spec struct-bindat))
80 '((item 83 struct-bindat)))
81 ((data .
82 [1 2 3 4 5])
83 (id . "ABCDEF")
84 (length . 5)
85 (opcode . 3)
86 (type . 2))
87 ((data .
88 [6 7 8 9 10 11 12])
89 (id . "BCDEFG")
90 (length . 7)
91 (opcode . 4)
92 (type . 1)))
93 (items . 2)
94 (header
95 (src-port . 5408)
96 (dest-port . 284)
97 (src-ip .
98 [192 168 1 101])
99 (dest-ip .
100 [192 168 1 100]))))))
101 84
102(ert-deftest bindat-test-pack/multibyte-string-fails () 85(ert-deftest bindat-test-pack/multibyte-string-fails ()
103 (should-error (bindat-pack nil nil "ö"))) 86 (should-error (bindat-pack nil nil "ö")))
@@ -121,4 +104,62 @@
121 (should (equal (bindat-ip-to-string [192 168 0 1]) "192.168.0.1")) 104 (should (equal (bindat-ip-to-string [192 168 0 1]) "192.168.0.1"))
122 (should (equal (bindat-ip-to-string "\300\250\0\1") "192.168.0.1"))) 105 (should (equal (bindat-ip-to-string "\300\250\0\1") "192.168.0.1")))
123 106
107(defconst bindat-test--int-websocket-type
108 (bindat-type
109 :pack-var value
110 (n1 u8
111 :pack-val (if (< value 126) value (if (< value 65536) 126 127)))
112 (n2 uint (pcase n1 (127 64) (126 16) (_ 0))
113 :pack-val value)
114 :unpack-val (if (< n1 126) n1 n2)))
115
116(ert-deftest bindat-test--pack-val ()
117 ;; This is intended to test the :(un)pack-val feature that offers
118 ;; control over the unpacked representation of the data.
119 (dolist (n '(0 42 125 126 127 128 150 255 5000 65535 65536 8769786876))
120 (should
121 (equal (bindat-unpack bindat-test--int-websocket-type
122 (bindat-pack bindat-test--int-websocket-type n))
123 n))))
124
125(ert-deftest bindat-test--sint ()
126 (dotimes (kind 32)
127 (let ((bitlen (* 8 (/ kind 2)))
128 (r (zerop (% kind 2))))
129 (dotimes (_ 100)
130 (let* ((n (random (ash 1 bitlen)))
131 (i (- n (ash 1 (1- bitlen)))))
132 (should (equal (bindat-unpack
133 (bindat-type sint bitlen r)
134 (bindat-pack (bindat-type sint bitlen r) i))
135 i))
136 (when (>= i 0)
137 (should (equal (bindat-pack
138 (bindat-type if r (uintr bitlen) (uint bitlen)) i)
139 (bindat-pack (bindat-type sint bitlen r) i)))
140 (should (equal (bindat-unpack
141 (bindat-type if r (uintr bitlen) (uint bitlen))
142 (bindat-pack (bindat-type sint bitlen r) i))
143 i))))))))
144
145(defconst bindat-test--LEB128
146 (bindat-type
147 letrec ((loop
148 (struct :pack-var n
149 (head u8
150 :pack-val (+ (logand n 127) (if (> n 127) 128 0)))
151 (tail if (< head 128) (unit 0) loop
152 :pack-val (ash n -7))
153 :unpack-val (+ (logand head 127) (ash tail 7)))))
154 loop))
155
156(ert-deftest bindat-test--recursive ()
157 (dotimes (n 10)
158 (let ((max (ash 1 (* n 10))))
159 (dotimes (_ 10)
160 (let ((n (random max)))
161 (should (equal (bindat-unpack bindat-test--LEB128
162 (bindat-pack bindat-test--LEB128 n))
163 n)))))))
164
124;;; bindat-tests.el ends here 165;;; bindat-tests.el ends here
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el
index fb84596ad3f..03c267ccd0f 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -1199,6 +1199,29 @@ interpreted and compiled."
1199 (should (equal (funcall (eval fun t)) '(c d))) 1199 (should (equal (funcall (eval fun t)) '(c d)))
1200 (should (equal (funcall (byte-compile fun)) '(c d)))))) 1200 (should (equal (funcall (byte-compile fun)) '(c d))))))
1201 1201
1202(ert-deftest bytecomp-reify-function ()
1203 "Check that closures that modify their bound variables are
1204compiled correctly."
1205 (cl-letf ((lexical-binding t)
1206 ((symbol-function 'counter) nil))
1207 (let ((x 0))
1208 (defun counter () (cl-incf x))
1209 (should (equal (counter) 1))
1210 (should (equal (counter) 2))
1211 ;; byte compiling should not cause counter to always return the
1212 ;; same value (bug#46834)
1213 (byte-compile 'counter)
1214 (should (equal (counter) 3))
1215 (should (equal (counter) 4)))
1216 (let ((x 0))
1217 (let ((x 1))
1218 (defun counter () x)
1219 (should (equal (counter) 1))
1220 ;; byte compiling should not cause the outer binding to shadow
1221 ;; the inner one (bug#46834)
1222 (byte-compile 'counter)
1223 (should (equal (counter) 1))))))
1224
1202;; Local Variables: 1225;; Local Variables:
1203;; no-byte-compile: t 1226;; no-byte-compile: t
1204;; End: 1227;; End:
diff --git a/test/lisp/emacs-lisp/cconv-tests.el b/test/lisp/emacs-lisp/cconv-tests.el
index 517373386e3..5aeed0cc155 100644
--- a/test/lisp/emacs-lisp/cconv-tests.el
+++ b/test/lisp/emacs-lisp/cconv-tests.el
@@ -182,7 +182,14 @@
182 (should (eq (cconv-tests-cl-defsubst) 'cl-defsubst-result))) 182 (should (eq (cconv-tests-cl-defsubst) 'cl-defsubst-result)))
183 183
184(ert-deftest cconv-convert-lambda-lifted () 184(ert-deftest cconv-convert-lambda-lifted ()
185 "Bug#30872." 185 ;; Verify that lambda-lifting is actually performed at all.
186 (should (equal (cconv-closure-convert
187 '#'(lambda (x) (let ((f #'(lambda () (+ x 1))))
188 (funcall f))))
189 '#'(lambda (x) (let ((f #'(lambda (x) (+ x 1))))
190 (funcall f x)))))
191
192 ;; Bug#30872.
186 (should 193 (should
187 (equal (funcall 194 (equal (funcall
188 (byte-compile 195 (byte-compile
diff --git a/test/lisp/emacs-lisp/checkdoc-tests.el b/test/lisp/emacs-lisp/checkdoc-tests.el
index cf7baf4ce44..7a7aa9fb3cd 100644
--- a/test/lisp/emacs-lisp/checkdoc-tests.el
+++ b/test/lisp/emacs-lisp/checkdoc-tests.el
@@ -52,49 +52,31 @@
52 (insert "(cl-defmethod foo ((a (eql smthg)) (b list)) \"Return A+B.\")") 52 (insert "(cl-defmethod foo ((a (eql smthg)) (b list)) \"Return A+B.\")")
53 (checkdoc-defun))) 53 (checkdoc-defun)))
54 54
55(ert-deftest checkdoc-cl-defun-with-key-ok () 55(ert-deftest checkdoc-cl-defmethod-qualified-ok ()
56 "Checkdoc should be happy with a cl-defun using &key." 56 "Checkdoc should be happy with a `cl-defmethod' using qualifiers."
57 (with-temp-buffer
58 (emacs-lisp-mode)
59 (insert "(cl-defun foo (&key a (b 27)) \"Return :A+:B.\")")
60 (checkdoc-defun)))
61
62(ert-deftest checkdoc-cl-defun-with-allow-other-keys-ok ()
63 "Checkdoc should be happy with a cl-defun using &allow-other-keys."
64 (with-temp-buffer
65 (emacs-lisp-mode)
66 (insert "(cl-defun foo (&key a &allow-other-keys) \"Return :A.\")")
67 (checkdoc-defun)))
68
69(ert-deftest checkdoc-cl-defun-with-default-optional-value-ok ()
70 "Checkdoc should be happy with a cl-defun using default values for optional args."
71 (with-temp-buffer 57 (with-temp-buffer
72 (emacs-lisp-mode) 58 (emacs-lisp-mode)
73 ;; B is optional and equals 1+a if not provided. HAS-BS is non-nil 59 (insert "(cl-defmethod test :around ((a (eql smthg))) \"Return A.\")")
74 ;; if B was provided in the call:
75 (insert "(cl-defun foo (a &optional (b (1+ a) has-bs)) \"Return A + B.\")")
76 (checkdoc-defun))) 60 (checkdoc-defun)))
77 61
78(ert-deftest checkdoc-cl-defun-with-destructuring-ok () 62(ert-deftest checkdoc-cl-defmethod-with-extra-qualifier-ok ()
79 "Checkdoc should be happy with a cl-defun destructuring its arguments." 63 "Checkdoc should be happy with a :extra qualified `cl-defmethod'."
80 (with-temp-buffer 64 (with-temp-buffer
81 (emacs-lisp-mode) 65 (emacs-lisp-mode)
82 (insert "(cl-defun foo ((a b &optional c) d) \"Return A+B+C+D.\")") 66 (insert "(cl-defmethod foo :extra \"foo\" ((a (eql smthg))) \"Return A.\")")
83 (checkdoc-defun))) 67 (checkdoc-defun))
84 68
85(ert-deftest checkdoc-cl-defmethod-ok ()
86 "Checkdoc should be happy with a simple correct cl-defmethod."
87 (with-temp-buffer 69 (with-temp-buffer
88 (emacs-lisp-mode) 70 (emacs-lisp-mode)
89 (insert "(cl-defmethod foo (a) \"Return A.\")") 71 (insert
72 "(cl-defmethod foo :extra \"foo\" :after ((a (eql smthg))) \"Return A.\")")
90 (checkdoc-defun))) 73 (checkdoc-defun)))
91 74
92(ert-deftest checkdoc-cl-defmethod-with-types-ok () 75(ert-deftest checkdoc-cl-defmethod-with-extra-qualifier-and-nil-args-ok ()
93 "Checkdoc should be happy with a cl-defmethod using types." 76 "Checkdoc should be happy with a 0-arity :extra qualified `cl-defmethod'."
94 (with-temp-buffer 77 (with-temp-buffer
95 (emacs-lisp-mode) 78 (emacs-lisp-mode)
96 ;; this method matches if A is the symbol `smthg' and if b is a list: 79 (insert "(cl-defmethod foo :extra \"foo\" () \"Return A.\")")
97 (insert "(cl-defmethod foo ((a (eql smthg)) (b list)) \"Return A+B.\")")
98 (checkdoc-defun))) 80 (checkdoc-defun)))
99 81
100(ert-deftest checkdoc-cl-defun-with-key-ok () 82(ert-deftest checkdoc-cl-defun-with-key-ok ()
diff --git a/test/lisp/emacs-lisp/map-tests.el b/test/lisp/emacs-lisp/map-tests.el
index 9a2cd42a211..67666d8e7e7 100644
--- a/test/lisp/emacs-lisp/map-tests.el
+++ b/test/lisp/emacs-lisp/map-tests.el
@@ -22,7 +22,7 @@
22 22
23;;; Commentary: 23;;; Commentary:
24 24
25;; Tests for map.el 25;; Tests for map.el.
26 26
27;;; Code: 27;;; Code:
28 28
@@ -30,12 +30,10 @@
30(require 'map) 30(require 'map)
31 31
32(defmacro with-maps-do (var &rest body) 32(defmacro with-maps-do (var &rest body)
33 "Successively bind VAR to an alist, vector and hash-table. 33 "Successively bind VAR to an alist, plist, vector, and hash-table.
34Each map is built from the following alist data: 34Each map is built from the following alist data:
35'((0 . 3) (1 . 4) (2 . 5)). 35 \\='((0 . 3) (1 . 4) (2 . 5)).
36Evaluate BODY for each created map. 36Evaluate BODY for each created map."
37
38\(fn (var map) body)"
39 (declare (indent 1) (debug (symbolp body))) 37 (declare (indent 1) (debug (symbolp body)))
40 (let ((alist (make-symbol "alist")) 38 (let ((alist (make-symbol "alist"))
41 (plist (make-symbol "plist")) 39 (plist (make-symbol "plist"))
@@ -53,43 +51,62 @@ Evaluate BODY for each created map.
53 (dolist (,var (list ,alist ,plist ,vec ,ht)) 51 (dolist (,var (list ,alist ,plist ,vec ,ht))
54 ,@body)))) 52 ,@body))))
55 53
54(defmacro with-empty-maps-do (var &rest body)
55 "Like `with-maps-do', but with empty maps."
56 (declare (indent 1) (debug (symbolp body)))
57 `(dolist (,var (list (list) (vector) (make-hash-table)))
58 ,@body))
59
60(ert-deftest test-map-plist-p ()
61 "Test `map--plist-p'."
62 (with-empty-maps-do map
63 (should-not (map--plist-p map)))
64 (should-not (map--plist-p ""))
65 (should-not (map--plist-p '((()))))
66 (should (map--plist-p '(:a)))
67 (should (map--plist-p '(a)))
68 (should (map--plist-p '(nil)))
69 (should (map--plist-p '(""))))
70
56(ert-deftest test-map-elt () 71(ert-deftest test-map-elt ()
57 (with-maps-do map 72 (with-maps-do map
58 (should (= 3 (map-elt map 0))) 73 (should (= 3 (map-elt map 0)))
59 (should (= 4 (map-elt map 1))) 74 (should (= 4 (map-elt map 1)))
60 (should (= 5 (map-elt map 2))) 75 (should (= 5 (map-elt map 2)))
61 (should (null (map-elt map -1))) 76 (should-not (map-elt map -1))
62 (should (null (map-elt map 4))))) 77 (should-not (map-elt map 4))
78 (should-not (map-elt map 0.1))))
63 79
64(ert-deftest test-map-elt-default () 80(ert-deftest test-map-elt-default ()
65 (with-maps-do map 81 (with-maps-do map
66 (should (= 5 (map-elt map 7 5))))) 82 (should (= 5 (map-elt map 7 5)))
83 (should (= 5 (map-elt map 0.1 5))))
84 (with-empty-maps-do map
85 (should (= 5 (map-elt map 0 5)))))
67 86
68(ert-deftest test-map-elt-testfn () 87(ert-deftest test-map-elt-testfn ()
69 (let ((map (list (cons "a" 1) (cons "b" 2))) 88 (let ((map (list (cons "a" 1) (cons "b" 2)))
70 ;; Make sure to use a non-eq "a", even when compiled. 89 ;; Make sure to use a non-eq "a", even when compiled.
71 (noneq-key (string ?a))) 90 (noneq-key (string ?a)))
72 (should-not (map-elt map noneq-key)) 91 (should-not (map-elt map noneq-key))
73 (should (map-elt map noneq-key nil 'equal)))) 92 (should (map-elt map noneq-key nil #'equal))))
74 93
75(ert-deftest test-map-elt-with-nil-value () 94(ert-deftest test-map-elt-with-nil-value ()
76 (should (null (map-elt '((a . 1) 95 (should-not (map-elt '((a . 1) (b)) 'b 2)))
77 (b))
78 'b
79 '2))))
80 96
81(ert-deftest test-map-put! () 97(ert-deftest test-map-put! ()
82 (with-maps-do map 98 (with-maps-do map
83 (setf (map-elt map 2) 'hello) 99 (setf (map-elt map 2) 'hello)
84 (should (eq (map-elt map 2) 'hello))) 100 (should (eq (map-elt map 2) 'hello)))
85 (with-maps-do map 101 (with-maps-do map
86 (map-put map 2 'hello) 102 (with-suppressed-warnings ((obsolete map-put))
103 (map-put map 2 'hello))
87 (should (eq (map-elt map 2) 'hello))) 104 (should (eq (map-elt map 2) 'hello)))
88 (with-maps-do map 105 (with-maps-do map
89 (map-put! map 2 'hello) 106 (map-put! map 2 'hello)
90 (should (eq (map-elt map 2) 'hello)) 107 (should (eq (map-elt map 2) 'hello))
91 (if (not (or (hash-table-p map) 108 (if (not (or (hash-table-p map)
92 (and (listp map) (not (listp (car map)))))) ;plist! 109 (map--plist-p map)))
93 (should-error (map-put! map 5 'value) 110 (should-error (map-put! map 5 'value)
94 ;; For vectors, it could arguably signal 111 ;; For vectors, it could arguably signal
95 ;; map-not-inplace as well, but it currently doesn't. 112 ;; map-not-inplace as well, but it currently doesn't.
@@ -97,49 +114,88 @@ Evaluate BODY for each created map.
97 'map-not-inplace 114 'map-not-inplace
98 'error)) 115 'error))
99 (map-put! map 5 'value) 116 (map-put! map 5 'value)
100 (should (eq (map-elt map 5) 'value)))) 117 (should (eq (map-elt map 5) 'value)))))
101 (let ((ht (make-hash-table))) 118
102 (setf (map-elt ht 2) 'a) 119(ert-deftest test-map-put!-new-keys ()
103 (should (eq (map-elt ht 2) 120 "Test `map-put!' with new keys."
104 'a))) 121 (with-maps-do map
105 (let ((alist '((0 . a) (1 . b) (2 . c)))) 122 (let ((size (map-length map)))
106 (setf (map-elt alist 2) 'a) 123 (if (arrayp map)
107 (should (eq (map-elt alist 2) 124 (progn
108 'a))) 125 (should-error (setf (map-elt map 'k) 'v))
109 (let ((vec [3 4 5])) 126 (should-error (setf (map-elt map size) 'v)))
110 (should-error (setf (map-elt vec 3) 6)))) 127 (setf (map-elt map 'k) 'v)
128 (should (eq (map-elt map 'k) 'v))
129 (setf (map-elt map size) 'v)
130 (should (eq (map-elt map size) 'v))))))
111 131
112(ert-deftest test-map-put-alist-new-key () 132(ert-deftest test-map-put-alist-new-key ()
113 "Regression test for Bug#23105." 133 "Regression test for Bug#23105."
114 (let ((alist '((0 . a)))) 134 (let ((alist (list (cons 0 'a))))
115 (map-put alist 2 'b) 135 (with-suppressed-warnings ((obsolete map-put))
116 (should (eq (map-elt alist 2) 136 (map-put alist 2 'b))
117 'b)))) 137 (should (eq (map-elt alist 2) 'b))))
118 138
119(ert-deftest test-map-put-testfn-alist () 139(ert-deftest test-map-put-testfn-alist ()
120 (let ((alist (list (cons "a" 1) (cons "b" 2))) 140 (let ((alist (list (cons "a" 1) (cons "b" 2)))
121 ;; Make sure to use a non-eq "a", even when compiled. 141 ;; Make sure to use a non-eq "a", even when compiled.
122 (noneq-key (string ?a))) 142 (noneq-key (string ?a)))
123 (map-put alist noneq-key 3 #'equal) 143 (with-suppressed-warnings ((obsolete map-put))
124 (should-not (cddr alist)) 144 (map-put alist noneq-key 3 #'equal)
125 (map-put alist noneq-key 9 #'eql) 145 (should-not (cddr alist))
126 (should (cddr alist)))) 146 (map-put alist noneq-key 9 #'eql)
147 (should (cddr alist)))))
127 148
128(ert-deftest test-map-put-return-value () 149(ert-deftest test-map-put-return-value ()
129 (let ((ht (make-hash-table))) 150 (let ((ht (make-hash-table)))
130 (should (eq (map-put ht 'a 'hello) 'hello)))) 151 (with-suppressed-warnings ((obsolete map-put))
152 (should (eq (map-put ht 'a 'hello) 'hello)))))
153
154(ert-deftest test-map-insert-empty ()
155 "Test `map-insert' on empty maps."
156 (with-empty-maps-do map
157 (if (arrayp map)
158 (should-error (map-insert map 0 6))
159 (let ((new (map-insert map 0 6)))
160 (should-not (eq map new))
161 (should-not (map-pairs map))
162 (should (= (map-elt new 0) 6))))))
163
164(ert-deftest test-map-insert ()
165 "Test `map-insert'."
166 (with-maps-do map
167 (let ((pairs (map-pairs map))
168 (size (map-length map))
169 (new (map-insert map 0 6)))
170 (should-not (eq map new))
171 (should (equal (map-pairs map) pairs))
172 (should (= (map-elt new 0) 6))
173 (if (arrayp map)
174 (should-error (map-insert map size 7))
175 (setq new (map-insert map size 7))
176 (should-not (eq map new))
177 (should (equal (map-pairs map) pairs))
178 (should (= (map-elt new size) 7))))))
131 179
132(ert-deftest test-map-delete () 180(ert-deftest test-map-delete ()
133 (with-maps-do map 181 (with-maps-do map
134 (map-delete map 1) 182 (should (map-elt map 1))
135 (should (null (map-elt map 1)))) 183 (should (eq map (map-delete map 1)))
184 (should-not (map-elt map 1)))
136 (with-maps-do map 185 (with-maps-do map
137 (map-delete map -2) 186 (should-not (map-elt map -2))
138 (should (null (map-elt map -2))))) 187 (should (eq map (map-delete map -2)))
188 (should-not (map-elt map -2)))
189 (with-maps-do map
190 ;; Check for OBOE.
191 (let ((key (map-length map)))
192 (should-not (map-elt map key))
193 (should (eq map (map-delete map key)))
194 (should-not (map-elt map key)))))
139 195
140(ert-deftest test-map-delete-return-value () 196(ert-deftest test-map-delete-empty ()
141 (let ((ht (make-hash-table))) 197 (with-empty-maps-do map
142 (should (eq (map-delete ht 'a) ht)))) 198 (should (eq map (map-delete map t)))))
143 199
144(ert-deftest test-map-nested-elt () 200(ert-deftest test-map-nested-elt ()
145 (let ((vec [a b [c d [e f]]])) 201 (let ((vec [a b [c d [e f]]]))
@@ -149,8 +205,9 @@ Evaluate BODY for each created map.
149 (d . 3) 205 (d . 3)
150 (e . ((f . 4) 206 (e . ((f . 4)
151 (g . 5)))))))) 207 (g . 5))))))))
152 (should (eq (map-nested-elt alist '(b e f)) 208 (should (eq (map-nested-elt alist '(b e f)) 4)))
153 4))) 209 (let ((plist '(a 1 b (c 2 d 3 e (f 4 g 5)))))
210 (should (eq (map-nested-elt plist '(b e f)) 4)))
154 (let ((ht (make-hash-table))) 211 (let ((ht (make-hash-table)))
155 (setf (map-elt ht 'a) 1) 212 (setf (map-elt ht 'a) 1)
156 (setf (map-elt ht 'b) (make-hash-table)) 213 (setf (map-elt ht 'b) (make-hash-table))
@@ -160,214 +217,238 @@ Evaluate BODY for each created map.
160 217
161(ert-deftest test-map-nested-elt-default () 218(ert-deftest test-map-nested-elt-default ()
162 (let ((vec [a b [c d]])) 219 (let ((vec [a b [c d]]))
163 (should (null (map-nested-elt vec '(2 3)))) 220 (should-not (map-nested-elt vec '(2 3)))
164 (should (null (map-nested-elt vec '(2 1 1)))) 221 (should-not (map-nested-elt vec '(2 1 1)))
165 (should (= 4 (map-nested-elt vec '(2 1 1) 4))))) 222 (should (= 4 (map-nested-elt vec '(2 1 1) 4)))))
166 223
167(ert-deftest test-mapp () 224(ert-deftest test-mapp ()
168 (should (mapp nil)) 225 (with-empty-maps-do map
169 (should (mapp '((a . b) (c . d)))) 226 (should (mapp map)))
170 (should (mapp '(a b c d))) 227 (with-maps-do map
171 (should (mapp [])) 228 (should (mapp map)))
172 (should (mapp [1 2 3])) 229 (should (mapp ""))
173 (should (mapp (make-hash-table)))
174 (should (mapp "hello")) 230 (should (mapp "hello"))
175 (should (not (mapp 1))) 231 (should-not (mapp 1))
176 (should (not (mapp 'hello)))) 232 (should-not (mapp 'hello)))
177 233
178(ert-deftest test-map-keys () 234(ert-deftest test-map-keys ()
179 (with-maps-do map 235 (with-maps-do map
180 (should (equal (map-keys map) '(0 1 2)))) 236 (should (equal (map-keys map) '(0 1 2))))
181 (should (null (map-keys nil))) 237 (with-empty-maps-do map
182 (should (null (map-keys [])))) 238 (should-not (map-keys map))))
183 239
184(ert-deftest test-map-values () 240(ert-deftest test-map-values ()
185 (with-maps-do map 241 (with-maps-do map
186 (should (equal (map-values map) '(3 4 5))))) 242 (should (equal (map-values map) '(3 4 5))))
243 (with-empty-maps-do map
244 (should-not (map-values map))))
187 245
188(ert-deftest test-map-pairs () 246(ert-deftest test-map-pairs ()
189 (with-maps-do map 247 (with-maps-do map
190 (should (equal (map-pairs map) '((0 . 3) 248 (should (equal (map-pairs map)
191 (1 . 4) 249 '((0 . 3)
192 (2 . 5)))))) 250 (1 . 4)
251 (2 . 5)))))
252 (with-empty-maps-do map
253 (should-not (map-pairs map))))
193 254
194(ert-deftest test-map-length () 255(ert-deftest test-map-length ()
195 (let ((ht (make-hash-table))) 256 (with-empty-maps-do map
196 (puthash 'a 1 ht) 257 (should (zerop (map-length map))))
197 (puthash 'b 2 ht) 258 (with-maps-do map
198 (puthash 'c 3 ht) 259 (should (= 3 (map-length map))))
199 (puthash 'd 4 ht) 260 (should (= 1 (map-length '(nil 1))))
200 (should (= 0 (map-length nil))) 261 (should (= 2 (map-length '(nil 1 t 2))))
201 (should (= 0 (map-length []))) 262 (should (= 2 (map-length '((a . 1) (b . 2)))))
202 (should (= 0 (map-length (make-hash-table)))) 263 (should (= 5 (map-length [0 1 2 3 4])))
203 (should (= 5 (map-length [0 1 2 3 4]))) 264 (should (= 4 (map-length #s(hash-table data (a 1 b 2 c 3 d 4))))))
204 (should (= 2 (map-length '((a . 1) (b . 2)))))
205 (should (= 4 (map-length ht)))))
206 265
207(ert-deftest test-map-copy () 266(ert-deftest test-map-copy ()
208 (with-maps-do map 267 (with-maps-do map
209 (let ((copy (map-copy map))) 268 (let ((copy (map-copy map)))
210 (should (equal (map-keys map) (map-keys copy))) 269 (should (equal (map-pairs map) (map-pairs copy)))
211 (should (equal (map-values map) (map-values copy))) 270 (should-not (eq map copy))
212 (should (not (eq map copy)))))) 271 (map-put! map 0 0)
272 (should-not (equal (map-pairs map) (map-pairs copy)))))
273 (with-empty-maps-do map
274 (should-not (map-pairs (map-copy map)))))
275
276(ert-deftest test-map-copy-alist ()
277 "Test use of `copy-alist' for alists."
278 (let* ((cons (list 'a 1 2))
279 (alist (list cons))
280 (copy (map-copy alist)))
281 (setcar cons 'b)
282 (should (equal alist '((b 1 2))))
283 (should (equal copy '((a 1 2))))
284 (setcar (cdr cons) 0)
285 (should (equal alist '((b 0 2))))
286 (should (equal copy '((a 0 2))))
287 (setcdr cons 3)
288 (should (equal alist '((b . 3))))
289 (should (equal copy '((a 0 2))))))
213 290
214(ert-deftest test-map-apply () 291(ert-deftest test-map-apply ()
215 (with-maps-do map 292 (let ((fn (lambda (k v) (cons (number-to-string k) v))))
216 (should (equal (map-apply (lambda (k v) (cons (int-to-string k) v)) 293 (with-maps-do map
217 map) 294 (should (equal (map-apply fn map)
218 '(("0" . 3) ("1" . 4) ("2" . 5))))) 295 '(("0" . 3) ("1" . 4) ("2" . 5)))))
219 (let ((vec [a b c])) 296 (with-empty-maps-do map
220 (should (equal (map-apply (lambda (k v) (cons (1+ k) v)) 297 (should-not (map-apply fn map)))))
221 vec)
222 '((1 . a)
223 (2 . b)
224 (3 . c))))))
225 298
226(ert-deftest test-map-do () 299(ert-deftest test-map-do ()
227 (with-maps-do map 300 (let* (res
228 (let ((result nil)) 301 (fn (lambda (k v)
229 (map-do (lambda (k v) 302 (push (list (number-to-string k) v) res))))
230 (push (list (int-to-string k) v) result)) 303 (with-empty-maps-do map
231 map) 304 (should-not (map-do fn map))
232 (should (equal result '(("2" 5) ("1" 4) ("0" 3))))))) 305 (should-not res))
306 (with-maps-do map
307 (setq res nil)
308 (should-not (map-do fn map))
309 (should (equal res '(("2" 5) ("1" 4) ("0" 3)))))))
233 310
234(ert-deftest test-map-keys-apply () 311(ert-deftest test-map-keys-apply ()
235 (with-maps-do map 312 (with-maps-do map
236 (should (equal (map-keys-apply (lambda (k) (int-to-string k)) 313 (should (equal (map-keys-apply #'1+ map) '(1 2 3))))
237 map) 314 (with-empty-maps-do map
238 '("0" "1" "2")))) 315 (let (ks)
239 (let ((vec [a b c])) 316 (should-not (map-keys-apply (lambda (k) (push k ks)) map))
240 (should (equal (map-keys-apply (lambda (k) (1+ k)) 317 (should-not ks))))
241 vec)
242 '(1 2 3)))))
243 318
244(ert-deftest test-map-values-apply () 319(ert-deftest test-map-values-apply ()
245 (with-maps-do map 320 (with-maps-do map
246 (should (equal (map-values-apply (lambda (v) (1+ v)) 321 (should (equal (map-values-apply #'1+ map) '(4 5 6))))
247 map) 322 (with-empty-maps-do map
248 '(4 5 6)))) 323 (let (vs)
249 (let ((vec [a b c])) 324 (should-not (map-values-apply (lambda (v) (push v vs)) map))
250 (should (equal (map-values-apply (lambda (v) (symbol-name v)) 325 (should-not vs))))
251 vec)
252 '("a" "b" "c")))))
253 326
254(ert-deftest test-map-filter () 327(ert-deftest test-map-filter ()
255 (with-maps-do map 328 (with-maps-do map
256 (should (equal (map-keys (map-filter (lambda (_k v) 329 (should (equal (map-filter (lambda (_k v) (> v 3)) map)
257 (<= 4 v)) 330 '((1 . 4) (2 . 5))))
258 map)) 331 (should (equal (map-filter #'always map) (map-pairs map)))
259 '(1 2))) 332 (should-not (map-filter #'ignore map)))
260 (should (null (map-filter (lambda (k _v) 333 (with-empty-maps-do map
261 (eq 'd k)) 334 (should-not (map-filter #'always map))
262 map)))) 335 (should-not (map-filter #'ignore map))))
263 (should (null (map-filter (lambda (_k v)
264 (eq 3 v))
265 [1 2 4 5])))
266 (should (equal (map-filter (lambda (k _v)
267 (eq 3 k))
268 [1 2 4 5])
269 '((3 . 5)))))
270 336
271(ert-deftest test-map-remove () 337(ert-deftest test-map-remove ()
272 (with-maps-do map 338 (with-maps-do map
273 (should (equal (map-keys (map-remove (lambda (_k v) 339 (should (equal (map-remove (lambda (_k v) (> v 3)) map)
274 (>= v 4)) 340 '((0 . 3))))
275 map)) 341 (should (equal (map-remove #'ignore map) (map-pairs map)))
276 '(0))) 342 (should-not (map-remove #'always map)))
277 (should (equal (map-keys (map-remove (lambda (k _v) 343 (with-empty-maps-do map
278 (eq 'd k)) 344 (should-not (map-remove #'always map))
279 map)) 345 (should-not (map-remove #'ignore map))))
280 (map-keys map))))
281 (should (equal (map-remove (lambda (_k v)
282 (eq 3 v))
283 [1 2 4 5])
284 '((0 . 1)
285 (1 . 2)
286 (2 . 4)
287 (3 . 5))))
288 (should (null (map-remove (lambda (k _v)
289 (>= k 0))
290 [1 2 4 5]))))
291 346
292(ert-deftest test-map-empty-p () 347(ert-deftest test-map-empty-p ()
293 (should (map-empty-p nil)) 348 (with-empty-maps-do map
294 (should (not (map-empty-p '((a . b) (c . d))))) 349 (should (map-empty-p map)))
295 (should (map-empty-p [])) 350 (should (map-empty-p ""))
296 (should (not (map-empty-p [1 2 3]))) 351 (should-not (map-empty-p '((a . b) (c . d))))
297 (should (map-empty-p (make-hash-table))) 352 (should-not (map-empty-p [1 2 3]))
298 (should (not (map-empty-p "hello"))) 353 (should-not (map-empty-p "hello")))
299 (should (map-empty-p "")))
300 354
301(ert-deftest test-map-contains-key () 355(ert-deftest test-map-contains-key ()
302 (should (map-contains-key '((a . 1) (b . 2)) 'a)) 356 (with-empty-maps-do map
303 (should (not (map-contains-key '((a . 1) (b . 2)) 'c))) 357 (should-not (map-contains-key map -1))
304 (should (map-contains-key '(("a" . 1)) "a")) 358 (should-not (map-contains-key map 0))
305 (should (not (map-contains-key '(("a" . 1)) "a" #'eq))) 359 (should-not (map-contains-key map 1))
306 (should (map-contains-key [a b c] 2)) 360 (should-not (map-contains-key map (map-length map))))
307 (should (not (map-contains-key [a b c] 3)))) 361 (with-maps-do map
362 (should-not (map-contains-key map -1))
363 (should (map-contains-key map 0))
364 (should (map-contains-key map 1))
365 (should-not (map-contains-key map (map-length map)))))
366
367(ert-deftest test-map-contains-key-testfn ()
368 "Test `map-contains-key' under different equalities."
369 (let ((key (string ?a))
370 (plist '("a" 1 a 2))
371 (alist '(("a" . 1) (a . 2))))
372 (should (map-contains-key alist 'a))
373 (should (map-contains-key plist 'a))
374 (should (map-contains-key alist 'a #'eq))
375 (should (map-contains-key plist 'a #'eq))
376 (should (map-contains-key alist key))
377 (should-not (map-contains-key plist key))
378 (should-not (map-contains-key alist key #'eq))
379 (should-not (map-contains-key plist key #'eq))))
308 380
309(ert-deftest test-map-some () 381(ert-deftest test-map-some ()
310 (with-maps-do map 382 (with-maps-do map
311 (should (map-some (lambda (k _v) 383 (should (eq (map-some (lambda (k _v) (and (= k 1) 'found)) map)
312 (eq 1 k)) 384 'found))
313 map)) 385 (should-not (map-some #'ignore map)))
314 (should-not (map-some (lambda (k _v) 386 (with-empty-maps-do map
315 (eq 'd k)) 387 (should-not (map-some #'always map))
316 map))) 388 (should-not (map-some #'ignore map))))
317 (let ((vec [a b c]))
318 (should (map-some (lambda (k _v)
319 (> k 1))
320 vec))
321 (should-not (map-some (lambda (k _v)
322 (> k 3))
323 vec))))
324 389
325(ert-deftest test-map-every-p () 390(ert-deftest test-map-every-p ()
326 (with-maps-do map 391 (with-maps-do map
327 (should (map-every-p (lambda (k _v) 392 (should (map-every-p #'always map))
328 k) 393 (should-not (map-every-p #'ignore map))
329 map)) 394 (should-not (map-every-p (lambda (k _v) (zerop k)) map)))
330 (should (not (map-every-p (lambda (_k _v) 395 (with-empty-maps-do map
331 nil) 396 (should (map-every-p #'always map))
332 map)))) 397 (should (map-every-p #'ignore map))
333 (let ((vec [a b c])) 398 (should (map-every-p (lambda (k _v) (zerop k)) map))))
334 (should (map-every-p (lambda (k _v)
335 (>= k 0))
336 vec))
337 (should (not (map-every-p (lambda (k _v)
338 (> k 3))
339 vec)))))
340 399
341(ert-deftest test-map-into () 400(ert-deftest test-map-into ()
342 (let* ((alist '((a . 1) (b . 2))) 401 (let* ((plist '(a 1 b 2))
402 (alist '((a . 1) (b . 2)))
343 (ht (map-into alist 'hash-table)) 403 (ht (map-into alist 'hash-table))
344 (ht2 (map-into alist '(hash-table :test equal)))) 404 (ht2 (map-into alist '(hash-table :test equal))))
345 (should (hash-table-p ht)) 405 (should (hash-table-p ht))
346 (should (equal (map-into (map-into alist 'hash-table) 'list) 406 (should (equal (map-into ht 'list) alist))
347 alist)) 407 (should (equal (map-pairs (map-into (map-into ht 'list) 'hash-table))
348 (should (listp (map-into ht 'list))) 408 (map-pairs ht)))
349 (should (equal (map-keys (map-into (map-into ht 'list) 'hash-table))
350 (map-keys ht)))
351 (should (equal (map-values (map-into (map-into ht 'list) 'hash-table))
352 (map-values ht)))
353 (should (equal (map-into ht 'alist) (map-into ht2 'alist))) 409 (should (equal (map-into ht 'alist) (map-into ht2 'alist)))
354 (should (eq (hash-table-test ht2) 'equal)) 410 (should (equal (map-into alist 'list) alist))
355 (should (null (map-into nil 'list))) 411 (should (equal (map-into alist 'alist) alist))
356 (should (map-empty-p (map-into nil 'hash-table))) 412 (should (equal (map-into alist 'plist) plist))
357 (should-error (map-into [1 2 3] 'string)))) 413 (should (equal (map-into plist 'alist) alist))
414 (should (equal (map-into plist 'plist) plist)))
415 (should-error (map-into [1 2 3] 'string) :type 'cl-no-applicable-method))
416
417(ert-deftest test-map-into-hash-test ()
418 "Test `map-into' with different hash-table test functions."
419 (should (eq (hash-table-test (map-into () 'hash-table)) #'equal))
420 (should (eq (hash-table-test (map-into () '(hash-table))) #'eql))
421 (should (eq (hash-table-test (map-into () '(hash-table :test eq))) #'eq))
422 (should (eq (hash-table-test (map-into () '(hash-table :test eql))) #'eql))
423 (should (eq (hash-table-test (map-into () '(hash-table :test equal)))
424 #'equal)))
425
426(ert-deftest test-map-into-empty ()
427 "Test `map-into' with empty maps."
428 (with-empty-maps-do map
429 (should-not (map-into map 'list))
430 (should-not (map-into map 'alist))
431 (should-not (map-into map 'plist))
432 (should (map-empty-p (map-into map 'hash-table)))))
358 433
359(ert-deftest test-map-let () 434(ert-deftest test-map-let ()
360 (map-let (foo bar baz) '((foo . 1) (bar . 2)) 435 (map-let (foo bar baz) '((foo . 1) (bar . 2))
361 (should (= foo 1)) 436 (should (= foo 1))
362 (should (= bar 2)) 437 (should (= bar 2))
363 (should (null baz))) 438 (should-not baz))
364 (map-let (('foo a) 439 (map-let (('foo a)
365 ('bar b) 440 ('bar b)
366 ('baz c)) 441 ('baz c))
367 '((foo . 1) (bar . 2)) 442 '((foo . 1) (bar . 2))
368 (should (= a 1)) 443 (should (= a 1))
369 (should (= b 2)) 444 (should (= b 2))
370 (should (null c)))) 445 (should-not c)))
446
447(ert-deftest test-map-merge ()
448 "Test `map-merge'."
449 (should (equal (map-merge 'list '(a 1) '((b . 2) (c . 3))
450 #s(hash-table data (c 4)))
451 '((c . 4) (b . 2) (a . 1)))))
371 452
372(ert-deftest test-map-merge-with () 453(ert-deftest test-map-merge-with ()
373 (should (equal (map-merge-with 'list #'+ 454 (should (equal (map-merge-with 'list #'+
@@ -376,6 +457,19 @@ Evaluate BODY for each created map.
376 '((1 . 1) (2 . 5) (3 . 0))) 457 '((1 . 1) (2 . 5) (3 . 0)))
377 '((3 . 0) (2 . 9) (1 . 6))))) 458 '((3 . 0) (2 . 9) (1 . 6)))))
378 459
460(ert-deftest test-map-merge-empty ()
461 "Test merging of empty maps."
462 (should-not (map-merge 'list))
463 (should-not (map-merge 'alist))
464 (should-not (map-merge 'plist))
465 (should-not (map-merge-with 'list #'+))
466 (should-not (map-merge-with 'alist #'+))
467 (should-not (map-merge-with 'plist #'+))
468 (should (map-empty-p (map-merge 'hash-table)))
469 (should (map-empty-p (map-merge-with 'hash-table #'+)))
470 (should-error (map-merge 'array) :type 'cl-no-applicable-method)
471 (should-error (map-merge-with 'array #'+) :type 'cl-no-applicable-method))
472
379(ert-deftest test-map-plist-pcase () 473(ert-deftest test-map-plist-pcase ()
380 (let ((plist '(:one 1 :two 2))) 474 (let ((plist '(:one 1 :two 2)))
381 (should (equal (pcase-let (((map :one (:two two)) plist)) 475 (should (equal (pcase-let (((map :one (:two two)) plist))
diff --git a/test/lisp/emacs-lisp/pcase-tests.el b/test/lisp/emacs-lisp/pcase-tests.el
index e6f4c097504..2120139ec18 100644
--- a/test/lisp/emacs-lisp/pcase-tests.el
+++ b/test/lisp/emacs-lisp/pcase-tests.el
@@ -75,8 +75,29 @@
75(ert-deftest pcase-tests-vectors () 75(ert-deftest pcase-tests-vectors ()
76 (should (equal (pcase [1 2] (`[,x] 1) (`[,x ,y] (+ x y))) 3))) 76 (should (equal (pcase [1 2] (`[,x] 1) (`[,x ,y] (+ x y))) 3)))
77 77
78;; Local Variables: 78(ert-deftest pcase-tests-bug14773 ()
79;; no-byte-compile: t 79 (let ((f (lambda (x)
80;; End: 80 (pcase 'dummy
81 ((and (let var x) (guard var)) 'left)
82 ((and (let var (not x)) (guard var)) 'right)))))
83 (should (equal (funcall f t) 'left))
84 (should (equal (funcall f nil) 'right))))
85
86(ert-deftest pcase-tests-bug46786 ()
87 (let ((self 'outer))
88 (ignore self)
89 (should (equal (cl-macrolet ((show-self () `(list 'self self)))
90 (pcase-let ((`(,self ,_self2) '(inner "2")))
91 (show-self)))
92 '(self inner)))))
93
94(ert-deftest pcase-tests-or-vars ()
95 (let ((f (lambda (v)
96 (pcase v
97 ((or (and 'b1 (let x1 4) (let x2 5))
98 (and 'b2 (let y1 8) (let y2 9)))
99 (list x1 x2 y1 y2))))))
100 (should (equal (funcall f 'b1) '(4 5 nil nil)))
101 (should (equal (funcall f 'b2) '(nil nil 8 9)))))
81 102
82;;; pcase-tests.el ends here. 103;;; pcase-tests.el ends here.
diff --git a/test/lisp/emacs-lisp/rx-tests.el b/test/lisp/emacs-lisp/rx-tests.el
index fecdcf55aff..2dd1bca22d1 100644
--- a/test/lisp/emacs-lisp/rx-tests.el
+++ b/test/lisp/emacs-lisp/rx-tests.el
@@ -156,6 +156,8 @@
156 "....."))) 156 ".....")))
157 157
158(ert-deftest rx-pcase () 158(ert-deftest rx-pcase ()
159 (should (equal (pcase "i18n" ((rx (let x (+ digit))) (list 'ok x)))
160 '(ok "18")))
159 (should (equal (pcase "a 1 2 3 1 1 b" 161 (should (equal (pcase "a 1 2 3 1 1 b"
160 ((rx (let u (+ digit)) space 162 ((rx (let u (+ digit)) space
161 (let v (+ digit)) space 163 (let v (+ digit)) space
@@ -176,6 +178,12 @@
176 ((rx nonl) 'wrong) 178 ((rx nonl) 'wrong)
177 (_ 'correct)) 179 (_ 'correct))
178 'correct)) 180 'correct))
181 (should (equal (pcase "PQR"
182 ((and (rx (let a nonl)) (rx ?z))
183 (list 'one a))
184 ((rx (let b ?Q))
185 (list 'two b)))
186 '(two "Q")))
179 (should (equal (pcase-let (((rx ?B (let z nonl)) "ABC")) 187 (should (equal (pcase-let (((rx ?B (let z nonl)) "ABC"))
180 (list 'ok z)) 188 (list 'ok z))
181 '(ok "C"))) 189 '(ok "C")))
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 26e14b98e91..d13397274aa 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -23,6 +23,7 @@
23 23
24(require 'ert) 24(require 'ert)
25(require 'erc) 25(require 'erc)
26(require 'erc-ring)
26 27
27(ert-deftest erc--read-time-period () 28(ert-deftest erc--read-time-period ()
28 (cl-letf (((symbol-function 'read-string) (lambda (&rest _) ""))) 29 (cl-letf (((symbol-function 'read-string) (lambda (&rest _) "")))
@@ -45,3 +46,66 @@
45 46
46 (cl-letf (((symbol-function 'read-string) (lambda (&rest _) "1d"))) 47 (cl-letf (((symbol-function 'read-string) (lambda (&rest _) "1d")))
47 (should (equal (erc--read-time-period "foo: ") 86400)))) 48 (should (equal (erc--read-time-period "foo: ") 86400))))
49
50(ert-deftest erc-ring-previous-command-base-case ()
51 (ert-info ("Create ring when nonexistent and do nothing")
52 (let (erc-input-ring
53 erc-input-ring-index)
54 (erc-previous-command)
55 (should (ring-p erc-input-ring))
56 (should (zerop (ring-length erc-input-ring)))
57 (should-not erc-input-ring-index)))
58 (should-not erc-input-ring))
59
60(ert-deftest erc-ring-previous-command ()
61 (with-current-buffer (get-buffer-create "*#fake*")
62 (erc-mode)
63 (insert "\n\n")
64 (setq erc-input-marker (make-marker) ; these are all local
65 erc-insert-marker (make-marker)
66 erc-send-completed-hook nil)
67 (set-marker erc-insert-marker (point-max))
68 (erc-display-prompt)
69 (should (= (point) erc-input-marker))
70 (add-hook 'erc-pre-send-functions #'erc-add-to-input-ring nil t)
71 ;;
72 (cl-letf (((symbol-function 'erc-process-input-line)
73 (lambda (&rest _)
74 (insert-before-markers
75 (erc-display-message-highlight 'notice "echo: one\n"))))
76 ((symbol-function 'erc-command-no-process-p)
77 (lambda (&rest _) t)))
78 (ert-info ("Create ring, populate, recall")
79 (insert "/one")
80 (erc-send-current-line)
81 (should (ring-p erc-input-ring))
82 (should (zerop (ring-member erc-input-ring "/one"))) ; equal
83 (should (save-excursion (forward-line -1) (goto-char (point-at-bol))
84 (looking-at-p "[*]+ echo: one")))
85 (should-not erc-input-ring-index)
86 (erc-bol)
87 (should (looking-at "$"))
88 (erc-previous-command)
89 (erc-bol)
90 (should (looking-at "/one"))
91 (should (zerop erc-input-ring-index)))
92 (ert-info ("Back to one")
93 (should (= (ring-length erc-input-ring) (1+ erc-input-ring-index)))
94 (erc-previous-command)
95 (should-not erc-input-ring-index)
96 (erc-bol)
97 (should (looking-at "$"))
98 (should (equal (ring-ref erc-input-ring 0) "/one")))
99 (ert-info ("Swap input after prompt with previous (#bug46339)")
100 (insert "abc")
101 (erc-previous-command)
102 (should (= 1 erc-input-ring-index))
103 (erc-bol)
104 (should (looking-at "/one"))
105 (should (equal (ring-ref erc-input-ring 0) "abc"))
106 (should (equal (ring-ref erc-input-ring 1) "/one"))
107 (erc-next-command)
108 (erc-bol)
109 (should (looking-at "abc")))))
110 (when noninteractive
111 (kill-buffer "*#fake*")))
diff --git a/test/lisp/json-tests.el b/test/lisp/json-tests.el
index 9886dc0d457..f400fb064a6 100644
--- a/test/lisp/json-tests.el
+++ b/test/lisp/json-tests.el
@@ -329,13 +329,13 @@ Point is moved to beginning of the buffer."
329 (should (equal (read str) res))))))) 329 (should (equal (read str) res)))))))
330 330
331(ert-deftest test-json-encode-number () 331(ert-deftest test-json-encode-number ()
332 (should (equal (json-encode-number 0) "0")) 332 (should (equal (json-encode 0) "0"))
333 (should (equal (json-encode-number -0) "0")) 333 (should (equal (json-encode -0) "0"))
334 (should (equal (json-encode-number 3) "3")) 334 (should (equal (json-encode 3) "3"))
335 (should (equal (json-encode-number -5) "-5")) 335 (should (equal (json-encode -5) "-5"))
336 (should (equal (json-encode-number 123.456) "123.456")) 336 (should (equal (json-encode 123.456) "123.456"))
337 (let ((bignum (1+ most-positive-fixnum))) 337 (let ((bignum (1+ most-positive-fixnum)))
338 (should (equal (json-encode-number bignum) 338 (should (equal (json-encode bignum)
339 (number-to-string bignum))))) 339 (number-to-string bignum)))))
340 340
341;;; Strings 341;;; Strings
@@ -404,6 +404,8 @@ Point is moved to beginning of the buffer."
404 (should (equal (json-read-string) "abcαβγ"))) 404 (should (equal (json-read-string) "abcαβγ")))
405 (json-tests--with-temp-buffer "\"\\nasd\\u0444\\u044b\\u0432fgh\\t\"" 405 (json-tests--with-temp-buffer "\"\\nasd\\u0444\\u044b\\u0432fgh\\t\""
406 (should (equal (json-read-string) "\nasdфывfgh\t"))) 406 (should (equal (json-read-string) "\nasdфывfgh\t")))
407 (json-tests--with-temp-buffer "\"abc\uFFFFαβγ𝔸𝐁𝖢\\\"\\\\\""
408 (should (equal (json-read-string) "abc\uFFFFαβγ𝔸𝐁𝖢\"\\")))
407 ;; Bug#24784 409 ;; Bug#24784
408 (json-tests--with-temp-buffer "\"\\uD834\\uDD1E\"" 410 (json-tests--with-temp-buffer "\"\\uD834\\uDD1E\""
409 (should (equal (json-read-string) "\U0001D11E"))) 411 (should (equal (json-read-string) "\U0001D11E")))
@@ -418,30 +420,37 @@ Point is moved to beginning of the buffer."
418 (should (equal (json-encode-string "foo") "\"foo\"")) 420 (should (equal (json-encode-string "foo") "\"foo\""))
419 (should (equal (json-encode-string "a\n\fb") "\"a\\n\\fb\"")) 421 (should (equal (json-encode-string "a\n\fb") "\"a\\n\\fb\""))
420 (should (equal (json-encode-string "\nasdфыв\u001f\u007ffgh\t") 422 (should (equal (json-encode-string "\nasdфыв\u001f\u007ffgh\t")
421 "\"\\nasdфыв\\u001f\u007ffgh\\t\""))) 423 "\"\\nasdфыв\\u001f\u007ffgh\\t\""))
424 ;; Bug#43549.
425 (should (equal (json-encode-string (propertize "foo" 'read-only t))
426 "\"foo\""))
427 (should (equal (json-encode-string "a\0b") "\"a\\u0000b\""))
428 (should (equal (json-encode-string "abc\uFFFFαβγ𝔸𝐁𝖢\"\\")
429 "\"abc\uFFFFαβγ𝔸𝐁𝖢\\\"\\\\\"")))
422 430
423(ert-deftest test-json-encode-key () 431(ert-deftest test-json-encode-key ()
424 (should (equal (json-encode-key '##) "\"\"")) 432 (with-suppressed-warnings ((obsolete json-encode-key))
425 (should (equal (json-encode-key :) "\"\"")) 433 (should (equal (json-encode-key '##) "\"\""))
426 (should (equal (json-encode-key "") "\"\"")) 434 (should (equal (json-encode-key :) "\"\""))
427 (should (equal (json-encode-key 'a) "\"a\"")) 435 (should (equal (json-encode-key "") "\"\""))
428 (should (equal (json-encode-key :a) "\"a\"")) 436 (should (equal (json-encode-key 'a) "\"a\""))
429 (should (equal (json-encode-key "a") "\"a\"")) 437 (should (equal (json-encode-key :a) "\"a\""))
430 (should (equal (json-encode-key t) "\"t\"")) 438 (should (equal (json-encode-key "a") "\"a\""))
431 (should (equal (json-encode-key :t) "\"t\"")) 439 (should (equal (json-encode-key t) "\"t\""))
432 (should (equal (json-encode-key "t") "\"t\"")) 440 (should (equal (json-encode-key :t) "\"t\""))
433 (should (equal (json-encode-key nil) "\"nil\"")) 441 (should (equal (json-encode-key "t") "\"t\""))
434 (should (equal (json-encode-key :nil) "\"nil\"")) 442 (should (equal (json-encode-key nil) "\"nil\""))
435 (should (equal (json-encode-key "nil") "\"nil\"")) 443 (should (equal (json-encode-key :nil) "\"nil\""))
436 (should (equal (json-encode-key ":a") "\":a\"")) 444 (should (equal (json-encode-key "nil") "\"nil\""))
437 (should (equal (json-encode-key ":t") "\":t\"")) 445 (should (equal (json-encode-key ":a") "\":a\""))
438 (should (equal (json-encode-key ":nil") "\":nil\"")) 446 (should (equal (json-encode-key ":t") "\":t\""))
439 (should (equal (should-error (json-encode-key 5)) 447 (should (equal (json-encode-key ":nil") "\":nil\""))
440 '(json-key-format 5))) 448 (should (equal (should-error (json-encode-key 5))
441 (should (equal (should-error (json-encode-key ["foo"])) 449 '(json-key-format 5)))
442 '(json-key-format ["foo"]))) 450 (should (equal (should-error (json-encode-key ["foo"]))
443 (should (equal (should-error (json-encode-key '("foo"))) 451 '(json-key-format ["foo"])))
444 '(json-key-format ("foo"))))) 452 (should (equal (should-error (json-encode-key '("foo")))
453 '(json-key-format ("foo"))))))
445 454
446;;; Objects 455;;; Objects
447 456
@@ -578,45 +587,32 @@ Point is moved to beginning of the buffer."
578(ert-deftest test-json-encode-hash-table () 587(ert-deftest test-json-encode-hash-table ()
579 (let ((json-encoding-object-sort-predicate nil) 588 (let ((json-encoding-object-sort-predicate nil)
580 (json-encoding-pretty-print nil)) 589 (json-encoding-pretty-print nil))
581 (should (equal (json-encode-hash-table #s(hash-table)) "{}")) 590 (should (equal (json-encode #s(hash-table)) "{}"))
582 (should (equal (json-encode-hash-table #s(hash-table data (a 1))) 591 (should (equal (json-encode #s(hash-table data (a 1))) "{\"a\":1}"))
583 "{\"a\":1}")) 592 (should (equal (json-encode #s(hash-table data (t 1))) "{\"t\":1}"))
584 (should (equal (json-encode-hash-table #s(hash-table data (t 1))) 593 (should (equal (json-encode #s(hash-table data (nil 1))) "{\"nil\":1}"))
585 "{\"t\":1}")) 594 (should (equal (json-encode #s(hash-table data (:a 1))) "{\"a\":1}"))
586 (should (equal (json-encode-hash-table #s(hash-table data (nil 1))) 595 (should (equal (json-encode #s(hash-table data (:t 1))) "{\"t\":1}"))
587 "{\"nil\":1}")) 596 (should (equal (json-encode #s(hash-table data (:nil 1))) "{\"nil\":1}"))
588 (should (equal (json-encode-hash-table #s(hash-table data (:a 1))) 597 (should (equal (json-encode #s(hash-table test equal data ("a" 1)))
589 "{\"a\":1}"))
590 (should (equal (json-encode-hash-table #s(hash-table data (:t 1)))
591 "{\"t\":1}"))
592 (should (equal (json-encode-hash-table #s(hash-table data (:nil 1)))
593 "{\"nil\":1}"))
594 (should (equal (json-encode-hash-table
595 #s(hash-table test equal data ("a" 1)))
596 "{\"a\":1}")) 598 "{\"a\":1}"))
597 (should (equal (json-encode-hash-table 599 (should (equal (json-encode #s(hash-table test equal data ("t" 1)))
598 #s(hash-table test equal data ("t" 1)))
599 "{\"t\":1}")) 600 "{\"t\":1}"))
600 (should (equal (json-encode-hash-table 601 (should (equal (json-encode #s(hash-table test equal data ("nil" 1)))
601 #s(hash-table test equal data ("nil" 1)))
602 "{\"nil\":1}")) 602 "{\"nil\":1}"))
603 (should (equal (json-encode-hash-table 603 (should (equal (json-encode #s(hash-table test equal data (":a" 1)))
604 #s(hash-table test equal data (":a" 1)))
605 "{\":a\":1}")) 604 "{\":a\":1}"))
606 (should (equal (json-encode-hash-table 605 (should (equal (json-encode #s(hash-table test equal data (":t" 1)))
607 #s(hash-table test equal data (":t" 1)))
608 "{\":t\":1}")) 606 "{\":t\":1}"))
609 (should (equal (json-encode-hash-table 607 (should (equal (json-encode #s(hash-table test equal data (":nil" 1)))
610 #s(hash-table test equal data (":nil" 1)))
611 "{\":nil\":1}")) 608 "{\":nil\":1}"))
612 (should (member (json-encode-hash-table #s(hash-table data (t 2 :nil 1))) 609 (should (member (json-encode #s(hash-table data (t 2 :nil 1)))
613 '("{\"nil\":1,\"t\":2}" "{\"t\":2,\"nil\":1}"))) 610 '("{\"nil\":1,\"t\":2}" "{\"t\":2,\"nil\":1}")))
614 (should (member (json-encode-hash-table 611 (should (member (json-encode #s(hash-table test equal data (:t 2 ":t" 1)))
615 #s(hash-table test equal data (:t 2 ":t" 1)))
616 '("{\":t\":1,\"t\":2}" "{\"t\":2,\":t\":1}"))) 612 '("{\":t\":1,\"t\":2}" "{\"t\":2,\":t\":1}")))
617 (should (member (json-encode-hash-table #s(hash-table data (b 2 a 1))) 613 (should (member (json-encode #s(hash-table data (b 2 a 1)))
618 '("{\"a\":1,\"b\":2}" "{\"b\":2,\"a\":1}"))) 614 '("{\"a\":1,\"b\":2}" "{\"b\":2,\"a\":1}")))
619 (should (member (json-encode-hash-table #s(hash-table data (c 3 b 2 a 1))) 615 (should (member (json-encode #s(hash-table data (c 3 b 2 a 1)))
620 '("{\"a\":1,\"b\":2,\"c\":3}" 616 '("{\"a\":1,\"b\":2,\"c\":3}"
621 "{\"a\":1,\"c\":3,\"b\":2}" 617 "{\"a\":1,\"c\":3,\"b\":2}"
622 "{\"b\":2,\"a\":1,\"c\":3}" 618 "{\"b\":2,\"a\":1,\"c\":3}"
@@ -629,13 +625,12 @@ Point is moved to beginning of the buffer."
629 (json-encoding-pretty-print t) 625 (json-encoding-pretty-print t)
630 (json-encoding-default-indentation " ") 626 (json-encoding-default-indentation " ")
631 (json-encoding-lisp-style-closings nil)) 627 (json-encoding-lisp-style-closings nil))
632 (should (equal (json-encode-hash-table #s(hash-table)) "{}")) 628 (should (equal (json-encode #s(hash-table)) "{}"))
633 (should (equal (json-encode-hash-table #s(hash-table data (a 1))) 629 (should (equal (json-encode #s(hash-table data (a 1))) "{\n \"a\": 1\n}"))
634 "{\n \"a\": 1\n}")) 630 (should (member (json-encode #s(hash-table data (b 2 a 1)))
635 (should (member (json-encode-hash-table #s(hash-table data (b 2 a 1)))
636 '("{\n \"a\": 1,\n \"b\": 2\n}" 631 '("{\n \"a\": 1,\n \"b\": 2\n}"
637 "{\n \"b\": 2,\n \"a\": 1\n}"))) 632 "{\n \"b\": 2,\n \"a\": 1\n}")))
638 (should (member (json-encode-hash-table #s(hash-table data (c 3 b 2 a 1))) 633 (should (member (json-encode #s(hash-table data (c 3 b 2 a 1)))
639 '("{\n \"a\": 1,\n \"b\": 2,\n \"c\": 3\n}" 634 '("{\n \"a\": 1,\n \"b\": 2,\n \"c\": 3\n}"
640 "{\n \"a\": 1,\n \"c\": 3,\n \"b\": 2\n}" 635 "{\n \"a\": 1,\n \"c\": 3,\n \"b\": 2\n}"
641 "{\n \"b\": 2,\n \"a\": 1,\n \"c\": 3\n}" 636 "{\n \"b\": 2,\n \"a\": 1,\n \"c\": 3\n}"
@@ -648,13 +643,12 @@ Point is moved to beginning of the buffer."
648 (json-encoding-pretty-print t) 643 (json-encoding-pretty-print t)
649 (json-encoding-default-indentation " ") 644 (json-encoding-default-indentation " ")
650 (json-encoding-lisp-style-closings t)) 645 (json-encoding-lisp-style-closings t))
651 (should (equal (json-encode-hash-table #s(hash-table)) "{}")) 646 (should (equal (json-encode #s(hash-table)) "{}"))
652 (should (equal (json-encode-hash-table #s(hash-table data (a 1))) 647 (should (equal (json-encode #s(hash-table data (a 1))) "{\n \"a\": 1}"))
653 "{\n \"a\": 1}")) 648 (should (member (json-encode #s(hash-table data (b 2 a 1)))
654 (should (member (json-encode-hash-table #s(hash-table data (b 2 a 1)))
655 '("{\n \"a\": 1,\n \"b\": 2}" 649 '("{\n \"a\": 1,\n \"b\": 2}"
656 "{\n \"b\": 2,\n \"a\": 1}"))) 650 "{\n \"b\": 2,\n \"a\": 1}")))
657 (should (member (json-encode-hash-table #s(hash-table data (c 3 b 2 a 1))) 651 (should (member (json-encode #s(hash-table data (c 3 b 2 a 1)))
658 '("{\n \"a\": 1,\n \"b\": 2,\n \"c\": 3}" 652 '("{\n \"a\": 1,\n \"b\": 2,\n \"c\": 3}"
659 "{\n \"a\": 1,\n \"c\": 3,\n \"b\": 2}" 653 "{\n \"a\": 1,\n \"c\": 3,\n \"b\": 2}"
660 "{\n \"b\": 2,\n \"a\": 1,\n \"c\": 3}" 654 "{\n \"b\": 2,\n \"a\": 1,\n \"c\": 3}"
@@ -672,7 +666,7 @@ Point is moved to beginning of the buffer."
672 (#s(hash-table data (c 3 b 2 a 1)) 666 (#s(hash-table data (c 3 b 2 a 1))
673 . "{\"a\":1,\"b\":2,\"c\":3}"))) 667 . "{\"a\":1,\"b\":2,\"c\":3}")))
674 (let ((copy (map-pairs in))) 668 (let ((copy (map-pairs in)))
675 (should (equal (json-encode-hash-table in) out)) 669 (should (equal (json-encode in) out))
676 ;; Ensure sorting isn't destructive. 670 ;; Ensure sorting isn't destructive.
677 (should (seq-set-equal-p (map-pairs in) copy)))))) 671 (should (seq-set-equal-p (map-pairs in) copy))))))
678 672
@@ -785,38 +779,42 @@ Point is moved to beginning of the buffer."
785 (should (equal in copy)))))) 779 (should (equal in copy))))))
786 780
787(ert-deftest test-json-encode-list () 781(ert-deftest test-json-encode-list ()
782 "Test `json-encode-list' or its more moral equivalents."
788 (let ((json-encoding-object-sort-predicate nil) 783 (let ((json-encoding-object-sort-predicate nil)
789 (json-encoding-pretty-print nil)) 784 (json-encoding-pretty-print nil))
790 (should (equal (json-encode-list ()) "{}")) 785 ;; Trick `json-encode' into using `json--print-list'.
791 (should (equal (json-encode-list '(a)) "[\"a\"]")) 786 (let ((json-null (list nil)))
792 (should (equal (json-encode-list '(:a)) "[\"a\"]")) 787 (should (equal (json-encode ()) "{}")))
793 (should (equal (json-encode-list '("a")) "[\"a\"]")) 788 (should (equal (json-encode '(a)) "[\"a\"]"))
794 (should (equal (json-encode-list '(a 1)) "[\"a\",1]")) 789 (should (equal (json-encode '(:a)) "[\"a\"]"))
795 (should (equal (json-encode-list '("a" 1)) "[\"a\",1]")) 790 (should (equal (json-encode '("a")) "[\"a\"]"))
796 (should (equal (json-encode-list '(:a 1)) "{\"a\":1}")) 791 (should (equal (json-encode '(a 1)) "[\"a\",1]"))
797 (should (equal (json-encode-list '((a . 1))) "{\"a\":1}")) 792 (should (equal (json-encode '("a" 1)) "[\"a\",1]"))
798 (should (equal (json-encode-list '((:a . 1))) "{\"a\":1}")) 793 (should (equal (json-encode '(:a 1)) "{\"a\":1}"))
799 (should (equal (json-encode-list '(:b 2 :a)) "[\"b\",2,\"a\"]")) 794 (should (equal (json-encode '((a . 1))) "{\"a\":1}"))
800 (should (equal (json-encode-list '(4 3 2 1)) "[4,3,2,1]")) 795 (should (equal (json-encode '((:a . 1))) "{\"a\":1}"))
801 (should (equal (json-encode-list '(b 2 a 1)) "[\"b\",2,\"a\",1]")) 796 (should (equal (json-encode '(:b 2 :a)) "[\"b\",2,\"a\"]"))
802 (should (equal (json-encode-list '(:b 2 :a 1)) "{\"b\":2,\"a\":1}")) 797 (should (equal (json-encode '(4 3 2 1)) "[4,3,2,1]"))
803 (should (equal (json-encode-list '((b . 2) (a . 1))) "{\"b\":2,\"a\":1}")) 798 (should (equal (json-encode '(b 2 a 1)) "[\"b\",2,\"a\",1]"))
804 (should (equal (json-encode-list '((:b . 2) (:a . 1))) 799 (should (equal (json-encode '(:b 2 :a 1)) "{\"b\":2,\"a\":1}"))
800 (should (equal (json-encode '((b . 2) (a . 1))) "{\"b\":2,\"a\":1}"))
801 (should (equal (json-encode '((:b . 2) (:a . 1)))
805 "{\"b\":2,\"a\":1}")) 802 "{\"b\":2,\"a\":1}"))
806 (should (equal (json-encode-list '((a) 1)) "[[\"a\"],1]")) 803 (should (equal (json-encode '((a) 1)) "[[\"a\"],1]"))
807 (should (equal (json-encode-list '((:a) 1)) "[[\"a\"],1]")) 804 (should (equal (json-encode '((:a) 1)) "[[\"a\"],1]"))
808 (should (equal (json-encode-list '(("a") 1)) "[[\"a\"],1]")) 805 (should (equal (json-encode '(("a") 1)) "[[\"a\"],1]"))
809 (should (equal (json-encode-list '((a 1) 2)) "[[\"a\",1],2]")) 806 (should (equal (json-encode '((a 1) 2)) "[[\"a\",1],2]"))
810 (should (equal (json-encode-list '((:a 1) 2)) "[{\"a\":1},2]")) 807 (should (equal (json-encode '((:a 1) 2)) "[{\"a\":1},2]"))
811 (should (equal (json-encode-list '(((a . 1)) 2)) "[{\"a\":1},2]")) 808 (should (equal (json-encode '(((a . 1)) 2)) "[{\"a\":1},2]"))
812 (should (equal (json-encode-list '(:a 1 :b (2))) "{\"a\":1,\"b\":[2]}")) 809 (should (equal (json-encode '(:a 1 :b (2))) "{\"a\":1,\"b\":[2]}"))
813 (should (equal (json-encode-list '((a . 1) (b 2))) "{\"a\":1,\"b\":[2]}")) 810 (should (equal (json-encode '((a . 1) (b 2))) "{\"a\":1,\"b\":[2]}"))
814 (should-error (json-encode-list '(a . 1)) :type 'wrong-type-argument) 811 (should-error (json-encode '(a . 1)) :type 'wrong-type-argument)
815 (should-error (json-encode-list '((a . 1) 2)) :type 'wrong-type-argument) 812 (should-error (json-encode '((a . 1) 2)) :type 'wrong-type-argument)
816 (should (equal (should-error (json-encode-list [])) 813 (with-suppressed-warnings ((obsolete json-encode-list))
817 '(json-error []))) 814 (should (equal (should-error (json-encode-list []))
818 (should (equal (should-error (json-encode-list [a])) 815 '(json-error [])))
819 '(json-error [a]))))) 816 (should (equal (should-error (json-encode-list [a]))
817 '(json-error [a]))))))
820 818
821;;; Arrays 819;;; Arrays
822 820
diff --git a/test/lisp/minibuffer-tests.el b/test/lisp/minibuffer-tests.el
index 7349b191caf..791e51cdcd5 100644
--- a/test/lisp/minibuffer-tests.el
+++ b/test/lisp/minibuffer-tests.el
@@ -125,5 +125,11 @@
125 '(("completion1" "prefix1" #("suffix1" 0 7 (face shadow))))) 125 '(("completion1" "prefix1" #("suffix1" 0 7 (face shadow)))))
126 (should (equal (get-text-property 19 'face) 'shadow)))) 126 (should (equal (get-text-property 19 'face) 'shadow))))
127 127
128(ert-deftest completion-pcm--optimize-pattern ()
129 (should (equal (completion-pcm--optimize-pattern '("buf" point "f"))
130 '("buf" point "f")))
131 (should (equal (completion-pcm--optimize-pattern '(any "" any))
132 '(any))))
133
128(provide 'minibuffer-tests) 134(provide 'minibuffer-tests)
129;;; minibuffer-tests.el ends here 135;;; minibuffer-tests.el ends here
diff --git a/test/lisp/net/puny-tests.el b/test/lisp/net/puny-tests.el
index b37168f5ca7..28c0d49cbee 100644
--- a/test/lisp/net/puny-tests.el
+++ b/test/lisp/net/puny-tests.el
@@ -39,10 +39,12 @@
39 (should (string= (puny-decode-string "xn--9dbdkw") "חנוך"))) 39 (should (string= (puny-decode-string "xn--9dbdkw") "חנוך")))
40 40
41(ert-deftest puny-test-encode-domain () 41(ert-deftest puny-test-encode-domain ()
42 (should (string= (puny-encode-domain "åäö.se") "xn--4cab6c.se"))) 42 (should (string= (puny-encode-domain "åäö.se") "xn--4cab6c.se"))
43 (should (string= (puny-encode-domain "яндекс.рф") "xn--d1acpjx3f.xn--p1ai")))
43 44
44(ert-deftest puny-test-decode-domain () 45(ert-deftest puny-test-decode-domain ()
45 (should (string= (puny-decode-domain "xn--4cab6c.se") "åäö.se"))) 46 (should (string= (puny-decode-domain "xn--4cab6c.se") "åäö.se"))
47 (should (string= (puny-decode-domain "xn--d1acpjx3f.xn--p1ai") "яндекс.рф")))
46 48
47(ert-deftest puny-highly-restrictive-domain-p () 49(ert-deftest puny-highly-restrictive-domain-p ()
48 (should (puny-highly-restrictive-domain-p "foo.bar.org")) 50 (should (puny-highly-restrictive-domain-p "foo.bar.org"))
diff --git a/test/lisp/cedet/inversion-tests.el b/test/lisp/obsolete/inversion-tests.el
index c8b45d67ea1..c8b45d67ea1 100644
--- a/test/lisp/cedet/inversion-tests.el
+++ b/test/lisp/obsolete/inversion-tests.el
diff --git a/test/src/keymap-tests.el b/test/src/keymap-tests.el
index d4f5fc3f190..a9b0cb502d3 100644
--- a/test/src/keymap-tests.el
+++ b/test/src/keymap-tests.el
@@ -63,10 +63,66 @@
63 (keymap--get-keyelt object t) 63 (keymap--get-keyelt object t)
64 (should menu-item-filter-ran))) 64 (should menu-item-filter-ran)))
65 65
66(ert-deftest keymap-define-key/undefined ()
67 ;; nil (means key is undefined in this keymap),
68 (let ((map (make-keymap)))
69 (define-key map [?a] nil)
70 (should-not (lookup-key map [?a]))))
71
72(ert-deftest keymap-define-key/keyboard-macro ()
73 ;; a string (treated as a keyboard macro),
74 (let ((map (make-keymap)))
75 (define-key map [?a] "abc")
76 (should (equal (lookup-key map [?a]) "abc"))))
77
78(ert-deftest keymap-define-key/lambda ()
79 (let ((map (make-keymap)))
80 (define-key map [?a] (lambda () (interactive) nil))
81 (should (functionp (lookup-key map [?a])))))
82
83(ert-deftest keymap-define-key/keymap ()
84 ;; a keymap (to define a prefix key),
85 (let ((map (make-keymap))
86 (map2 (make-keymap)))
87 (define-key map [?a] map2)
88 (define-key map2 [?b] 'foo)
89 (should (eq (lookup-key map [?a ?b]) 'foo))))
90
91(ert-deftest keymap-define-key/menu-item ()
92 ;; or an extended menu item definition.
93 ;; (See info node ‘(elisp)Extended Menu Items’.)
94 (let ((map (make-sparse-keymap))
95 (menu (make-sparse-keymap)))
96 (define-key menu [new-file]
97 '(menu-item "Visit New File..." find-file
98 :enable (menu-bar-non-minibuffer-window-p)
99 :help "Specify a new file's name, to edit the file"))
100 (define-key map [menu-bar file] (cons "File" menu))
101 (should (eq (lookup-key map [menu-bar file new-file]) 'find-file))))
102
66(ert-deftest keymap-lookup-key () 103(ert-deftest keymap-lookup-key ()
67 (let ((map (make-keymap))) 104 (let ((map (make-keymap)))
68 (define-key map [?a] 'foo) 105 (define-key map [?a] 'foo)
69 (should (eq (lookup-key map [?a]) 'foo)))) 106 (should (eq (lookup-key map [?a]) 'foo))
107 (should-not (lookup-key map [?b]))))
108
109(ert-deftest keymap-lookup-key/list-of-keymaps ()
110 (let ((map1 (make-keymap))
111 (map2 (make-keymap)))
112 (define-key map1 [?a] 'foo)
113 (define-key map2 [?b] 'bar)
114 (should (eq (lookup-key (list map1 map2) [?a]) 'foo))
115 (should (eq (lookup-key (list map1 map2) [?b]) 'bar))
116 (should-not (lookup-key (list map1 map2) [?c]))))
117
118(ert-deftest keymap-lookup-key/too-long ()
119 (let ((map (make-keymap)))
120 (define-key map (kbd "C-c f") 'foo)
121 (should (= (lookup-key map (kbd "C-c f x")) 2))))
122
123;; TODO: Write test for the ACCEPT-DEFAULT argument.
124;; (ert-deftest keymap-lookup-key/accept-default ()
125;; ...)
70 126
71(ert-deftest describe-buffer-bindings/header-in-current-buffer () 127(ert-deftest describe-buffer-bindings/header-in-current-buffer ()
72 "Header should be inserted into the current buffer. 128 "Header should be inserted into the current buffer.