diff options
| author | Basil L. Contovounesios | 2025-02-02 17:18:52 +0100 |
|---|---|---|
| committer | Basil L. Contovounesios | 2025-02-14 15:42:52 +0100 |
| commit | 0edf094e54c721f6039b878cafb8ed02fac74a0f (patch) | |
| tree | b25e2878e1c159aca5311dd937f0230685aad445 /test | |
| parent | 9ded6fd73e929977a38d4c644aa4e9fe66e76e90 (diff) | |
| download | emacs-0edf094e54c721f6039b878cafb8ed02fac74a0f.tar.gz emacs-0edf094e54c721f6039b878cafb8ed02fac74a0f.zip | |
Consolidate some cl-lib tests
For discussion, see bug#75633#16 and the following thread:
https://lists.gnu.org/r/emacs-devel/2025-02/msg00053.html
* test/lisp/emacs-lisp/cl-extra-tests.el (cl-lib-test-remprop)
(cl-lib-test-coerce-to-vector, cl-parse-integer): Move here from
cl-lib-tests.el.
(cl-extra-test-remprop): Remove duplicate test, folding body...
(cl-get): ...into this test.
(cl-extra-test-concatenate): Remove duplicate test, folding body...
(cl-concatenate): ...into this test.
* test/lisp/emacs-lisp/cl-lib-tests.el: Update historic commentary.
(cl-lib-test-remprop, cl-lib-test-coerce-to-vector)
(cl-parse-integer): Move to cl-extra-tests.el.
(cl-lib-test-remove-if-not, cl-lib-test-remove)
(cl-lib-test-set-functions, cl-lib-test-string-position)
(cl-lib-test-mismatch, cl-nset-difference): Move to cl-seq-tests.el.
(cl-lib-test-gensym, cl-lib-keyword-names-versus-values)
(cl-lib-empty-keyargs, mystruct, cl-lib-struct-accessors)
(cl-lib-struct-constructors, cl-lib-arglist-performance, cl-the)
(cl-flet-test, cl-lib-test-typep, cl-lib-symbol-macrolet)
(cl-lib-symbol-macrolet-4+5, cl-lib-symbol-macrolet-2)
(cl-lib-symbol-macrolet-hide, cl-lib-defstruct-record): Move to
cl-macs-tests.el.
(cl-lib-test-endp): Remove duplicate test, folding body into
cl-seq-endp-test.
(cl-lib-set-difference): Remove duplicate test, folding body into
cl-set-difference-test.
* test/lisp/emacs-lisp/cl-macs-tests.el: Do not require cl-macs and
pcase.
(mystruct, cl-lib-struct-accessors, cl-lib-struct-constructors)
(cl-lib-arglist-performance, cl-lib-defstruct-record)
(cl-lib-symbol-macrolet, cl-lib-symbol-macrolet-4+5)
(cl-lib-symbol-macrolet-2, cl-lib-symbol-macrolet-hide, cl-flet-test)
(cl-lib-keyword-names-versus-values, cl-lib-empty-keyargs)
(cl-lib-test-gensym, cl-the, cl-lib-test-typep): Move here from
cl-lib-tests.el.
(cl-case-error, cl-case-warning): Fix indentation.
* test/lisp/emacs-lisp/cl-seq-tests.el: Require cl-lib rather than
cl-seq.
(cl-seq-endp-test): Absorb body of cl-lib-test-endp.
(cl-lib-test-remove, cl-lib-test-remove-if-not)
(cl-lib-test-string-position, cl-lib-test-mismatch)
(cl-lib-test-set-functions, cl-nset-difference): Move here from
cl-lib-tests.el.
(cl-set-difference-test): Absorb body of cl-lib-set-difference.
Diffstat (limited to 'test')
| -rw-r--r-- | test/lisp/emacs-lisp/cl-extra-tests.el | 70 | ||||
| -rw-r--r-- | test/lisp/emacs-lisp/cl-lib-tests.el | 322 | ||||
| -rw-r--r-- | test/lisp/emacs-lisp/cl-macs-tests.el | 134 | ||||
| -rw-r--r-- | test/lisp/emacs-lisp/cl-seq-tests.el | 153 |
4 files changed, 332 insertions, 347 deletions
diff --git a/test/lisp/emacs-lisp/cl-extra-tests.el b/test/lisp/emacs-lisp/cl-extra-tests.el index bec4e373201..75533b36f29 100644 --- a/test/lisp/emacs-lisp/cl-extra-tests.el +++ b/test/lisp/emacs-lisp/cl-extra-tests.el | |||
| @@ -22,12 +22,55 @@ | |||
| 22 | (require 'cl-lib) | 22 | (require 'cl-lib) |
| 23 | (require 'ert) | 23 | (require 'ert) |
| 24 | 24 | ||
| 25 | (ert-deftest cl-lib-test-remprop () | ||
| 26 | (let ((x (cl-gensym))) | ||
| 27 | (should (equal (symbol-plist x) '())) | ||
| 28 | ;; Remove nonexistent property on empty plist. | ||
| 29 | (cl-remprop x 'b) | ||
| 30 | (should (equal (symbol-plist x) '())) | ||
| 31 | (put x 'a 1) | ||
| 32 | (should (equal (symbol-plist x) '(a 1))) | ||
| 33 | ;; Remove nonexistent property on nonempty plist. | ||
| 34 | (cl-remprop x 'b) | ||
| 35 | (should (equal (symbol-plist x) '(a 1))) | ||
| 36 | (put x 'b 2) | ||
| 37 | (put x 'c 3) | ||
| 38 | (put x 'd 4) | ||
| 39 | (should (equal (symbol-plist x) '(a 1 b 2 c 3 d 4))) | ||
| 40 | ;; Remove property that is neither first nor last. | ||
| 41 | (cl-remprop x 'c) | ||
| 42 | (should (equal (symbol-plist x) '(a 1 b 2 d 4))) | ||
| 43 | ;; Remove last property from a plist of length >1. | ||
| 44 | (cl-remprop x 'd) | ||
| 45 | (should (equal (symbol-plist x) '(a 1 b 2))) | ||
| 46 | ;; Remove first property from a plist of length >1. | ||
| 47 | (cl-remprop x 'a) | ||
| 48 | (should (equal (symbol-plist x) '(b 2))) | ||
| 49 | ;; Remove property when there is only one. | ||
| 50 | (cl-remprop x 'b) | ||
| 51 | (should (equal (symbol-plist x) '())))) | ||
| 52 | |||
| 25 | (ert-deftest cl-get () | 53 | (ert-deftest cl-get () |
| 26 | (put 'cl-get-test 'x 1) | 54 | (put 'cl-get-test 'x 1) |
| 27 | (put 'cl-get-test 'y nil) | 55 | (put 'cl-get-test 'y nil) |
| 28 | (should (eq (cl-get 'cl-get-test 'x) 1)) | 56 | (should (eq (cl-get 'cl-get-test 'x) 1)) |
| 29 | (should (eq (cl-get 'cl-get-test 'y :none) nil)) | 57 | (should (eq (cl-get 'cl-get-test 'y :none) nil)) |
| 30 | (should (eq (cl-get 'cl-get-test 'z :none) :none))) | 58 | (should (eq (cl-get 'cl-get-test 'z :none) :none)) |
| 59 | (let ((sym (make-symbol "test"))) | ||
| 60 | (put sym 'foo 'bar) | ||
| 61 | (should (equal (cl-get sym 'foo) 'bar)) | ||
| 62 | (cl-remprop sym 'foo) | ||
| 63 | (should (equal (cl-get sym 'foo 'default) 'default)))) | ||
| 64 | |||
| 65 | (ert-deftest cl-lib-test-coerce-to-vector () | ||
| 66 | (let* ((a (vector)) | ||
| 67 | (b (vector 1 a 3)) | ||
| 68 | (c (list)) | ||
| 69 | (d (list b a))) | ||
| 70 | (should (eql (cl-coerce a 'vector) a)) | ||
| 71 | (should (eql (cl-coerce b 'vector) b)) | ||
| 72 | (should (equal (cl-coerce c 'vector) (vector))) | ||
| 73 | (should (equal (cl-coerce d 'vector) (vector b a))))) | ||
| 31 | 74 | ||
| 32 | (ert-deftest cl-extra-test-coerce () | 75 | (ert-deftest cl-extra-test-coerce () |
| 33 | (should (equal (cl-coerce "abc" 'list) '(?a ?b ?c))) | 76 | (should (equal (cl-coerce "abc" 'list) '(?a ?b ?c))) |
| @@ -152,7 +195,8 @@ | |||
| 152 | (should (equal (cl-concatenate 'vector [1 2 3] [4 5 6]) | 195 | (should (equal (cl-concatenate 'vector [1 2 3] [4 5 6]) |
| 153 | [1 2 3 4 5 6])) | 196 | [1 2 3 4 5 6])) |
| 154 | (should (equal (cl-concatenate 'string "123" "456") | 197 | (should (equal (cl-concatenate 'string "123" "456") |
| 155 | "123456"))) | 198 | "123456")) |
| 199 | (should (equal (cl-concatenate 'list '(1 2) '(3 4) '(5 6)) '(1 2 3 4 5 6)))) | ||
| 156 | 200 | ||
| 157 | (ert-deftest cl-extra-test-mapcan () | 201 | (ert-deftest cl-extra-test-mapcan () |
| 158 | (should (equal (cl-mapcan #'list '(1 2 3)) '(1 2 3))) | 202 | (should (equal (cl-mapcan #'list '(1 2 3)) '(1 2 3))) |
| @@ -258,6 +302,17 @@ | |||
| 258 | (should (equal (cl-signum -10) -1)) | 302 | (should (equal (cl-signum -10) -1)) |
| 259 | (should (equal (cl-signum 0) 0))) | 303 | (should (equal (cl-signum 0) 0))) |
| 260 | 304 | ||
| 305 | (ert-deftest cl-parse-integer () | ||
| 306 | (should-error (cl-parse-integer "abc")) | ||
| 307 | (should (null (cl-parse-integer "abc" :junk-allowed t))) | ||
| 308 | (should (null (cl-parse-integer "" :junk-allowed t))) | ||
| 309 | (should (= 342391 (cl-parse-integer "0123456789" :radix 8 :junk-allowed t))) | ||
| 310 | (should-error (cl-parse-integer "0123456789" :radix 8)) | ||
| 311 | (should (= -239 (cl-parse-integer "-efz" :radix 16 :junk-allowed t))) | ||
| 312 | (should-error (cl-parse-integer "efz" :radix 16)) | ||
| 313 | (should (= 239 (cl-parse-integer "zzef" :radix 16 :start 2))) | ||
| 314 | (should (= -123 (cl-parse-integer " -123 ")))) | ||
| 315 | |||
| 261 | (ert-deftest cl-extra-test-parse-integer () | 316 | (ert-deftest cl-extra-test-parse-integer () |
| 262 | (should (equal (cl-parse-integer "10") 10)) | 317 | (should (equal (cl-parse-integer "10") 10)) |
| 263 | (should (equal (cl-parse-integer "-10") -10)) | 318 | (should (equal (cl-parse-integer "-10") -10)) |
| @@ -274,10 +329,6 @@ | |||
| 274 | (should (equal (cl-subseq '(1 2 3 4 5) 2) '(3 4 5))) | 329 | (should (equal (cl-subseq '(1 2 3 4 5) 2) '(3 4 5))) |
| 275 | (should (equal (cl-subseq '(1 2 3 4 5) 1 3) '(2 3)))) | 330 | (should (equal (cl-subseq '(1 2 3 4 5) 1 3) '(2 3)))) |
| 276 | 331 | ||
| 277 | (ert-deftest cl-extra-test-concatenate () | ||
| 278 | (should (equal (cl-concatenate 'string "hello " "world") "hello world")) | ||
| 279 | (should (equal (cl-concatenate 'list '(1 2) '(3 4) '(5 6)) '(1 2 3 4 5 6)))) | ||
| 280 | |||
| 281 | (ert-deftest cl-extra-test-revappend () | 332 | (ert-deftest cl-extra-test-revappend () |
| 282 | (should (equal (cl-revappend '(1 2 3) '(4 5 6)) '(3 2 1 4 5 6)))) | 333 | (should (equal (cl-revappend '(1 2 3) '(4 5 6)) '(3 2 1 4 5 6)))) |
| 283 | 334 | ||
| @@ -297,11 +348,4 @@ | |||
| 297 | (should (cl-tailp l l)) | 348 | (should (cl-tailp l l)) |
| 298 | (should (not (cl-tailp '(4 5) l))))) | 349 | (should (not (cl-tailp '(4 5) l))))) |
| 299 | 350 | ||
| 300 | (ert-deftest cl-extra-test-remprop () | ||
| 301 | (let ((sym (make-symbol "test"))) | ||
| 302 | (put sym 'foo 'bar) | ||
| 303 | (should (equal (cl-get sym 'foo) 'bar)) | ||
| 304 | (cl-remprop sym 'foo) | ||
| 305 | (should (equal (cl-get sym 'foo 'default) 'default)))) | ||
| 306 | |||
| 307 | ;;; cl-extra-tests.el ends here | 351 | ;;; cl-extra-tests.el ends here |
diff --git a/test/lisp/emacs-lisp/cl-lib-tests.el b/test/lisp/emacs-lisp/cl-lib-tests.el index ff860d94468..12de268bced 100644 --- a/test/lisp/emacs-lisp/cl-lib-tests.el +++ b/test/lisp/emacs-lisp/cl-lib-tests.el | |||
| @@ -19,229 +19,14 @@ | |||
| 19 | 19 | ||
| 20 | ;;; Commentary: | 20 | ;;; Commentary: |
| 21 | 21 | ||
| 22 | ;; Extracted from ert-tests.el, back when ert used to reimplement some | 22 | ;; Some of these tests were extracted from ert-tests.el, back when ert |
| 23 | ;; cl functions. | 23 | ;; used to reimplement some cl functions. |
| 24 | 24 | ||
| 25 | ;;; Code: | 25 | ;;; Code: |
| 26 | 26 | ||
| 27 | (require 'cl-lib) | 27 | (require 'cl-lib) |
| 28 | (require 'ert) | 28 | (require 'ert) |
| 29 | 29 | ||
| 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. | ||
| 34 | (cl-remprop x 'b) | ||
| 35 | (should (equal (symbol-plist x) '())) | ||
| 36 | (put x 'a 1) | ||
| 37 | (should (equal (symbol-plist x) '(a 1))) | ||
| 38 | ;; Remove nonexistent property on nonempty plist. | ||
| 39 | (cl-remprop x 'b) | ||
| 40 | (should (equal (symbol-plist x) '(a 1))) | ||
| 41 | (put x 'b 2) | ||
| 42 | (put x 'c 3) | ||
| 43 | (put x 'd 4) | ||
| 44 | (should (equal (symbol-plist x) '(a 1 b 2 c 3 d 4))) | ||
| 45 | ;; Remove property that is neither first nor last. | ||
| 46 | (cl-remprop x 'c) | ||
| 47 | (should (equal (symbol-plist x) '(a 1 b 2 d 4))) | ||
| 48 | ;; Remove last property from a plist of length >1. | ||
| 49 | (cl-remprop x 'd) | ||
| 50 | (should (equal (symbol-plist x) '(a 1 b 2))) | ||
| 51 | ;; Remove first property from a plist of length >1. | ||
| 52 | (cl-remprop x 'a) | ||
| 53 | (should (equal (symbol-plist x) '(b 2))) | ||
| 54 | ;; Remove property when there is only one. | ||
| 55 | (cl-remprop x 'b) | ||
| 56 | (should (equal (symbol-plist x) '())))) | ||
| 57 | |||
| 58 | (ert-deftest cl-lib-test-remove-if-not () | ||
| 59 | (let ((list (list 'a 'b 'c 'd)) | ||
| 60 | (i 0)) | ||
| 61 | (let ((result (cl-remove-if-not (lambda (x) | ||
| 62 | (should (eql x (nth i list))) | ||
| 63 | (cl-incf i) | ||
| 64 | (member i '(2 3))) | ||
| 65 | list))) | ||
| 66 | (should (equal i 4)) | ||
| 67 | (should (equal result '(b c))) | ||
| 68 | (should (equal list '(a b c d))))) | ||
| 69 | (should (equal '() | ||
| 70 | (cl-remove-if-not (lambda (_x) (should nil)) '())))) | ||
| 71 | |||
| 72 | (ert-deftest cl-lib-test-remove () | ||
| 73 | (let ((list (list 'a 'b 'c 'd)) | ||
| 74 | (key-index 0) | ||
| 75 | (test-index 0)) | ||
| 76 | (let ((result | ||
| 77 | (cl-remove 'foo list | ||
| 78 | :key (lambda (x) | ||
| 79 | (should (eql x (nth key-index list))) | ||
| 80 | (prog1 | ||
| 81 | (list key-index x) | ||
| 82 | (cl-incf key-index))) | ||
| 83 | :test | ||
| 84 | (lambda (a b) | ||
| 85 | (should (eql a 'foo)) | ||
| 86 | (should (equal b (list test-index | ||
| 87 | (nth test-index list)))) | ||
| 88 | (cl-incf test-index) | ||
| 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)) | ||
| 95 | (y (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' | ||
| 101 | (list y))))) | ||
| 102 | |||
| 103 | |||
| 104 | (ert-deftest cl-lib-test-set-functions () | ||
| 105 | (let ((c1 (cons nil nil)) | ||
| 106 | (c2 (cons nil nil)) | ||
| 107 | (sym (make-symbol "a"))) | ||
| 108 | (let ((e '()) | ||
| 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))) | ||
| 122 | |||
| 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))) | ||
| 133 | |||
| 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))) | ||
| 142 | |||
| 143 | (should (equal (cl-union b a) (list 'x 'y 'a 'b sym nil "" "x" c1 c2))) | ||
| 144 | |||
| 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)))))) | ||
| 154 | |||
| 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 | ||
| 162 | '(lambda () | ||
| 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)) | ||
| 170 | (funcall body)))) | ||
| 171 | |||
| 172 | (ert-deftest cl-lib-test-coerce-to-vector () | ||
| 173 | (let* ((a (vector)) | ||
| 174 | (b (vector 1 a 3)) | ||
| 175 | (c (list)) | ||
| 176 | (d (list b a))) | ||
| 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))))) | ||
| 181 | |||
| 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))) | ||
| 189 | |||
| 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))) | ||
| 197 | |||
| 198 | (ert-deftest cl-lib-keyword-names-versus-values () | ||
| 199 | (should (equal | ||
| 200 | (funcall (cl-function (lambda (&key a b) (list a b))) | ||
| 201 | :b :a :a 42) | ||
| 202 | '(42 :a)))) | ||
| 203 | |||
| 204 | (ert-deftest cl-lib-empty-keyargs () | ||
| 205 | (should-error (funcall (cl-function (lambda (&key) 1)) | ||
| 206 | :b 1))) | ||
| 207 | |||
| 208 | (cl-defstruct (mystruct | ||
| 209 | (:constructor cl-lib--con-1 (&aux (abc 1))) | ||
| 210 | (:constructor cl-lib--con-2 (&optional def) "Constructor docstring.")) | ||
| 211 | "General 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)))) | ||
| 224 | t))))) | ||
| 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)))) | ||
| 230 | |||
| 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)))) | ||
| 237 | |||
| 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)))) | ||
| 244 | |||
| 245 | (ert-deftest cl-lib-test-pushnew () | 30 | (ert-deftest cl-lib-test-pushnew () |
| 246 | (let ((list '(1 2 3))) | 31 | (let ((list '(1 2 3))) |
| 247 | (cl-pushnew 0 list) | 32 | (cl-pushnew 0 list) |
| @@ -468,12 +253,6 @@ | |||
| 468 | (should (equal (cl-pairlis '(a nil c) '(1 2 3)) '((a . 1) (nil . 2) (c . 3)))) | 253 | (should (equal (cl-pairlis '(a nil c) '(1 2 3)) '((a . 1) (nil . 2) (c . 3)))) |
| 469 | (should (equal (cl-pairlis '(a b c) '(1 nil 3)) '((a . 1) (b) (c . 3))))) | 254 | (should (equal (cl-pairlis '(a b c) '(1 nil 3)) '((a . 1) (b) (c . 3))))) |
| 470 | 255 | ||
| 471 | (ert-deftest cl-lib-test-endp () | ||
| 472 | (should (cl-endp '())) | ||
| 473 | (should-not (cl-endp '(1))) | ||
| 474 | (should-error (cl-endp 1) :type 'wrong-type-argument) | ||
| 475 | (should-error (cl-endp [1]) :type 'wrong-type-argument)) | ||
| 476 | |||
| 477 | (ert-deftest cl-lib-test-nth-value () | 256 | (ert-deftest cl-lib-test-nth-value () |
| 478 | (let ((vals (cl-values 2 3))) | 257 | (let ((vals (cl-values 2 3))) |
| 479 | (should (= (cl-nth-value 0 vals) 2)) | 258 | (should (= (cl-nth-value 0 vals) 2)) |
| @@ -544,70 +323,6 @@ | |||
| 544 | (should-error (cl-adjoin 1 nums :key 'int-to-string :test-not myfn-p) | 323 | (should-error (cl-adjoin 1 nums :key 'int-to-string :test-not myfn-p) |
| 545 | :type 'wrong-type-argument))) | 324 | :type 'wrong-type-argument))) |
| 546 | 325 | ||
| 547 | (ert-deftest cl-parse-integer () | ||
| 548 | (should-error (cl-parse-integer "abc")) | ||
| 549 | (should (null (cl-parse-integer "abc" :junk-allowed t))) | ||
| 550 | (should (null (cl-parse-integer "" :junk-allowed t))) | ||
| 551 | (should (= 342391 (cl-parse-integer "0123456789" :radix 8 :junk-allowed t))) | ||
| 552 | (should-error (cl-parse-integer "0123456789" :radix 8)) | ||
| 553 | (should (= -239 (cl-parse-integer "-efz" :radix 16 :junk-allowed t))) | ||
| 554 | (should-error (cl-parse-integer "efz" :radix 16)) | ||
| 555 | (should (= 239 (cl-parse-integer "zzef" :radix 16 :start 2))) | ||
| 556 | (should (= -123 (cl-parse-integer " -123 ")))) | ||
| 557 | |||
| 558 | (ert-deftest cl-flet-test () | ||
| 559 | (should (equal (cl-flet ((f1 (x) x)) (let ((x #'f1)) (funcall x 5))) 5))) | ||
| 560 | |||
| 561 | (ert-deftest cl-lib-test-typep () | ||
| 562 | (cl-deftype cl-lib-test-type (&optional x) `(member ,x)) | ||
| 563 | ;; Make sure we correctly implement the rule that deftype's optional args | ||
| 564 | ;; default to `*' rather than to nil. | ||
| 565 | (should (cl-typep '* 'cl-lib-test-type)) | ||
| 566 | (should-not (cl-typep 1 'cl-lib-test-type))) | ||
| 567 | |||
| 568 | (ert-deftest cl-lib-symbol-macrolet () | ||
| 569 | ;; bug#26325 | ||
| 570 | (should (equal (cl-flet ((f (x) (+ x 5))) | ||
| 571 | (let ((x 5)) | ||
| 572 | (f (+ x 6)))) | ||
| 573 | ;; Go through `eval', otherwise the macro-expansion | ||
| 574 | ;; error prevents running the whole test suite :-( | ||
| 575 | (eval '(cl-symbol-macrolet ((f (+ x 6))) | ||
| 576 | (cl-flet ((f (x) (+ x 5))) | ||
| 577 | (let ((x 5)) | ||
| 578 | (f f)))) | ||
| 579 | t)))) | ||
| 580 | |||
| 581 | (defmacro cl-lib-symbol-macrolet-4+5 () | ||
| 582 | ;; bug#26068 | ||
| 583 | (let* ((sname "x") | ||
| 584 | (s1 (make-symbol sname)) | ||
| 585 | (s2 (make-symbol sname))) | ||
| 586 | `(cl-symbol-macrolet ((,s1 4) | ||
| 587 | (,s2 5)) | ||
| 588 | (+ ,s1 ,s2)))) | ||
| 589 | |||
| 590 | (ert-deftest cl-lib-symbol-macrolet-2 () | ||
| 591 | (should (equal (cl-lib-symbol-macrolet-4+5) (+ 4 5)))) | ||
| 592 | |||
| 593 | |||
| 594 | (ert-deftest cl-lib-symbol-macrolet-hide () | ||
| 595 | ;; bug#26325, bug#26073 | ||
| 596 | (should (equal (let ((y 5)) | ||
| 597 | (cl-symbol-macrolet ((x y)) | ||
| 598 | (list x | ||
| 599 | (let ((x 6)) (list x y)) | ||
| 600 | (cl-letf ((x 6)) (list x y)) | ||
| 601 | (apply (lambda (x) (+ x 1)) (list 8))))) | ||
| 602 | '(5 (6 5) (6 6) 9)))) | ||
| 603 | |||
| 604 | (ert-deftest cl-lib-defstruct-record () | ||
| 605 | (cl-defstruct foo x) | ||
| 606 | (let ((x (make-foo :x 42))) | ||
| 607 | (should (recordp x)) | ||
| 608 | (should (eq (type-of x) 'foo)) | ||
| 609 | (should (eql (foo-x x) 42)))) | ||
| 610 | |||
| 611 | (ert-deftest old-struct () | 326 | (ert-deftest old-struct () |
| 612 | (cl-defstruct foo x) | 327 | (cl-defstruct foo x) |
| 613 | (with-suppressed-warnings ((obsolete cl-old-struct-compat-mode)) | 328 | (with-suppressed-warnings ((obsolete cl-old-struct-compat-mode)) |
| @@ -638,37 +353,4 @@ | |||
| 638 | (should (equal (mapcar (cl-constantly 3) '(a b c d)) | 353 | (should (equal (mapcar (cl-constantly 3) '(a b c d)) |
| 639 | '(3 3 3 3)))) | 354 | '(3 3 3 3)))) |
| 640 | 355 | ||
| 641 | (ert-deftest cl-lib-set-difference () | ||
| 642 | ;; our set-difference preserves order, though it is not required to | ||
| 643 | ;; by cl standards. Nevertheless better keep that invariant | ||
| 644 | (should (equal (cl-set-difference '(1 2 3 4) '(3 4 5 6)) | ||
| 645 | '(1 2)))) | ||
| 646 | |||
| 647 | (ert-deftest cl-nset-difference () | ||
| 648 | ;; our nset-difference doesn't | ||
| 649 | (let* ((l1 (list 1 2 3 4)) (l2 '(3 4 5 6)) | ||
| 650 | (diff (cl-nset-difference l1 l2))) | ||
| 651 | (should (memq 1 diff)) | ||
| 652 | (should (memq 2 diff)) | ||
| 653 | (should (= (length diff) 2)) | ||
| 654 | (should (equal l2 '(3 4 5 6)))) | ||
| 655 | (let* ((l1 (list "1" "2" "3" "4")) (l2 '("3" "4" "5" "6")) | ||
| 656 | (diff (cl-nset-difference l1 l2 :test #'equal))) | ||
| 657 | (should (member "1" diff)) | ||
| 658 | (should (member "2" diff)) | ||
| 659 | (should (= (length diff) 2)) | ||
| 660 | (should (equal l2 '("3" "4" "5" "6")))) | ||
| 661 | (let* ((l1 (list '(a . 1) '(b . 2) '(c . 3) '(d . 4))) | ||
| 662 | (l2 (list '(c . 3) '(d . 4) '(e . 5) '(f . 6))) | ||
| 663 | (diff (cl-nset-difference l1 l2 :key #'car))) | ||
| 664 | (should (member '(a . 1) diff)) | ||
| 665 | (should (member '(b . 2) diff)) | ||
| 666 | (should (= (length diff) 2))) | ||
| 667 | (let* ((l1 (list '("a" . 1) '("b" . 2) '("c" . 3) '("d" . 4))) | ||
| 668 | (l2 (list '("c" . 3) '("d" . 4) '("e" . 5) '("f" . 6))) | ||
| 669 | (diff (cl-nset-difference l1 l2 :key #'car :test #'string=))) | ||
| 670 | (should (member '("a" . 1) diff)) | ||
| 671 | (should (member '("b" . 2) diff)) | ||
| 672 | (should (= (length diff) 2)))) | ||
| 673 | |||
| 674 | ;;; cl-lib-tests.el ends here | 356 | ;;; cl-lib-tests.el ends here |
diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el b/test/lisp/emacs-lisp/cl-macs-tests.el index 628bae36e48..4fa5c4edba1 100644 --- a/test/lisp/emacs-lisp/cl-macs-tests.el +++ b/test/lisp/emacs-lisp/cl-macs-tests.el | |||
| @@ -22,11 +22,9 @@ | |||
| 22 | ;;; Code: | 22 | ;;; Code: |
| 23 | 23 | ||
| 24 | (require 'cl-lib) | 24 | (require 'cl-lib) |
| 25 | (require 'cl-macs) | ||
| 26 | (require 'edebug) | 25 | (require 'edebug) |
| 27 | (require 'ert) | 26 | (require 'ert) |
| 28 | (require 'ert-x) | 27 | (require 'ert-x) |
| 29 | (require 'pcase) | ||
| 30 | 28 | ||
| 31 | 29 | ||
| 32 | ;;;; cl-loop tests -- many adapted from Steele's CLtL2 | 30 | ;;;; cl-loop tests -- many adapted from Steele's CLtL2 |
| @@ -518,6 +516,45 @@ collection clause." | |||
| 518 | collect (list k x)))))) | 516 | collect (list k x)))))) |
| 519 | 517 | ||
| 520 | 518 | ||
| 519 | (cl-defstruct (mystruct | ||
| 520 | (:constructor cl-lib--con-1 (&aux (abc 1))) | ||
| 521 | (:constructor cl-lib--con-2 (&optional def) "Constructor docstring.")) | ||
| 522 | "General docstring." | ||
| 523 | (abc 5 :readonly t) (def nil)) | ||
| 524 | |||
| 525 | (ert-deftest cl-lib-struct-accessors () | ||
| 526 | (let ((x (make-mystruct :abc 1 :def 2))) | ||
| 527 | (should (eql (cl-struct-slot-value 'mystruct 'abc x) 1)) | ||
| 528 | (should (eql (cl-struct-slot-value 'mystruct 'def x) 2)) | ||
| 529 | (setf (cl-struct-slot-value 'mystruct 'def x) -1) | ||
| 530 | (should (eql (cl-struct-slot-value 'mystruct 'def x) -1)) | ||
| 531 | (should (eql (cl-struct-slot-offset 'mystruct 'abc) 1)) | ||
| 532 | (should-error (cl-struct-slot-offset 'mystruct 'marypoppins)) | ||
| 533 | (should (pcase (cl-struct-slot-info 'mystruct) | ||
| 534 | (`((cl-tag-slot) (abc 5 :readonly t) | ||
| 535 | (def . ,(or 'nil '(nil)))) | ||
| 536 | t))))) | ||
| 537 | |||
| 538 | (ert-deftest cl-lib-struct-constructors () | ||
| 539 | (should (string-match "\\`Constructor docstring." | ||
| 540 | (documentation 'cl-lib--con-2 t))) | ||
| 541 | (should (mystruct-p (cl-lib--con-1))) | ||
| 542 | (should (mystruct-p (cl-lib--con-2)))) | ||
| 543 | |||
| 544 | (ert-deftest cl-lib-arglist-performance () | ||
| 545 | ;; An `&aux' should not cause lambda's arglist to be turned into an &rest | ||
| 546 | ;; that's parsed by hand. | ||
| 547 | (should (equal () (help-function-arglist 'cl-lib--con-1))) | ||
| 548 | (should (pcase (help-function-arglist 'cl-lib--con-2) | ||
| 549 | (`(&optional ,_) t)))) | ||
| 550 | |||
| 551 | (ert-deftest cl-lib-defstruct-record () | ||
| 552 | (cl-defstruct foo x) | ||
| 553 | (let ((x (make-foo :x 42))) | ||
| 554 | (should (recordp x)) | ||
| 555 | (should (eq (type-of x) 'foo)) | ||
| 556 | (should (eql (foo-x x) 42)))) | ||
| 557 | |||
| 521 | (ert-deftest cl-defstruct/builtin-type () | 558 | (ert-deftest cl-defstruct/builtin-type () |
| 522 | (should-error | 559 | (should-error |
| 523 | (macroexpand '(cl-defstruct hash-table)) | 560 | (macroexpand '(cl-defstruct hash-table)) |
| @@ -563,6 +600,41 @@ collection clause." | |||
| 563 | m))) | 600 | m))) |
| 564 | '(42 5 42)))) | 601 | '(42 5 42)))) |
| 565 | 602 | ||
| 603 | (ert-deftest cl-lib-symbol-macrolet () | ||
| 604 | ;; bug#26325 | ||
| 605 | (should (equal (cl-flet ((f (x) (+ x 5))) | ||
| 606 | (let ((x 5)) | ||
| 607 | (f (+ x 6)))) | ||
| 608 | ;; Go through `eval', otherwise the macro-expansion | ||
| 609 | ;; error prevents running the whole test suite :-( | ||
| 610 | (eval '(cl-symbol-macrolet ((f (+ x 6))) | ||
| 611 | (cl-flet ((f (x) (+ x 5))) | ||
| 612 | (let ((x 5)) | ||
| 613 | (f f)))) | ||
| 614 | t)))) | ||
| 615 | |||
| 616 | (defmacro cl-lib-symbol-macrolet-4+5 () | ||
| 617 | ;; bug#26068 | ||
| 618 | (let* ((sname "x") | ||
| 619 | (s1 (make-symbol sname)) | ||
| 620 | (s2 (make-symbol sname))) | ||
| 621 | `(cl-symbol-macrolet ((,s1 4) | ||
| 622 | (,s2 5)) | ||
| 623 | (+ ,s1 ,s2)))) | ||
| 624 | |||
| 625 | (ert-deftest cl-lib-symbol-macrolet-2 () | ||
| 626 | (should (equal (cl-lib-symbol-macrolet-4+5) (+ 4 5)))) | ||
| 627 | |||
| 628 | (ert-deftest cl-lib-symbol-macrolet-hide () | ||
| 629 | ;; bug#26325, bug#26073 | ||
| 630 | (should (equal (let ((y 5)) | ||
| 631 | (cl-symbol-macrolet ((x y)) | ||
| 632 | (list x | ||
| 633 | (let ((x 6)) (list x y)) | ||
| 634 | (cl-letf ((x 6)) (list x y)) | ||
| 635 | (apply (lambda (x) (+ x 1)) (list 8))))) | ||
| 636 | '(5 (6 5) (6 6) 9)))) | ||
| 637 | |||
| 566 | (ert-deftest cl-macs-loop-conditional-step-clauses () | 638 | (ert-deftest cl-macs-loop-conditional-step-clauses () |
| 567 | "These tests failed under the initial fixes in #bug#29799." | 639 | "These tests failed under the initial fixes in #bug#29799." |
| 568 | (should (cl-loop for i from 1 upto 100 and j = 1 then (1+ j) | 640 | (should (cl-loop for i from 1 upto 100 and j = 1 then (1+ j) |
| @@ -718,6 +790,9 @@ collection clause." | |||
| 718 | (f lex-var))))) | 790 | (f lex-var))))) |
| 719 | (should (equal (f nil) 'a))))) | 791 | (should (equal (f nil) 'a))))) |
| 720 | 792 | ||
| 793 | (ert-deftest cl-flet-test () | ||
| 794 | (should (equal (cl-flet ((f1 (x) x)) (let ((x #'f1)) (funcall x 5))) 5))) | ||
| 795 | |||
| 721 | (ert-deftest cl-macs--test-flet-block () | 796 | (ert-deftest cl-macs--test-flet-block () |
| 722 | (should (equal (cl-block f1 | 797 | (should (equal (cl-block f1 |
| 723 | (cl-flet ((f1 (a) (cons (cl-return-from f1 a) 6))) | 798 | (cl-flet ((f1 (a) (cons (cl-return-from f1 a) 6))) |
| @@ -803,9 +878,9 @@ collection clause." | |||
| 803 | (cl-ecase val (t 1) (123 2)) | 878 | (cl-ecase val (t 1) (123 2)) |
| 804 | (cl-ecase val (123 2) (t 1)))) | 879 | (cl-ecase val (123 2) (t 1)))) |
| 805 | (ert-info ((prin1-to-string form) :prefix "Form: ") | 880 | (ert-info ((prin1-to-string form) :prefix "Form: ") |
| 806 | (let ((error (should-error (macroexpand form)))) | 881 | (let ((error (should-error (macroexpand form)))) |
| 807 | (should (equal (cdr error) | 882 | (should (equal (cdr error) |
| 808 | '("Misplaced t or `otherwise' clause")))))))) | 883 | '("Misplaced t or `otherwise' clause")))))))) |
| 809 | 884 | ||
| 810 | (ert-deftest cl-case-warning () | 885 | (ert-deftest cl-case-warning () |
| 811 | "Test that `cl-case' and `cl-ecase' warn about suspicious | 886 | "Test that `cl-case' and `cl-ecase' warn about suspicious |
| @@ -833,10 +908,10 @@ constructs." | |||
| 833 | (dolist (macro '(cl-case cl-ecase)) | 908 | (dolist (macro '(cl-case cl-ecase)) |
| 834 | (let ((form `(,macro val (,case 1)))) | 909 | (let ((form `(,macro val (,case 1)))) |
| 835 | (ert-info ((prin1-to-string form) :prefix "Form: ") | 910 | (ert-info ((prin1-to-string form) :prefix "Form: ") |
| 836 | (ert-with-message-capture messages | 911 | (ert-with-message-capture messages |
| 837 | (macroexpand form) | 912 | (macroexpand form) |
| 838 | (should (equal messages | 913 | (should (equal messages |
| 839 | (concat "Warning: " message "\n")))))))))) | 914 | (concat "Warning: " message "\n")))))))))) |
| 840 | 915 | ||
| 841 | (ert-deftest cl-case-no-warning () | 916 | (ert-deftest cl-case-no-warning () |
| 842 | "Test that `cl-case' and `cl-ecase' don't warn in some valid cases. | 917 | "Test that `cl-case' and `cl-ecase' don't warn in some valid cases. |
| @@ -875,4 +950,45 @@ See Bug#57915." | |||
| 875 | (should (equal (cl--test-s-cl--test-a x) 4)) | 950 | (should (equal (cl--test-s-cl--test-a x) 4)) |
| 876 | (should (equal (cl--test-s-b x) 'dyn))))) | 951 | (should (equal (cl--test-s-b x) 'dyn))))) |
| 877 | 952 | ||
| 953 | (ert-deftest cl-lib-keyword-names-versus-values () | ||
| 954 | (should (equal | ||
| 955 | (funcall (cl-function (lambda (&key a b) (list a b))) | ||
| 956 | :b :a :a 42) | ||
| 957 | '(42 :a)))) | ||
| 958 | |||
| 959 | (ert-deftest cl-lib-empty-keyargs () | ||
| 960 | (should-error (funcall (cl-function (lambda (&key) 1)) | ||
| 961 | :b 1))) | ||
| 962 | |||
| 963 | (ert-deftest cl-lib-test-gensym () | ||
| 964 | ;; Since the expansion of `should' calls `cl-gensym' and thus has a | ||
| 965 | ;; side-effect on `cl--gensym-counter', we have to make sure all | ||
| 966 | ;; macros in our test body are expanded before we rebind | ||
| 967 | ;; `cl--gensym-counter' and run the body. Otherwise, the test would | ||
| 968 | ;; fail if run interpreted. | ||
| 969 | (let ((body (byte-compile | ||
| 970 | '(lambda () | ||
| 971 | (should (equal (symbol-name (cl-gensym)) "G0")) | ||
| 972 | (should (equal (symbol-name (cl-gensym)) "G1")) | ||
| 973 | (should (equal (symbol-name (cl-gensym)) "G2")) | ||
| 974 | (should (equal (symbol-name (cl-gensym "foo")) "foo3")) | ||
| 975 | (should (equal (symbol-name (cl-gensym "bar")) "bar4")) | ||
| 976 | (should (equal cl--gensym-counter 5)))))) | ||
| 977 | (let ((cl--gensym-counter 0)) | ||
| 978 | (funcall body)))) | ||
| 979 | |||
| 980 | (ert-deftest cl-the () | ||
| 981 | (should (eql (cl-the integer 42) 42)) | ||
| 982 | (should-error (cl-the integer "abc")) | ||
| 983 | (let ((side-effect 0)) | ||
| 984 | (should (= (cl-the integer (cl-incf side-effect)) 1)) | ||
| 985 | (should (= side-effect 1)))) | ||
| 986 | |||
| 987 | (ert-deftest cl-lib-test-typep () | ||
| 988 | (cl-deftype cl-lib-test-type (&optional x) `(member ,x)) | ||
| 989 | ;; Make sure we correctly implement the rule that deftype's optional args | ||
| 990 | ;; default to `*' rather than to nil. | ||
| 991 | (should (cl-typep '* 'cl-lib-test-type)) | ||
| 992 | (should-not (cl-typep 1 'cl-lib-test-type))) | ||
| 993 | |||
| 878 | ;;; cl-macs-tests.el ends here | 994 | ;;; cl-macs-tests.el ends here |
diff --git a/test/lisp/emacs-lisp/cl-seq-tests.el b/test/lisp/emacs-lisp/cl-seq-tests.el index 97276be3870..2348a7fc812 100644 --- a/test/lisp/emacs-lisp/cl-seq-tests.el +++ b/test/lisp/emacs-lisp/cl-seq-tests.el | |||
| @@ -22,7 +22,7 @@ | |||
| 22 | ;;; Code: | 22 | ;;; Code: |
| 23 | 23 | ||
| 24 | (require 'ert) | 24 | (require 'ert) |
| 25 | (require 'cl-seq) | 25 | (require 'cl-lib) |
| 26 | 26 | ||
| 27 | (ert-deftest cl-union-test-00 () | 27 | (ert-deftest cl-union-test-00 () |
| 28 | "Test for bug#22729." | 28 | "Test for bug#22729." |
| @@ -54,8 +54,10 @@ Additionally register an `ert-info' to help identify test failures." | |||
| 54 | 54 | ||
| 55 | (ert-deftest cl-seq-endp-test () | 55 | (ert-deftest cl-seq-endp-test () |
| 56 | (should (cl-endp '())) | 56 | (should (cl-endp '())) |
| 57 | (should (not (cl-endp '(1 2 3)))) | 57 | (should-not (cl-endp '(1))) |
| 58 | (should-error (cl-endp 42) :type 'wrong-type-argument)) | 58 | (should-not (cl-endp '(1 2 3))) |
| 59 | (should-error (cl-endp 1) :type 'wrong-type-argument) | ||
| 60 | (should-error (cl-endp [1]) :type 'wrong-type-argument)) | ||
| 59 | 61 | ||
| 60 | (ert-deftest cl-seq-reduce-test () | 62 | (ert-deftest cl-seq-reduce-test () |
| 61 | (should (equal 6 (cl-reduce #'+ '(1 2 3)))) | 63 | (should (equal 6 (cl-reduce #'+ '(1 2 3)))) |
| @@ -97,6 +99,37 @@ Additionally register an `ert-info' to help identify test failures." | |||
| 97 | (should (equal '(1 2 a a 5 2 6) (cl-replace l1 l2 :start1 2 :end1 4))) | 99 | (should (equal '(1 2 a a 5 2 6) (cl-replace l1 l2 :start1 2 :end1 4))) |
| 98 | (should (equal '(a a 3 4 5 2 6) (cl-replace l1 l2 :start2 2 :end2 4))))) | 100 | (should (equal '(a a 3 4 5 2 6) (cl-replace l1 l2 :start2 2 :end2 4))))) |
| 99 | 101 | ||
| 102 | (ert-deftest cl-lib-test-remove () | ||
| 103 | (let ((list (list 'a 'b 'c 'd)) | ||
| 104 | (key-index 0) | ||
| 105 | (test-index 0)) | ||
| 106 | (let ((result | ||
| 107 | (cl-remove 'foo list | ||
| 108 | :key (lambda (x) | ||
| 109 | (should (eql x (nth key-index list))) | ||
| 110 | (prog1 | ||
| 111 | (list key-index x) | ||
| 112 | (cl-incf key-index))) | ||
| 113 | :test | ||
| 114 | (lambda (a b) | ||
| 115 | (should (eql a 'foo)) | ||
| 116 | (should (equal b (list test-index | ||
| 117 | (nth test-index list)))) | ||
| 118 | (cl-incf test-index) | ||
| 119 | (member test-index '(2 3)))))) | ||
| 120 | (should (equal key-index 4)) | ||
| 121 | (should (equal test-index 4)) | ||
| 122 | (should (equal result '(a d))) | ||
| 123 | (should (equal list '(a b c d))))) | ||
| 124 | (let ((x (cons nil nil)) | ||
| 125 | (y (cons nil nil))) | ||
| 126 | (should (equal (cl-remove x (list x y)) | ||
| 127 | ;; or (list x), since we use `equal' -- the | ||
| 128 | ;; important thing is that only one element got | ||
| 129 | ;; removed, this proves that the default test is | ||
| 130 | ;; `eql', not `equal' | ||
| 131 | (list y))))) | ||
| 132 | |||
| 100 | ;; keywords supported: :test :test-not :key :count :start :end :from-end | 133 | ;; keywords supported: :test :test-not :key :count :start :end :from-end |
| 101 | (ert-deftest cl-seq-remove-test () | 134 | (ert-deftest cl-seq-remove-test () |
| 102 | (let ((list '(1 2 3 4 5 2 6))) | 135 | (let ((list '(1 2 3 4 5 2 6))) |
| @@ -122,6 +155,20 @@ Additionally register an `ert-info' to help identify test failures." | |||
| 122 | (should (equal '() (cl-remove-if #'cl-evenp '()))) | 155 | (should (equal '() (cl-remove-if #'cl-evenp '()))) |
| 123 | (should (equal '() (cl-remove-if #'cl-evenp '(2))))) | 156 | (should (equal '() (cl-remove-if #'cl-evenp '(2))))) |
| 124 | 157 | ||
| 158 | (ert-deftest cl-lib-test-remove-if-not () | ||
| 159 | (let ((list (list 'a 'b 'c 'd)) | ||
| 160 | (i 0)) | ||
| 161 | (let ((result (cl-remove-if-not (lambda (x) | ||
| 162 | (should (eql x (nth i list))) | ||
| 163 | (cl-incf i) | ||
| 164 | (member i '(2 3))) | ||
| 165 | list))) | ||
| 166 | (should (equal i 4)) | ||
| 167 | (should (equal result '(b c))) | ||
| 168 | (should (equal list '(a b c d))))) | ||
| 169 | (should (equal '() | ||
| 170 | (cl-remove-if-not (lambda (_x) (should nil)) '())))) | ||
| 171 | |||
| 125 | (ert-deftest cl-remove-if-not-test () | 172 | (ert-deftest cl-remove-if-not-test () |
| 126 | (should (equal '(2 4) (cl-remove-if-not #'cl-evenp '(1 2 3 4)))) | 173 | (should (equal '(2 4) (cl-remove-if-not #'cl-evenp '(1 2 3 4)))) |
| 127 | (should (equal '(2 4) (cl-remove-if-not #'cl-evenp '(1 2 3 4) :count 2))) | 174 | (should (equal '(2 4) (cl-remove-if-not #'cl-evenp '(1 2 3 4) :count 2))) |
| @@ -309,6 +356,14 @@ Additionally register an `ert-info' to help identify test failures." | |||
| 309 | (let ((pred (lambda (x) (> (cl-position x orig :from-end t) 1)))) | 356 | (let ((pred (lambda (x) (> (cl-position x orig :from-end t) 1)))) |
| 310 | (should (equal '(b 2 3 4 5 2 6) (cl-nsubstitute 'b nil l :if-not pred)))))) | 357 | (should (equal '(b 2 3 4 5 2 6) (cl-nsubstitute 'b nil l :if-not pred)))))) |
| 311 | 358 | ||
| 359 | (ert-deftest cl-lib-test-string-position () | ||
| 360 | (should (eql (cl-position ?x "") nil)) | ||
| 361 | (should (eql (cl-position ?a "abc") 0)) | ||
| 362 | (should (eql (cl-position ?b "abc") 1)) | ||
| 363 | (should (eql (cl-position ?c "abc") 2)) | ||
| 364 | (should (eql (cl-position ?d "abc") nil)) | ||
| 365 | (should (eql (cl-position ?A "abc") nil))) | ||
| 366 | |||
| 312 | ;; keywords supported: :test :test-not :key :start :end :from-end | 367 | ;; keywords supported: :test :test-not :key :start :end :from-end |
| 313 | (ert-deftest cl-seq-position-test () | 368 | (ert-deftest cl-seq-position-test () |
| 314 | (let ((list '(1 2 3 4 5 2 6))) | 369 | (let ((list '(1 2 3 4 5 2 6))) |
| @@ -401,6 +456,14 @@ Additionally register an `ert-info' to help identify test failures." | |||
| 401 | '(1 2 3 4 5 6)))) | 456 | '(1 2 3 4 5 6)))) |
| 402 | (should (equal result 2)))) | 457 | (should (equal result 2)))) |
| 403 | 458 | ||
| 459 | (ert-deftest cl-lib-test-mismatch () | ||
| 460 | (should (eql (cl-mismatch "" "") nil)) | ||
| 461 | (should (eql (cl-mismatch "" "a") 0)) | ||
| 462 | (should (eql (cl-mismatch "a" "a") nil)) | ||
| 463 | (should (eql (cl-mismatch "ab" "a") 1)) | ||
| 464 | (should (eql (cl-mismatch "Aa" "aA") 0)) | ||
| 465 | (should (eql (cl-mismatch '(a b c) '(a b d)) 2))) | ||
| 466 | |||
| 404 | ;; keywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end | 467 | ;; keywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end |
| 405 | (ert-deftest cl-seq-mismatch-test () | 468 | (ert-deftest cl-seq-mismatch-test () |
| 406 | (let ((list '(1 2 3 4 5 2 6)) | 469 | (let ((list '(1 2 3 4 5 2 6)) |
| @@ -776,6 +839,57 @@ Additionally register an `ert-info' to help identify test failures." | |||
| 776 | '(((1 2) . 1) ((3 4) . 2) ((5) . 2))))) | 839 | '(((1 2) . 1) ((3 4) . 2) ((5) . 2))))) |
| 777 | (should (equal result '((1 2) . 1))))) | 840 | (should (equal result '((1 2) . 1))))) |
| 778 | 841 | ||
| 842 | (ert-deftest cl-lib-test-set-functions () | ||
| 843 | (let ((c1 (cons nil nil)) | ||
| 844 | (c2 (cons nil nil)) | ||
| 845 | (sym (make-symbol "a"))) | ||
| 846 | (let ((e '()) | ||
| 847 | (a (list 'a 'b sym nil "" "x" c1 c2)) | ||
| 848 | (b (list c1 'y 'b sym 'x))) | ||
| 849 | (should (equal (cl-set-difference e e) e)) | ||
| 850 | (should (equal (cl-set-difference a e) a)) | ||
| 851 | (should (equal (cl-set-difference e a) e)) | ||
| 852 | (should (equal (cl-set-difference a a) e)) | ||
| 853 | (should (equal (cl-set-difference b e) b)) | ||
| 854 | (should (equal (cl-set-difference e b) e)) | ||
| 855 | (should (equal (cl-set-difference b b) e)) | ||
| 856 | ;; Note: this test (and others) is sensitive to the order of the | ||
| 857 | ;; result, which is not documented. | ||
| 858 | (should (equal (cl-set-difference a b) (list 'a nil "" "x" c2))) | ||
| 859 | (should (equal (cl-set-difference b a) (list 'y 'x))) | ||
| 860 | |||
| 861 | ;; We aren't testing whether this is really using `eq' rather than `eql'. | ||
| 862 | (should (equal (cl-set-difference e e :test 'eq) e)) | ||
| 863 | (should (equal (cl-set-difference a e :test 'eq) a)) | ||
| 864 | (should (equal (cl-set-difference e a :test 'eq) e)) | ||
| 865 | (should (equal (cl-set-difference a a :test 'eq) e)) | ||
| 866 | (should (equal (cl-set-difference b e :test 'eq) b)) | ||
| 867 | (should (equal (cl-set-difference e b :test 'eq) e)) | ||
| 868 | (should (equal (cl-set-difference b b :test 'eq) e)) | ||
| 869 | (should (equal (cl-set-difference a b :test 'eq) (list 'a nil "" "x" c2))) | ||
| 870 | (should (equal (cl-set-difference b a :test 'eq) (list 'y 'x))) | ||
| 871 | |||
| 872 | (should (equal (cl-union e e) e)) | ||
| 873 | (should (equal (cl-union a e) a)) | ||
| 874 | (should (equal (cl-union e a) a)) | ||
| 875 | (should (equal (cl-union a a) a)) | ||
| 876 | (should (equal (cl-union b e) b)) | ||
| 877 | (should (equal (cl-union e b) b)) | ||
| 878 | (should (equal (cl-union b b) b)) | ||
| 879 | (should (equal (cl-union a b) (list 'x 'y 'a 'b sym nil "" "x" c1 c2))) | ||
| 880 | |||
| 881 | (should (equal (cl-union b a) (list 'x 'y 'a 'b sym nil "" "x" c1 c2))) | ||
| 882 | |||
| 883 | (should (equal (cl-intersection e e) e)) | ||
| 884 | (should (equal (cl-intersection a e) e)) | ||
| 885 | (should (equal (cl-intersection e a) e)) | ||
| 886 | (should (equal (cl-intersection a a) a)) | ||
| 887 | (should (equal (cl-intersection b e) e)) | ||
| 888 | (should (equal (cl-intersection e b) e)) | ||
| 889 | (should (equal (cl-intersection b b) b)) | ||
| 890 | (should (equal (cl-intersection a b) (list sym 'b c1))) | ||
| 891 | (should (equal (cl-intersection b a) (list sym 'b c1)))))) | ||
| 892 | |||
| 779 | (ert-deftest cl-intersection-test () | 893 | (ert-deftest cl-intersection-test () |
| 780 | (let ((result (cl-intersection '(1 2 3 4) '(3 4 5 6)))) | 894 | (let ((result (cl-intersection '(1 2 3 4) '(3 4 5 6)))) |
| 781 | (should (equal result '(4 3)))) | 895 | (should (equal result '(4 3)))) |
| @@ -815,8 +929,10 @@ Additionally register an `ert-info' to help identify test failures." | |||
| 815 | '(1 2 3)))) | 929 | '(1 2 3)))) |
| 816 | 930 | ||
| 817 | (ert-deftest cl-set-difference-test () | 931 | (ert-deftest cl-set-difference-test () |
| 818 | (let ((result (cl-set-difference '(1 2 3 4) '(3 4 5 6)))) | 932 | ;; Our set-difference preserves order, though it is not required to |
| 819 | (should (equal result '(1 2)))) | 933 | ;; by CL standards. Nevertheless better keep that invariant. |
| 934 | (should (equal (cl-set-difference '(1 2 3 4) '(3 4 5 6)) | ||
| 935 | '(1 2))) | ||
| 820 | (let ((result (cl-set-difference '(1 2 3) '()))) | 936 | (let ((result (cl-set-difference '(1 2 3) '()))) |
| 821 | (should (equal result '(1 2 3)))) | 937 | (should (equal result '(1 2 3)))) |
| 822 | (let ((result (cl-set-difference '(1 2 3) '(1 2 3)))) | 938 | (let ((result (cl-set-difference '(1 2 3) '(1 2 3)))) |
| @@ -843,6 +959,33 @@ Additionally register an `ert-info' to help identify test failures." | |||
| 843 | (should (equal list1 '(1 2 3))) | 959 | (should (equal list1 '(1 2 3))) |
| 844 | (should (equal list2 '(2 3 4))))) | 960 | (should (equal list2 '(2 3 4))))) |
| 845 | 961 | ||
| 962 | (ert-deftest cl-nset-difference () | ||
| 963 | ;; Our nset-difference doesn't preserve order. | ||
| 964 | (let* ((l1 (list 1 2 3 4)) (l2 '(3 4 5 6)) | ||
| 965 | (diff (cl-nset-difference l1 l2))) | ||
| 966 | (should (memq 1 diff)) | ||
| 967 | (should (memq 2 diff)) | ||
| 968 | (should (= (length diff) 2)) | ||
| 969 | (should (equal l2 '(3 4 5 6)))) | ||
| 970 | (let* ((l1 (list "1" "2" "3" "4")) (l2 '("3" "4" "5" "6")) | ||
| 971 | (diff (cl-nset-difference l1 l2 :test #'equal))) | ||
| 972 | (should (member "1" diff)) | ||
| 973 | (should (member "2" diff)) | ||
| 974 | (should (= (length diff) 2)) | ||
| 975 | (should (equal l2 '("3" "4" "5" "6")))) | ||
| 976 | (let* ((l1 (list '(a . 1) '(b . 2) '(c . 3) '(d . 4))) | ||
| 977 | (l2 (list '(c . 3) '(d . 4) '(e . 5) '(f . 6))) | ||
| 978 | (diff (cl-nset-difference l1 l2 :key #'car))) | ||
| 979 | (should (member '(a . 1) diff)) | ||
| 980 | (should (member '(b . 2) diff)) | ||
| 981 | (should (= (length diff) 2))) | ||
| 982 | (let* ((l1 (list '("a" . 1) '("b" . 2) '("c" . 3) '("d" . 4))) | ||
| 983 | (l2 (list '("c" . 3) '("d" . 4) '("e" . 5) '("f" . 6))) | ||
| 984 | (diff (cl-nset-difference l1 l2 :key #'car :test #'string=))) | ||
| 985 | (should (member '("a" . 1) diff)) | ||
| 986 | (should (member '("b" . 2) diff)) | ||
| 987 | (should (= (length diff) 2)))) | ||
| 988 | |||
| 846 | (ert-deftest cl-nset-difference-test () | 989 | (ert-deftest cl-nset-difference-test () |
| 847 | (should-not (cl-nset-difference () ())) | 990 | (should-not (cl-nset-difference () ())) |
| 848 | (should-not (cl-nset-difference () (list 1 2 3))) | 991 | (should-not (cl-nset-difference () (list 1 2 3))) |