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.
This commit is contained in:
Basil L. Contovounesios
parent
9ded6fd73e
commit
0edf094e54
4 changed files with 332 additions and 347 deletions
|
|
@ -22,12 +22,55 @@
|
|||
(require 'cl-lib)
|
||||
(require 'ert)
|
||||
|
||||
(ert-deftest cl-lib-test-remprop ()
|
||||
(let ((x (cl-gensym)))
|
||||
(should (equal (symbol-plist x) '()))
|
||||
;; Remove nonexistent property on empty plist.
|
||||
(cl-remprop x 'b)
|
||||
(should (equal (symbol-plist x) '()))
|
||||
(put x 'a 1)
|
||||
(should (equal (symbol-plist x) '(a 1)))
|
||||
;; Remove nonexistent property on nonempty plist.
|
||||
(cl-remprop x 'b)
|
||||
(should (equal (symbol-plist x) '(a 1)))
|
||||
(put x 'b 2)
|
||||
(put x 'c 3)
|
||||
(put x 'd 4)
|
||||
(should (equal (symbol-plist x) '(a 1 b 2 c 3 d 4)))
|
||||
;; Remove property that is neither first nor last.
|
||||
(cl-remprop x 'c)
|
||||
(should (equal (symbol-plist x) '(a 1 b 2 d 4)))
|
||||
;; Remove last property from a plist of length >1.
|
||||
(cl-remprop x 'd)
|
||||
(should (equal (symbol-plist x) '(a 1 b 2)))
|
||||
;; Remove first property from a plist of length >1.
|
||||
(cl-remprop x 'a)
|
||||
(should (equal (symbol-plist x) '(b 2)))
|
||||
;; Remove property when there is only one.
|
||||
(cl-remprop x 'b)
|
||||
(should (equal (symbol-plist x) '()))))
|
||||
|
||||
(ert-deftest cl-get ()
|
||||
(put 'cl-get-test 'x 1)
|
||||
(put 'cl-get-test 'y nil)
|
||||
(should (eq (cl-get 'cl-get-test 'x) 1))
|
||||
(should (eq (cl-get 'cl-get-test 'y :none) nil))
|
||||
(should (eq (cl-get 'cl-get-test 'z :none) :none)))
|
||||
(should (eq (cl-get 'cl-get-test 'z :none) :none))
|
||||
(let ((sym (make-symbol "test")))
|
||||
(put sym 'foo 'bar)
|
||||
(should (equal (cl-get sym 'foo) 'bar))
|
||||
(cl-remprop sym 'foo)
|
||||
(should (equal (cl-get sym 'foo 'default) 'default))))
|
||||
|
||||
(ert-deftest cl-lib-test-coerce-to-vector ()
|
||||
(let* ((a (vector))
|
||||
(b (vector 1 a 3))
|
||||
(c (list))
|
||||
(d (list b a)))
|
||||
(should (eql (cl-coerce a 'vector) a))
|
||||
(should (eql (cl-coerce b 'vector) b))
|
||||
(should (equal (cl-coerce c 'vector) (vector)))
|
||||
(should (equal (cl-coerce d 'vector) (vector b a)))))
|
||||
|
||||
(ert-deftest cl-extra-test-coerce ()
|
||||
(should (equal (cl-coerce "abc" 'list) '(?a ?b ?c)))
|
||||
|
|
@ -152,7 +195,8 @@
|
|||
(should (equal (cl-concatenate 'vector [1 2 3] [4 5 6])
|
||||
[1 2 3 4 5 6]))
|
||||
(should (equal (cl-concatenate 'string "123" "456")
|
||||
"123456")))
|
||||
"123456"))
|
||||
(should (equal (cl-concatenate 'list '(1 2) '(3 4) '(5 6)) '(1 2 3 4 5 6))))
|
||||
|
||||
(ert-deftest cl-extra-test-mapcan ()
|
||||
(should (equal (cl-mapcan #'list '(1 2 3)) '(1 2 3)))
|
||||
|
|
@ -258,6 +302,17 @@
|
|||
(should (equal (cl-signum -10) -1))
|
||||
(should (equal (cl-signum 0) 0)))
|
||||
|
||||
(ert-deftest cl-parse-integer ()
|
||||
(should-error (cl-parse-integer "abc"))
|
||||
(should (null (cl-parse-integer "abc" :junk-allowed t)))
|
||||
(should (null (cl-parse-integer "" :junk-allowed t)))
|
||||
(should (= 342391 (cl-parse-integer "0123456789" :radix 8 :junk-allowed t)))
|
||||
(should-error (cl-parse-integer "0123456789" :radix 8))
|
||||
(should (= -239 (cl-parse-integer "-efz" :radix 16 :junk-allowed t)))
|
||||
(should-error (cl-parse-integer "efz" :radix 16))
|
||||
(should (= 239 (cl-parse-integer "zzef" :radix 16 :start 2)))
|
||||
(should (= -123 (cl-parse-integer " -123 "))))
|
||||
|
||||
(ert-deftest cl-extra-test-parse-integer ()
|
||||
(should (equal (cl-parse-integer "10") 10))
|
||||
(should (equal (cl-parse-integer "-10") -10))
|
||||
|
|
@ -274,10 +329,6 @@
|
|||
(should (equal (cl-subseq '(1 2 3 4 5) 2) '(3 4 5)))
|
||||
(should (equal (cl-subseq '(1 2 3 4 5) 1 3) '(2 3))))
|
||||
|
||||
(ert-deftest cl-extra-test-concatenate ()
|
||||
(should (equal (cl-concatenate 'string "hello " "world") "hello world"))
|
||||
(should (equal (cl-concatenate 'list '(1 2) '(3 4) '(5 6)) '(1 2 3 4 5 6))))
|
||||
|
||||
(ert-deftest cl-extra-test-revappend ()
|
||||
(should (equal (cl-revappend '(1 2 3) '(4 5 6)) '(3 2 1 4 5 6))))
|
||||
|
||||
|
|
@ -297,11 +348,4 @@
|
|||
(should (cl-tailp l l))
|
||||
(should (not (cl-tailp '(4 5) l)))))
|
||||
|
||||
(ert-deftest cl-extra-test-remprop ()
|
||||
(let ((sym (make-symbol "test")))
|
||||
(put sym 'foo 'bar)
|
||||
(should (equal (cl-get sym 'foo) 'bar))
|
||||
(cl-remprop sym 'foo)
|
||||
(should (equal (cl-get sym 'foo 'default) 'default))))
|
||||
|
||||
;;; cl-extra-tests.el ends here
|
||||
|
|
|
|||
|
|
@ -19,229 +19,14 @@
|
|||
|
||||
;;; Commentary:
|
||||
|
||||
;; Extracted from ert-tests.el, back when ert used to reimplement some
|
||||
;; cl functions.
|
||||
;; Some of these tests were extracted from ert-tests.el, back when ert
|
||||
;; used to reimplement some cl functions.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'cl-lib)
|
||||
(require 'ert)
|
||||
|
||||
(ert-deftest cl-lib-test-remprop ()
|
||||
(let ((x (cl-gensym)))
|
||||
(should (equal (symbol-plist x) '()))
|
||||
;; Remove nonexistent property on empty plist.
|
||||
(cl-remprop x 'b)
|
||||
(should (equal (symbol-plist x) '()))
|
||||
(put x 'a 1)
|
||||
(should (equal (symbol-plist x) '(a 1)))
|
||||
;; Remove nonexistent property on nonempty plist.
|
||||
(cl-remprop x 'b)
|
||||
(should (equal (symbol-plist x) '(a 1)))
|
||||
(put x 'b 2)
|
||||
(put x 'c 3)
|
||||
(put x 'd 4)
|
||||
(should (equal (symbol-plist x) '(a 1 b 2 c 3 d 4)))
|
||||
;; Remove property that is neither first nor last.
|
||||
(cl-remprop x 'c)
|
||||
(should (equal (symbol-plist x) '(a 1 b 2 d 4)))
|
||||
;; Remove last property from a plist of length >1.
|
||||
(cl-remprop x 'd)
|
||||
(should (equal (symbol-plist x) '(a 1 b 2)))
|
||||
;; Remove first property from a plist of length >1.
|
||||
(cl-remprop x 'a)
|
||||
(should (equal (symbol-plist x) '(b 2)))
|
||||
;; Remove property when there is only one.
|
||||
(cl-remprop x 'b)
|
||||
(should (equal (symbol-plist x) '()))))
|
||||
|
||||
(ert-deftest cl-lib-test-remove-if-not ()
|
||||
(let ((list (list 'a 'b 'c 'd))
|
||||
(i 0))
|
||||
(let ((result (cl-remove-if-not (lambda (x)
|
||||
(should (eql x (nth i list)))
|
||||
(cl-incf i)
|
||||
(member i '(2 3)))
|
||||
list)))
|
||||
(should (equal i 4))
|
||||
(should (equal result '(b c)))
|
||||
(should (equal list '(a b c d)))))
|
||||
(should (equal '()
|
||||
(cl-remove-if-not (lambda (_x) (should nil)) '()))))
|
||||
|
||||
(ert-deftest cl-lib-test-remove ()
|
||||
(let ((list (list 'a 'b 'c 'd))
|
||||
(key-index 0)
|
||||
(test-index 0))
|
||||
(let ((result
|
||||
(cl-remove 'foo list
|
||||
:key (lambda (x)
|
||||
(should (eql x (nth key-index list)))
|
||||
(prog1
|
||||
(list key-index x)
|
||||
(cl-incf key-index)))
|
||||
:test
|
||||
(lambda (a b)
|
||||
(should (eql a 'foo))
|
||||
(should (equal b (list test-index
|
||||
(nth test-index list))))
|
||||
(cl-incf test-index)
|
||||
(member test-index '(2 3))))))
|
||||
(should (equal key-index 4))
|
||||
(should (equal test-index 4))
|
||||
(should (equal result '(a d)))
|
||||
(should (equal list '(a b c d)))))
|
||||
(let ((x (cons nil nil))
|
||||
(y (cons nil nil)))
|
||||
(should (equal (cl-remove x (list x y))
|
||||
;; or (list x), since we use `equal' -- the
|
||||
;; important thing is that only one element got
|
||||
;; removed, this proves that the default test is
|
||||
;; `eql', not `equal'
|
||||
(list y)))))
|
||||
|
||||
|
||||
(ert-deftest cl-lib-test-set-functions ()
|
||||
(let ((c1 (cons nil nil))
|
||||
(c2 (cons nil nil))
|
||||
(sym (make-symbol "a")))
|
||||
(let ((e '())
|
||||
(a (list 'a 'b sym nil "" "x" c1 c2))
|
||||
(b (list c1 'y 'b sym 'x)))
|
||||
(should (equal (cl-set-difference e e) e))
|
||||
(should (equal (cl-set-difference a e) a))
|
||||
(should (equal (cl-set-difference e a) e))
|
||||
(should (equal (cl-set-difference a a) e))
|
||||
(should (equal (cl-set-difference b e) b))
|
||||
(should (equal (cl-set-difference e b) e))
|
||||
(should (equal (cl-set-difference b b) e))
|
||||
;; Note: this test (and others) is sensitive to the order of the
|
||||
;; result, which is not documented.
|
||||
(should (equal (cl-set-difference a b) (list 'a nil "" "x" c2)))
|
||||
(should (equal (cl-set-difference b a) (list 'y 'x)))
|
||||
|
||||
;; We aren't testing whether this is really using `eq' rather than `eql'.
|
||||
(should (equal (cl-set-difference e e :test 'eq) e))
|
||||
(should (equal (cl-set-difference a e :test 'eq) a))
|
||||
(should (equal (cl-set-difference e a :test 'eq) e))
|
||||
(should (equal (cl-set-difference a a :test 'eq) e))
|
||||
(should (equal (cl-set-difference b e :test 'eq) b))
|
||||
(should (equal (cl-set-difference e b :test 'eq) e))
|
||||
(should (equal (cl-set-difference b b :test 'eq) e))
|
||||
(should (equal (cl-set-difference a b :test 'eq) (list 'a nil "" "x" c2)))
|
||||
(should (equal (cl-set-difference b a :test 'eq) (list 'y 'x)))
|
||||
|
||||
(should (equal (cl-union e e) e))
|
||||
(should (equal (cl-union a e) a))
|
||||
(should (equal (cl-union e a) a))
|
||||
(should (equal (cl-union a a) a))
|
||||
(should (equal (cl-union b e) b))
|
||||
(should (equal (cl-union e b) b))
|
||||
(should (equal (cl-union b b) b))
|
||||
(should (equal (cl-union a b) (list 'x 'y 'a 'b sym nil "" "x" c1 c2)))
|
||||
|
||||
(should (equal (cl-union b a) (list 'x 'y 'a 'b sym nil "" "x" c1 c2)))
|
||||
|
||||
(should (equal (cl-intersection e e) e))
|
||||
(should (equal (cl-intersection a e) e))
|
||||
(should (equal (cl-intersection e a) e))
|
||||
(should (equal (cl-intersection a a) a))
|
||||
(should (equal (cl-intersection b e) e))
|
||||
(should (equal (cl-intersection e b) e))
|
||||
(should (equal (cl-intersection b b) b))
|
||||
(should (equal (cl-intersection a b) (list sym 'b c1)))
|
||||
(should (equal (cl-intersection b a) (list sym 'b c1))))))
|
||||
|
||||
(ert-deftest cl-lib-test-gensym ()
|
||||
;; Since the expansion of `should' calls `cl-gensym' and thus has a
|
||||
;; side-effect on `cl--gensym-counter', we have to make sure all
|
||||
;; macros in our test body are expanded before we rebind
|
||||
;; `cl--gensym-counter' and run the body. Otherwise, the test would
|
||||
;; fail if run interpreted.
|
||||
(let ((body (byte-compile
|
||||
'(lambda ()
|
||||
(should (equal (symbol-name (cl-gensym)) "G0"))
|
||||
(should (equal (symbol-name (cl-gensym)) "G1"))
|
||||
(should (equal (symbol-name (cl-gensym)) "G2"))
|
||||
(should (equal (symbol-name (cl-gensym "foo")) "foo3"))
|
||||
(should (equal (symbol-name (cl-gensym "bar")) "bar4"))
|
||||
(should (equal cl--gensym-counter 5))))))
|
||||
(let ((cl--gensym-counter 0))
|
||||
(funcall body))))
|
||||
|
||||
(ert-deftest cl-lib-test-coerce-to-vector ()
|
||||
(let* ((a (vector))
|
||||
(b (vector 1 a 3))
|
||||
(c (list))
|
||||
(d (list b a)))
|
||||
(should (eql (cl-coerce a 'vector) a))
|
||||
(should (eql (cl-coerce b 'vector) b))
|
||||
(should (equal (cl-coerce c 'vector) (vector)))
|
||||
(should (equal (cl-coerce d 'vector) (vector b a)))))
|
||||
|
||||
(ert-deftest cl-lib-test-string-position ()
|
||||
(should (eql (cl-position ?x "") nil))
|
||||
(should (eql (cl-position ?a "abc") 0))
|
||||
(should (eql (cl-position ?b "abc") 1))
|
||||
(should (eql (cl-position ?c "abc") 2))
|
||||
(should (eql (cl-position ?d "abc") nil))
|
||||
(should (eql (cl-position ?A "abc") nil)))
|
||||
|
||||
(ert-deftest cl-lib-test-mismatch ()
|
||||
(should (eql (cl-mismatch "" "") nil))
|
||||
(should (eql (cl-mismatch "" "a") 0))
|
||||
(should (eql (cl-mismatch "a" "a") nil))
|
||||
(should (eql (cl-mismatch "ab" "a") 1))
|
||||
(should (eql (cl-mismatch "Aa" "aA") 0))
|
||||
(should (eql (cl-mismatch '(a b c) '(a b d)) 2)))
|
||||
|
||||
(ert-deftest cl-lib-keyword-names-versus-values ()
|
||||
(should (equal
|
||||
(funcall (cl-function (lambda (&key a b) (list a b)))
|
||||
:b :a :a 42)
|
||||
'(42 :a))))
|
||||
|
||||
(ert-deftest cl-lib-empty-keyargs ()
|
||||
(should-error (funcall (cl-function (lambda (&key) 1))
|
||||
:b 1)))
|
||||
|
||||
(cl-defstruct (mystruct
|
||||
(:constructor cl-lib--con-1 (&aux (abc 1)))
|
||||
(:constructor cl-lib--con-2 (&optional def) "Constructor docstring."))
|
||||
"General docstring."
|
||||
(abc 5 :readonly t) (def nil))
|
||||
(ert-deftest cl-lib-struct-accessors ()
|
||||
(let ((x (make-mystruct :abc 1 :def 2)))
|
||||
(should (eql (cl-struct-slot-value 'mystruct 'abc x) 1))
|
||||
(should (eql (cl-struct-slot-value 'mystruct 'def x) 2))
|
||||
(setf (cl-struct-slot-value 'mystruct 'def x) -1)
|
||||
(should (eql (cl-struct-slot-value 'mystruct 'def x) -1))
|
||||
(should (eql (cl-struct-slot-offset 'mystruct 'abc) 1))
|
||||
(should-error (cl-struct-slot-offset 'mystruct 'marypoppins))
|
||||
(should (pcase (cl-struct-slot-info 'mystruct)
|
||||
(`((cl-tag-slot) (abc 5 :readonly t)
|
||||
(def . ,(or 'nil '(nil))))
|
||||
t)))))
|
||||
(ert-deftest cl-lib-struct-constructors ()
|
||||
(should (string-match "\\`Constructor docstring."
|
||||
(documentation 'cl-lib--con-2 t)))
|
||||
(should (mystruct-p (cl-lib--con-1)))
|
||||
(should (mystruct-p (cl-lib--con-2))))
|
||||
|
||||
(ert-deftest cl-lib-arglist-performance ()
|
||||
;; An `&aux' should not cause lambda's arglist to be turned into an &rest
|
||||
;; that's parsed by hand.
|
||||
(should (equal () (help-function-arglist 'cl-lib--con-1)))
|
||||
(should (pcase (help-function-arglist 'cl-lib--con-2)
|
||||
(`(&optional ,_) t))))
|
||||
|
||||
(ert-deftest cl-the ()
|
||||
(should (eql (cl-the integer 42) 42))
|
||||
(should-error (cl-the integer "abc"))
|
||||
(let ((side-effect 0))
|
||||
(should (= (cl-the integer (cl-incf side-effect)) 1))
|
||||
(should (= side-effect 1))))
|
||||
|
||||
(ert-deftest cl-lib-test-pushnew ()
|
||||
(let ((list '(1 2 3)))
|
||||
(cl-pushnew 0 list)
|
||||
|
|
@ -468,12 +253,6 @@
|
|||
(should (equal (cl-pairlis '(a nil c) '(1 2 3)) '((a . 1) (nil . 2) (c . 3))))
|
||||
(should (equal (cl-pairlis '(a b c) '(1 nil 3)) '((a . 1) (b) (c . 3)))))
|
||||
|
||||
(ert-deftest cl-lib-test-endp ()
|
||||
(should (cl-endp '()))
|
||||
(should-not (cl-endp '(1)))
|
||||
(should-error (cl-endp 1) :type 'wrong-type-argument)
|
||||
(should-error (cl-endp [1]) :type 'wrong-type-argument))
|
||||
|
||||
(ert-deftest cl-lib-test-nth-value ()
|
||||
(let ((vals (cl-values 2 3)))
|
||||
(should (= (cl-nth-value 0 vals) 2))
|
||||
|
|
@ -544,70 +323,6 @@
|
|||
(should-error (cl-adjoin 1 nums :key 'int-to-string :test-not myfn-p)
|
||||
:type 'wrong-type-argument)))
|
||||
|
||||
(ert-deftest cl-parse-integer ()
|
||||
(should-error (cl-parse-integer "abc"))
|
||||
(should (null (cl-parse-integer "abc" :junk-allowed t)))
|
||||
(should (null (cl-parse-integer "" :junk-allowed t)))
|
||||
(should (= 342391 (cl-parse-integer "0123456789" :radix 8 :junk-allowed t)))
|
||||
(should-error (cl-parse-integer "0123456789" :radix 8))
|
||||
(should (= -239 (cl-parse-integer "-efz" :radix 16 :junk-allowed t)))
|
||||
(should-error (cl-parse-integer "efz" :radix 16))
|
||||
(should (= 239 (cl-parse-integer "zzef" :radix 16 :start 2)))
|
||||
(should (= -123 (cl-parse-integer " -123 "))))
|
||||
|
||||
(ert-deftest cl-flet-test ()
|
||||
(should (equal (cl-flet ((f1 (x) x)) (let ((x #'f1)) (funcall x 5))) 5)))
|
||||
|
||||
(ert-deftest cl-lib-test-typep ()
|
||||
(cl-deftype cl-lib-test-type (&optional x) `(member ,x))
|
||||
;; Make sure we correctly implement the rule that deftype's optional args
|
||||
;; default to `*' rather than to nil.
|
||||
(should (cl-typep '* 'cl-lib-test-type))
|
||||
(should-not (cl-typep 1 'cl-lib-test-type)))
|
||||
|
||||
(ert-deftest cl-lib-symbol-macrolet ()
|
||||
;; bug#26325
|
||||
(should (equal (cl-flet ((f (x) (+ x 5)))
|
||||
(let ((x 5))
|
||||
(f (+ x 6))))
|
||||
;; Go through `eval', otherwise the macro-expansion
|
||||
;; error prevents running the whole test suite :-(
|
||||
(eval '(cl-symbol-macrolet ((f (+ x 6)))
|
||||
(cl-flet ((f (x) (+ x 5)))
|
||||
(let ((x 5))
|
||||
(f f))))
|
||||
t))))
|
||||
|
||||
(defmacro cl-lib-symbol-macrolet-4+5 ()
|
||||
;; bug#26068
|
||||
(let* ((sname "x")
|
||||
(s1 (make-symbol sname))
|
||||
(s2 (make-symbol sname)))
|
||||
`(cl-symbol-macrolet ((,s1 4)
|
||||
(,s2 5))
|
||||
(+ ,s1 ,s2))))
|
||||
|
||||
(ert-deftest cl-lib-symbol-macrolet-2 ()
|
||||
(should (equal (cl-lib-symbol-macrolet-4+5) (+ 4 5))))
|
||||
|
||||
|
||||
(ert-deftest cl-lib-symbol-macrolet-hide ()
|
||||
;; bug#26325, bug#26073
|
||||
(should (equal (let ((y 5))
|
||||
(cl-symbol-macrolet ((x y))
|
||||
(list x
|
||||
(let ((x 6)) (list x y))
|
||||
(cl-letf ((x 6)) (list x y))
|
||||
(apply (lambda (x) (+ x 1)) (list 8)))))
|
||||
'(5 (6 5) (6 6) 9))))
|
||||
|
||||
(ert-deftest cl-lib-defstruct-record ()
|
||||
(cl-defstruct foo x)
|
||||
(let ((x (make-foo :x 42)))
|
||||
(should (recordp x))
|
||||
(should (eq (type-of x) 'foo))
|
||||
(should (eql (foo-x x) 42))))
|
||||
|
||||
(ert-deftest old-struct ()
|
||||
(cl-defstruct foo x)
|
||||
(with-suppressed-warnings ((obsolete cl-old-struct-compat-mode))
|
||||
|
|
@ -638,37 +353,4 @@
|
|||
(should (equal (mapcar (cl-constantly 3) '(a b c d))
|
||||
'(3 3 3 3))))
|
||||
|
||||
(ert-deftest cl-lib-set-difference ()
|
||||
;; our set-difference preserves order, though it is not required to
|
||||
;; by cl standards. Nevertheless better keep that invariant
|
||||
(should (equal (cl-set-difference '(1 2 3 4) '(3 4 5 6))
|
||||
'(1 2))))
|
||||
|
||||
(ert-deftest cl-nset-difference ()
|
||||
;; our nset-difference doesn't
|
||||
(let* ((l1 (list 1 2 3 4)) (l2 '(3 4 5 6))
|
||||
(diff (cl-nset-difference l1 l2)))
|
||||
(should (memq 1 diff))
|
||||
(should (memq 2 diff))
|
||||
(should (= (length diff) 2))
|
||||
(should (equal l2 '(3 4 5 6))))
|
||||
(let* ((l1 (list "1" "2" "3" "4")) (l2 '("3" "4" "5" "6"))
|
||||
(diff (cl-nset-difference l1 l2 :test #'equal)))
|
||||
(should (member "1" diff))
|
||||
(should (member "2" diff))
|
||||
(should (= (length diff) 2))
|
||||
(should (equal l2 '("3" "4" "5" "6"))))
|
||||
(let* ((l1 (list '(a . 1) '(b . 2) '(c . 3) '(d . 4)))
|
||||
(l2 (list '(c . 3) '(d . 4) '(e . 5) '(f . 6)))
|
||||
(diff (cl-nset-difference l1 l2 :key #'car)))
|
||||
(should (member '(a . 1) diff))
|
||||
(should (member '(b . 2) diff))
|
||||
(should (= (length diff) 2)))
|
||||
(let* ((l1 (list '("a" . 1) '("b" . 2) '("c" . 3) '("d" . 4)))
|
||||
(l2 (list '("c" . 3) '("d" . 4) '("e" . 5) '("f" . 6)))
|
||||
(diff (cl-nset-difference l1 l2 :key #'car :test #'string=)))
|
||||
(should (member '("a" . 1) diff))
|
||||
(should (member '("b" . 2) diff))
|
||||
(should (= (length diff) 2))))
|
||||
|
||||
;;; cl-lib-tests.el ends here
|
||||
|
|
|
|||
|
|
@ -22,11 +22,9 @@
|
|||
;;; Code:
|
||||
|
||||
(require 'cl-lib)
|
||||
(require 'cl-macs)
|
||||
(require 'edebug)
|
||||
(require 'ert)
|
||||
(require 'ert-x)
|
||||
(require 'pcase)
|
||||
|
||||
|
||||
;;;; cl-loop tests -- many adapted from Steele's CLtL2
|
||||
|
|
@ -518,6 +516,45 @@ collection clause."
|
|||
collect (list k x))))))
|
||||
|
||||
|
||||
(cl-defstruct (mystruct
|
||||
(:constructor cl-lib--con-1 (&aux (abc 1)))
|
||||
(:constructor cl-lib--con-2 (&optional def) "Constructor docstring."))
|
||||
"General docstring."
|
||||
(abc 5 :readonly t) (def nil))
|
||||
|
||||
(ert-deftest cl-lib-struct-accessors ()
|
||||
(let ((x (make-mystruct :abc 1 :def 2)))
|
||||
(should (eql (cl-struct-slot-value 'mystruct 'abc x) 1))
|
||||
(should (eql (cl-struct-slot-value 'mystruct 'def x) 2))
|
||||
(setf (cl-struct-slot-value 'mystruct 'def x) -1)
|
||||
(should (eql (cl-struct-slot-value 'mystruct 'def x) -1))
|
||||
(should (eql (cl-struct-slot-offset 'mystruct 'abc) 1))
|
||||
(should-error (cl-struct-slot-offset 'mystruct 'marypoppins))
|
||||
(should (pcase (cl-struct-slot-info 'mystruct)
|
||||
(`((cl-tag-slot) (abc 5 :readonly t)
|
||||
(def . ,(or 'nil '(nil))))
|
||||
t)))))
|
||||
|
||||
(ert-deftest cl-lib-struct-constructors ()
|
||||
(should (string-match "\\`Constructor docstring."
|
||||
(documentation 'cl-lib--con-2 t)))
|
||||
(should (mystruct-p (cl-lib--con-1)))
|
||||
(should (mystruct-p (cl-lib--con-2))))
|
||||
|
||||
(ert-deftest cl-lib-arglist-performance ()
|
||||
;; An `&aux' should not cause lambda's arglist to be turned into an &rest
|
||||
;; that's parsed by hand.
|
||||
(should (equal () (help-function-arglist 'cl-lib--con-1)))
|
||||
(should (pcase (help-function-arglist 'cl-lib--con-2)
|
||||
(`(&optional ,_) t))))
|
||||
|
||||
(ert-deftest cl-lib-defstruct-record ()
|
||||
(cl-defstruct foo x)
|
||||
(let ((x (make-foo :x 42)))
|
||||
(should (recordp x))
|
||||
(should (eq (type-of x) 'foo))
|
||||
(should (eql (foo-x x) 42))))
|
||||
|
||||
(ert-deftest cl-defstruct/builtin-type ()
|
||||
(should-error
|
||||
(macroexpand '(cl-defstruct hash-table))
|
||||
|
|
@ -563,6 +600,41 @@ collection clause."
|
|||
m)))
|
||||
'(42 5 42))))
|
||||
|
||||
(ert-deftest cl-lib-symbol-macrolet ()
|
||||
;; bug#26325
|
||||
(should (equal (cl-flet ((f (x) (+ x 5)))
|
||||
(let ((x 5))
|
||||
(f (+ x 6))))
|
||||
;; Go through `eval', otherwise the macro-expansion
|
||||
;; error prevents running the whole test suite :-(
|
||||
(eval '(cl-symbol-macrolet ((f (+ x 6)))
|
||||
(cl-flet ((f (x) (+ x 5)))
|
||||
(let ((x 5))
|
||||
(f f))))
|
||||
t))))
|
||||
|
||||
(defmacro cl-lib-symbol-macrolet-4+5 ()
|
||||
;; bug#26068
|
||||
(let* ((sname "x")
|
||||
(s1 (make-symbol sname))
|
||||
(s2 (make-symbol sname)))
|
||||
`(cl-symbol-macrolet ((,s1 4)
|
||||
(,s2 5))
|
||||
(+ ,s1 ,s2))))
|
||||
|
||||
(ert-deftest cl-lib-symbol-macrolet-2 ()
|
||||
(should (equal (cl-lib-symbol-macrolet-4+5) (+ 4 5))))
|
||||
|
||||
(ert-deftest cl-lib-symbol-macrolet-hide ()
|
||||
;; bug#26325, bug#26073
|
||||
(should (equal (let ((y 5))
|
||||
(cl-symbol-macrolet ((x y))
|
||||
(list x
|
||||
(let ((x 6)) (list x y))
|
||||
(cl-letf ((x 6)) (list x y))
|
||||
(apply (lambda (x) (+ x 1)) (list 8)))))
|
||||
'(5 (6 5) (6 6) 9))))
|
||||
|
||||
(ert-deftest cl-macs-loop-conditional-step-clauses ()
|
||||
"These tests failed under the initial fixes in #bug#29799."
|
||||
(should (cl-loop for i from 1 upto 100 and j = 1 then (1+ j)
|
||||
|
|
@ -718,6 +790,9 @@ collection clause."
|
|||
(f lex-var)))))
|
||||
(should (equal (f nil) 'a)))))
|
||||
|
||||
(ert-deftest cl-flet-test ()
|
||||
(should (equal (cl-flet ((f1 (x) x)) (let ((x #'f1)) (funcall x 5))) 5)))
|
||||
|
||||
(ert-deftest cl-macs--test-flet-block ()
|
||||
(should (equal (cl-block f1
|
||||
(cl-flet ((f1 (a) (cons (cl-return-from f1 a) 6)))
|
||||
|
|
@ -803,9 +878,9 @@ collection clause."
|
|||
(cl-ecase val (t 1) (123 2))
|
||||
(cl-ecase val (123 2) (t 1))))
|
||||
(ert-info ((prin1-to-string form) :prefix "Form: ")
|
||||
(let ((error (should-error (macroexpand form))))
|
||||
(should (equal (cdr error)
|
||||
'("Misplaced t or `otherwise' clause"))))))))
|
||||
(let ((error (should-error (macroexpand form))))
|
||||
(should (equal (cdr error)
|
||||
'("Misplaced t or `otherwise' clause"))))))))
|
||||
|
||||
(ert-deftest cl-case-warning ()
|
||||
"Test that `cl-case' and `cl-ecase' warn about suspicious
|
||||
|
|
@ -833,10 +908,10 @@ constructs."
|
|||
(dolist (macro '(cl-case cl-ecase))
|
||||
(let ((form `(,macro val (,case 1))))
|
||||
(ert-info ((prin1-to-string form) :prefix "Form: ")
|
||||
(ert-with-message-capture messages
|
||||
(macroexpand form)
|
||||
(should (equal messages
|
||||
(concat "Warning: " message "\n"))))))))))
|
||||
(ert-with-message-capture messages
|
||||
(macroexpand form)
|
||||
(should (equal messages
|
||||
(concat "Warning: " message "\n"))))))))))
|
||||
|
||||
(ert-deftest cl-case-no-warning ()
|
||||
"Test that `cl-case' and `cl-ecase' don't warn in some valid cases.
|
||||
|
|
@ -875,4 +950,45 @@ See Bug#57915."
|
|||
(should (equal (cl--test-s-cl--test-a x) 4))
|
||||
(should (equal (cl--test-s-b x) 'dyn)))))
|
||||
|
||||
(ert-deftest cl-lib-keyword-names-versus-values ()
|
||||
(should (equal
|
||||
(funcall (cl-function (lambda (&key a b) (list a b)))
|
||||
:b :a :a 42)
|
||||
'(42 :a))))
|
||||
|
||||
(ert-deftest cl-lib-empty-keyargs ()
|
||||
(should-error (funcall (cl-function (lambda (&key) 1))
|
||||
:b 1)))
|
||||
|
||||
(ert-deftest cl-lib-test-gensym ()
|
||||
;; Since the expansion of `should' calls `cl-gensym' and thus has a
|
||||
;; side-effect on `cl--gensym-counter', we have to make sure all
|
||||
;; macros in our test body are expanded before we rebind
|
||||
;; `cl--gensym-counter' and run the body. Otherwise, the test would
|
||||
;; fail if run interpreted.
|
||||
(let ((body (byte-compile
|
||||
'(lambda ()
|
||||
(should (equal (symbol-name (cl-gensym)) "G0"))
|
||||
(should (equal (symbol-name (cl-gensym)) "G1"))
|
||||
(should (equal (symbol-name (cl-gensym)) "G2"))
|
||||
(should (equal (symbol-name (cl-gensym "foo")) "foo3"))
|
||||
(should (equal (symbol-name (cl-gensym "bar")) "bar4"))
|
||||
(should (equal cl--gensym-counter 5))))))
|
||||
(let ((cl--gensym-counter 0))
|
||||
(funcall body))))
|
||||
|
||||
(ert-deftest cl-the ()
|
||||
(should (eql (cl-the integer 42) 42))
|
||||
(should-error (cl-the integer "abc"))
|
||||
(let ((side-effect 0))
|
||||
(should (= (cl-the integer (cl-incf side-effect)) 1))
|
||||
(should (= side-effect 1))))
|
||||
|
||||
(ert-deftest cl-lib-test-typep ()
|
||||
(cl-deftype cl-lib-test-type (&optional x) `(member ,x))
|
||||
;; Make sure we correctly implement the rule that deftype's optional args
|
||||
;; default to `*' rather than to nil.
|
||||
(should (cl-typep '* 'cl-lib-test-type))
|
||||
(should-not (cl-typep 1 'cl-lib-test-type)))
|
||||
|
||||
;;; cl-macs-tests.el ends here
|
||||
|
|
|
|||
|
|
@ -22,7 +22,7 @@
|
|||
;;; Code:
|
||||
|
||||
(require 'ert)
|
||||
(require 'cl-seq)
|
||||
(require 'cl-lib)
|
||||
|
||||
(ert-deftest cl-union-test-00 ()
|
||||
"Test for bug#22729."
|
||||
|
|
@ -54,8 +54,10 @@ Additionally register an `ert-info' to help identify test failures."
|
|||
|
||||
(ert-deftest cl-seq-endp-test ()
|
||||
(should (cl-endp '()))
|
||||
(should (not (cl-endp '(1 2 3))))
|
||||
(should-error (cl-endp 42) :type 'wrong-type-argument))
|
||||
(should-not (cl-endp '(1)))
|
||||
(should-not (cl-endp '(1 2 3)))
|
||||
(should-error (cl-endp 1) :type 'wrong-type-argument)
|
||||
(should-error (cl-endp [1]) :type 'wrong-type-argument))
|
||||
|
||||
(ert-deftest cl-seq-reduce-test ()
|
||||
(should (equal 6 (cl-reduce #'+ '(1 2 3))))
|
||||
|
|
@ -97,6 +99,37 @@ Additionally register an `ert-info' to help identify test failures."
|
|||
(should (equal '(1 2 a a 5 2 6) (cl-replace l1 l2 :start1 2 :end1 4)))
|
||||
(should (equal '(a a 3 4 5 2 6) (cl-replace l1 l2 :start2 2 :end2 4)))))
|
||||
|
||||
(ert-deftest cl-lib-test-remove ()
|
||||
(let ((list (list 'a 'b 'c 'd))
|
||||
(key-index 0)
|
||||
(test-index 0))
|
||||
(let ((result
|
||||
(cl-remove 'foo list
|
||||
:key (lambda (x)
|
||||
(should (eql x (nth key-index list)))
|
||||
(prog1
|
||||
(list key-index x)
|
||||
(cl-incf key-index)))
|
||||
:test
|
||||
(lambda (a b)
|
||||
(should (eql a 'foo))
|
||||
(should (equal b (list test-index
|
||||
(nth test-index list))))
|
||||
(cl-incf test-index)
|
||||
(member test-index '(2 3))))))
|
||||
(should (equal key-index 4))
|
||||
(should (equal test-index 4))
|
||||
(should (equal result '(a d)))
|
||||
(should (equal list '(a b c d)))))
|
||||
(let ((x (cons nil nil))
|
||||
(y (cons nil nil)))
|
||||
(should (equal (cl-remove x (list x y))
|
||||
;; or (list x), since we use `equal' -- the
|
||||
;; important thing is that only one element got
|
||||
;; removed, this proves that the default test is
|
||||
;; `eql', not `equal'
|
||||
(list y)))))
|
||||
|
||||
;; keywords supported: :test :test-not :key :count :start :end :from-end
|
||||
(ert-deftest cl-seq-remove-test ()
|
||||
(let ((list '(1 2 3 4 5 2 6)))
|
||||
|
|
@ -122,6 +155,20 @@ Additionally register an `ert-info' to help identify test failures."
|
|||
(should (equal '() (cl-remove-if #'cl-evenp '())))
|
||||
(should (equal '() (cl-remove-if #'cl-evenp '(2)))))
|
||||
|
||||
(ert-deftest cl-lib-test-remove-if-not ()
|
||||
(let ((list (list 'a 'b 'c 'd))
|
||||
(i 0))
|
||||
(let ((result (cl-remove-if-not (lambda (x)
|
||||
(should (eql x (nth i list)))
|
||||
(cl-incf i)
|
||||
(member i '(2 3)))
|
||||
list)))
|
||||
(should (equal i 4))
|
||||
(should (equal result '(b c)))
|
||||
(should (equal list '(a b c d)))))
|
||||
(should (equal '()
|
||||
(cl-remove-if-not (lambda (_x) (should nil)) '()))))
|
||||
|
||||
(ert-deftest cl-remove-if-not-test ()
|
||||
(should (equal '(2 4) (cl-remove-if-not #'cl-evenp '(1 2 3 4))))
|
||||
(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."
|
|||
(let ((pred (lambda (x) (> (cl-position x orig :from-end t) 1))))
|
||||
(should (equal '(b 2 3 4 5 2 6) (cl-nsubstitute 'b nil l :if-not pred))))))
|
||||
|
||||
(ert-deftest cl-lib-test-string-position ()
|
||||
(should (eql (cl-position ?x "") nil))
|
||||
(should (eql (cl-position ?a "abc") 0))
|
||||
(should (eql (cl-position ?b "abc") 1))
|
||||
(should (eql (cl-position ?c "abc") 2))
|
||||
(should (eql (cl-position ?d "abc") nil))
|
||||
(should (eql (cl-position ?A "abc") nil)))
|
||||
|
||||
;; keywords supported: :test :test-not :key :start :end :from-end
|
||||
(ert-deftest cl-seq-position-test ()
|
||||
(let ((list '(1 2 3 4 5 2 6)))
|
||||
|
|
@ -401,6 +456,14 @@ Additionally register an `ert-info' to help identify test failures."
|
|||
'(1 2 3 4 5 6))))
|
||||
(should (equal result 2))))
|
||||
|
||||
(ert-deftest cl-lib-test-mismatch ()
|
||||
(should (eql (cl-mismatch "" "") nil))
|
||||
(should (eql (cl-mismatch "" "a") 0))
|
||||
(should (eql (cl-mismatch "a" "a") nil))
|
||||
(should (eql (cl-mismatch "ab" "a") 1))
|
||||
(should (eql (cl-mismatch "Aa" "aA") 0))
|
||||
(should (eql (cl-mismatch '(a b c) '(a b d)) 2)))
|
||||
|
||||
;; keywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end
|
||||
(ert-deftest cl-seq-mismatch-test ()
|
||||
(let ((list '(1 2 3 4 5 2 6))
|
||||
|
|
@ -776,6 +839,57 @@ Additionally register an `ert-info' to help identify test failures."
|
|||
'(((1 2) . 1) ((3 4) . 2) ((5) . 2)))))
|
||||
(should (equal result '((1 2) . 1)))))
|
||||
|
||||
(ert-deftest cl-lib-test-set-functions ()
|
||||
(let ((c1 (cons nil nil))
|
||||
(c2 (cons nil nil))
|
||||
(sym (make-symbol "a")))
|
||||
(let ((e '())
|
||||
(a (list 'a 'b sym nil "" "x" c1 c2))
|
||||
(b (list c1 'y 'b sym 'x)))
|
||||
(should (equal (cl-set-difference e e) e))
|
||||
(should (equal (cl-set-difference a e) a))
|
||||
(should (equal (cl-set-difference e a) e))
|
||||
(should (equal (cl-set-difference a a) e))
|
||||
(should (equal (cl-set-difference b e) b))
|
||||
(should (equal (cl-set-difference e b) e))
|
||||
(should (equal (cl-set-difference b b) e))
|
||||
;; Note: this test (and others) is sensitive to the order of the
|
||||
;; result, which is not documented.
|
||||
(should (equal (cl-set-difference a b) (list 'a nil "" "x" c2)))
|
||||
(should (equal (cl-set-difference b a) (list 'y 'x)))
|
||||
|
||||
;; We aren't testing whether this is really using `eq' rather than `eql'.
|
||||
(should (equal (cl-set-difference e e :test 'eq) e))
|
||||
(should (equal (cl-set-difference a e :test 'eq) a))
|
||||
(should (equal (cl-set-difference e a :test 'eq) e))
|
||||
(should (equal (cl-set-difference a a :test 'eq) e))
|
||||
(should (equal (cl-set-difference b e :test 'eq) b))
|
||||
(should (equal (cl-set-difference e b :test 'eq) e))
|
||||
(should (equal (cl-set-difference b b :test 'eq) e))
|
||||
(should (equal (cl-set-difference a b :test 'eq) (list 'a nil "" "x" c2)))
|
||||
(should (equal (cl-set-difference b a :test 'eq) (list 'y 'x)))
|
||||
|
||||
(should (equal (cl-union e e) e))
|
||||
(should (equal (cl-union a e) a))
|
||||
(should (equal (cl-union e a) a))
|
||||
(should (equal (cl-union a a) a))
|
||||
(should (equal (cl-union b e) b))
|
||||
(should (equal (cl-union e b) b))
|
||||
(should (equal (cl-union b b) b))
|
||||
(should (equal (cl-union a b) (list 'x 'y 'a 'b sym nil "" "x" c1 c2)))
|
||||
|
||||
(should (equal (cl-union b a) (list 'x 'y 'a 'b sym nil "" "x" c1 c2)))
|
||||
|
||||
(should (equal (cl-intersection e e) e))
|
||||
(should (equal (cl-intersection a e) e))
|
||||
(should (equal (cl-intersection e a) e))
|
||||
(should (equal (cl-intersection a a) a))
|
||||
(should (equal (cl-intersection b e) e))
|
||||
(should (equal (cl-intersection e b) e))
|
||||
(should (equal (cl-intersection b b) b))
|
||||
(should (equal (cl-intersection a b) (list sym 'b c1)))
|
||||
(should (equal (cl-intersection b a) (list sym 'b c1))))))
|
||||
|
||||
(ert-deftest cl-intersection-test ()
|
||||
(let ((result (cl-intersection '(1 2 3 4) '(3 4 5 6))))
|
||||
(should (equal result '(4 3))))
|
||||
|
|
@ -815,8 +929,10 @@ Additionally register an `ert-info' to help identify test failures."
|
|||
'(1 2 3))))
|
||||
|
||||
(ert-deftest cl-set-difference-test ()
|
||||
(let ((result (cl-set-difference '(1 2 3 4) '(3 4 5 6))))
|
||||
(should (equal result '(1 2))))
|
||||
;; Our set-difference preserves order, though it is not required to
|
||||
;; by CL standards. Nevertheless better keep that invariant.
|
||||
(should (equal (cl-set-difference '(1 2 3 4) '(3 4 5 6))
|
||||
'(1 2)))
|
||||
(let ((result (cl-set-difference '(1 2 3) '())))
|
||||
(should (equal result '(1 2 3))))
|
||||
(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."
|
|||
(should (equal list1 '(1 2 3)))
|
||||
(should (equal list2 '(2 3 4)))))
|
||||
|
||||
(ert-deftest cl-nset-difference ()
|
||||
;; Our nset-difference doesn't preserve order.
|
||||
(let* ((l1 (list 1 2 3 4)) (l2 '(3 4 5 6))
|
||||
(diff (cl-nset-difference l1 l2)))
|
||||
(should (memq 1 diff))
|
||||
(should (memq 2 diff))
|
||||
(should (= (length diff) 2))
|
||||
(should (equal l2 '(3 4 5 6))))
|
||||
(let* ((l1 (list "1" "2" "3" "4")) (l2 '("3" "4" "5" "6"))
|
||||
(diff (cl-nset-difference l1 l2 :test #'equal)))
|
||||
(should (member "1" diff))
|
||||
(should (member "2" diff))
|
||||
(should (= (length diff) 2))
|
||||
(should (equal l2 '("3" "4" "5" "6"))))
|
||||
(let* ((l1 (list '(a . 1) '(b . 2) '(c . 3) '(d . 4)))
|
||||
(l2 (list '(c . 3) '(d . 4) '(e . 5) '(f . 6)))
|
||||
(diff (cl-nset-difference l1 l2 :key #'car)))
|
||||
(should (member '(a . 1) diff))
|
||||
(should (member '(b . 2) diff))
|
||||
(should (= (length diff) 2)))
|
||||
(let* ((l1 (list '("a" . 1) '("b" . 2) '("c" . 3) '("d" . 4)))
|
||||
(l2 (list '("c" . 3) '("d" . 4) '("e" . 5) '("f" . 6)))
|
||||
(diff (cl-nset-difference l1 l2 :key #'car :test #'string=)))
|
||||
(should (member '("a" . 1) diff))
|
||||
(should (member '("b" . 2) diff))
|
||||
(should (= (length diff) 2))))
|
||||
|
||||
(ert-deftest cl-nset-difference-test ()
|
||||
(should-not (cl-nset-difference () ()))
|
||||
(should-not (cl-nset-difference () (list 1 2 3)))
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue