diff options
Diffstat (limited to 'test/lisp/emacs-lisp/cl-seq-tests.el')
| -rw-r--r-- | test/lisp/emacs-lisp/cl-seq-tests.el | 1138 |
1 files changed, 991 insertions, 147 deletions
diff --git a/test/lisp/emacs-lisp/cl-seq-tests.el b/test/lisp/emacs-lisp/cl-seq-tests.el index 9c62379d857..ff875953cc4 100644 --- a/test/lisp/emacs-lisp/cl-seq-tests.el +++ b/test/lisp/emacs-lisp/cl-seq-tests.el @@ -1,4 +1,4 @@ -;;; cl-seq-tests.el --- Tests for cl-seq.el functionality -*- lexical-binding: t; -*- +;;; cl-seq-tests.el --- Tests for cl-seq.el -*- lexical-binding: t; -*- ;; Copyright (C) 2015-2025 Free Software Foundation, Inc. @@ -19,15 +19,13 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. -;;; Commentary: - ;;; Code: (require 'ert) -(require 'cl-seq) +(require 'cl-lib) (ert-deftest cl-union-test-00 () - "Test for https://debbugs.gnu.org/22729 ." + "Test for bug#22729." (let ((str1 "foo") (str2 (make-string 3 ?o))) ;; Emacs may make two string literals eql when reading. @@ -36,108 +34,185 @@ (should (equal str1 str2)) (should (equal (cl-union (list str1) (list str2)) (list str2))) - (should (equal (cl-union (list str1) (list str2) :test 'eql) + (should (equal (cl-union (list str1) (list str2) :test #'eql) (list str1 str2))))) -(defvar cl-seq--test-list nil - "List used on `cl-seq' tests with side effects.") -(defvar cl-seq--test-list2 nil - "List used on `cl-seq' tests with side effects.") - -(defmacro cl-seq--with-side-effects (list list2 &rest body) - "Run a test with side effects on lists; after the test restore the lists. -LIST is the value of `cl-seq--test-list' before the test. -LIST2, if non-nil, is the value of `cl-seq--test-list2' before the test. -Body are forms defining the test." - (declare (indent 2) (debug t)) - (let ((orig (make-symbol "orig")) - (orig2 (make-symbol "orig2"))) - `(let ((,orig (copy-sequence ,list)) - (,orig2 (copy-sequence ,list2))) - (unwind-protect (progn ,@body) - (setq cl-seq--test-list ,orig) - (when ,list2 - (setq cl-seq--test-list2 ,orig2)))))) +(defmacro cl-seq-tests--relet* (binders &rest body) + "Like `let*', but reevaluate BINDERS before each form in BODY. +Additionally register an `ert-info' to help identify test failures." + (declare (debug let) (indent 1)) + (let ((syms (mapcar (lambda (binder) + (if (consp binder) (car binder) binder)) + binders))) + (macroexp-progn + (mapcar (lambda (form) + `(ert-info (,(lambda () (pp-to-string form)) :prefix "form: ") + (let* ,binders + ,@(and syms `((ignore ,@syms))) + ,form))) + body)))) + +(ert-deftest cl-seq-endp-test () + (should (cl-endp '())) + (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)))) + (should (equal 5 (cl-reduce #'+ '(1 2 3 4) :start 1 :end 3))) + (should (equal 10 (cl-reduce #'+ '(1 2 3 4) :from-end t))) + (should (equal 10 (cl-reduce #'+ '(1 2 3 4) :initial-value 0))) + (should (equal 24 (cl-reduce #'* '(1 2 3 4) :initial-value 1))) + (should (equal 0 (cl-reduce #'+ '()))) + (should (equal 0 (cl-reduce #'+ '() :initial-value 0))) + (should (equal 1 (cl-reduce #'+ '(1)))) + (should (equal 0 (cl-reduce #'+ '() :initial-value 0)))) ;; keywords supported: :start :end (ert-deftest cl-seq-fill-test () - (let* ((cl-seq--test-list '(1 2 3 4 5 2 6)) - (orig (copy-sequence cl-seq--test-list)) - (tests '((should (equal '(b b b b b b b) (cl-fill _list 'b))) - (should (equal '(1 2 3 4 b b b) (cl-fill _list 'b :start 4))) - (should (equal '(b b b b 5 2 6) (cl-fill _list 'b :end 4))) - (should (equal '(1 2 b b 5 2 6) (cl-fill _list 'b :start 2 :end 4))) - (should (equal orig (cl-fill _list 'b :end 0)))))) - (dolist (test tests) - (let ((_list cl-seq--test-list)) - (cl-seq--with-side-effects orig nil - test))))) + (cl-seq-tests--relet* ((l (list 1 2 3 4 5 2 6)) + (orig (copy-sequence l))) + (should (equal '(b b b b b b b) (cl-fill l 'b))) + (should (equal '(1 2 3 4 b b b) (cl-fill l 'b :start 4))) + (should (equal '(b b b b 5 2 6) (cl-fill l 'b :end 4))) + (should (equal '(1 2 b b 5 2 6) (cl-fill l 'b :start 2 :end 4))) + (should (equal orig (cl-fill l 'b :end 0))))) ;; keywords supported: :start1 :end1 :start2 :end2 (ert-deftest cl-seq-replace-test () - (let* ((cl-seq--test-list '(1 2 3 4 5 2 6)) - (cl-seq--test-list2 (make-list 6 'a)) - (orig (copy-sequence cl-seq--test-list)) - (orig2 (copy-sequence cl-seq--test-list2)) - (tests '((should (equal '(a a a a a a 6) (cl-replace _list _list2))) - (should (equal '(a a a a a a 6) (cl-replace _list _list2 :start1 0))) - (should (equal '(a a a a a a 6) (cl-replace _list _list2 :start2 0))) - (should (equal orig (cl-replace _list _list2 :start1 (length _list)))) - (should (equal orig (cl-replace _list _list2 :start2 (length _list2)))) - (should (equal orig (cl-replace _list _list2 :end1 0))) - (should (equal orig (cl-replace _list _list2 :end2 0))) - (should (equal '(1 2 3 4 a a a) (cl-replace _list _list2 :start1 4))) - (should (equal '(a a a a 5 2 6) (cl-replace _list _list2 :end1 4))) - (should (equal '(a a 3 4 5 2 6) (cl-replace _list _list2 :start2 4))) - (should (equal '(a a a a 5 2 6) (cl-replace _list _list2 :end2 4))) - (should (equal '(1 2 a a 5 2 6) (cl-replace _list _list2 :start1 2 :end1 4))) - (should (equal '(a a 3 4 5 2 6) (cl-replace _list _list2 :start2 2 :end2 4)))))) - (dolist (test tests) - (let ((_list cl-seq--test-list) - (_list2 cl-seq--test-list2)) - (cl-seq--with-side-effects orig orig2 - test))))) + (cl-seq-tests--relet* ((l1 (list 1 2 3 4 5 2 6)) + (l2 (make-list 6 'a)) + (orig1 (copy-sequence l1))) + (should (equal '(a a a a a a 6) (cl-replace l1 l2))) + (should (equal '(a a a a a a 6) (cl-replace l1 l2 :start1 0))) + (should (equal '(a a a a a a 6) (cl-replace l1 l2 :start2 0))) + (should (equal orig1 (cl-replace l1 l2 :start1 (length l1)))) + (should (equal orig1 (cl-replace l1 l2 :start2 (length l2)))) + (should (equal orig1 (cl-replace l1 l2 :end1 0))) + (should (equal orig1 (cl-replace l1 l2 :end2 0))) + (should (equal '(1 2 3 4 a a a) (cl-replace l1 l2 :start1 4))) + (should (equal '(a a a a 5 2 6) (cl-replace l1 l2 :end1 4))) + (should (equal '(a a 3 4 5 2 6) (cl-replace l1 l2 :start2 4))) + (should (equal '(a a a a 5 2 6) (cl-replace l1 l2 :end2 4))) + (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) + (incf key-index))) + :test + (lambda (a b) + (should (eql a 'foo)) + (should (equal b (list test-index + (nth test-index list)))) + (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))) (should (equal list (cl-remove 'foo list))) - (should (equal '(1 3 4 5 6) (cl-remove 2 list))) - (should (equal '(1 3 4 5 6) (cl-remove 2 list - :key #'identity - :test (lambda (a b) (eql a b))))) + (should (equal '(1 3 4 5 6) (cl-remove 2 list))) + (should (equal '(1 3 4 5 6) (cl-remove 2 list :key #'identity :test #'eql))) (should (equal '(1 2 3 4 2) (cl-remove 4 list :test (lambda (a b) (> b a))))) (should (equal '(5 6) (cl-remove 4 list :test-not (lambda (a b) (> b a))))) - (should (equal '(1 3 5) (cl-remove 'foo list :if #'cl-evenp))) - (should (equal '(2 4 2 6) (cl-remove 'foo list :if-not #'cl-evenp))) - (should (equal '(1 2 3 4 5) (cl-remove 'foo list :if #'cl-evenp :start 4))) + (should (equal '(1 3 5) (cl-remove 'foo list :if #'evenp))) + (should (equal '(2 4 2 6) (cl-remove 'foo list :if-not #'evenp))) + (should (equal '(1 2 3 4 5) (cl-remove 'foo list :if #'evenp :start 4))) (should (equal '(1 2 3 4 5 6) (cl-remove 2 list :start 5 :end 6))) (should (equal '(1 3 4 5 2 6) (cl-remove 2 list :count 1))) (should (equal '(1 3 4 5 2 6) (cl-remove 2 list :from-end nil :count 1))) (should (equal '(1 2 3 4 5 6) (cl-remove 2 list :from-end t :count 1))))) +(ert-deftest cl-remove-if-test () + (should (equal '(1 3) (cl-remove-if #'evenp '(1 2 3 4)))) + (should (equal '(1 3) (cl-remove-if #'evenp '(1 2 3 4) :count 2))) + (should (equal '(1 3 4) (cl-remove-if #'evenp '(1 2 3 4) :start 1 :end 3))) + (should (equal '(1 3) (cl-remove-if #'evenp '(1 2 3 4) :from-end t))) + (should (equal '(2 4) (cl-remove-if #'oddp '(1 2 3 4)))) + (should (equal '() (cl-remove-if #'evenp '()))) + (should (equal '() (cl-remove-if #'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))) + (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 #'evenp '(1 2 3 4)))) + (should (equal '(2 4) (cl-remove-if-not #'evenp '(1 2 3 4) :count 2))) + (should (equal '(1 2 4) (cl-remove-if-not #'evenp '(1 2 3 4) :start 1 :end 3))) + (should (equal '(2 4) (cl-remove-if-not #'evenp '(1 2 3 4) :from-end t))) + (should (equal '(1 3) (cl-remove-if-not #'oddp '(1 2 3 4)))) + (should (equal '() (cl-remove-if-not #'evenp '()))) + (should (equal '(2) (cl-remove-if-not #'evenp '(2)))) + (should (equal '(2) (cl-remove-if-not #'evenp '(2) :key #'-)))) + ;; keywords supported: :test :test-not :key :count :start :end :from-end (ert-deftest cl-seq-delete-test () - (let* ((cl-seq--test-list '(1 2 3 4 5 2 6)) - (orig (copy-sequence cl-seq--test-list)) - (tests '((should (equal orig (cl-delete 'foo _list))) - (should (equal '(1 3 4 5 6) (cl-delete 2 _list))) - (should (equal '(1 3 4 5 6) (cl-delete 2 _list - :key #'identity - :test (lambda (a b) (eql a b))))) - (should (equal '(1 2 3 4 2) (cl-delete 4 _list :test (lambda (a b) (> b a))))) - (should (equal '(5 6) (cl-delete 4 _list :test-not (lambda (a b) (> b a))))) - (should (equal '(1 3 5) (cl-delete 'foo _list :if #'cl-evenp))) - (should (equal '(2 4 2 6) (cl-delete 'foo _list :if-not #'cl-evenp))) - (should (equal '(1 2 3 4 5) (cl-delete 'foo _list :if #'cl-evenp :start 4))) - (should (equal '(1 2 3 4 5 6) (cl-delete 2 _list :start 5 :end 6))) - (should (equal '(1 3 4 5 2 6) (cl-delete 2 _list :count 1))) - (should (equal '(1 3 4 5 2 6) (cl-delete 2 _list :from-end nil :count 1))) - (should (equal '(1 2 3 4 5 6) (cl-delete 2 _list :from-end t :count 1)))))) - (dolist (test tests) - (let ((_list cl-seq--test-list)) - (cl-seq--with-side-effects orig nil - test))))) + (cl-seq-tests--relet* ((l (list 1 2 3 4 5 2 6)) + (orig (copy-sequence l))) + (should (equal orig (cl-delete 'foo l))) + (should (equal '(1 3 4 5 6) (cl-delete 2 l))) + (should (equal '(1 3 4 5 6) (cl-delete 2 l :key #'identity :test #'eql))) + (should (equal '(1 2 3 4 2) (cl-delete 4 l :test (lambda (a b) (> b a))))) + (should (equal '(5 6) (cl-delete 4 l :test-not (lambda (a b) (> b a))))) + (should (equal '(1 3 5) (cl-delete 'foo l :if #'evenp))) + (should (equal '(2 4 2 6) (cl-delete 'foo l :if-not #'evenp))) + (should (equal '(1 2 3 4 5) (cl-delete 'foo l :if #'evenp :start 4))) + (should (equal '(1 2 3 4 5 6) (cl-delete 2 l :start 5 :end 6))) + (should (equal '(1 3 4 5 2 6) (cl-delete 2 l :count 1))) + (should (equal '(1 3 4 5 2 6) (cl-delete 2 l :from-end nil :count 1))) + (should (equal '(1 2 3 4 5 6) (cl-delete 2 l :from-end t :count 1))))) + +(ert-deftest cl-delete-if-test () + (cl-seq-tests--relet* ((l (list 1 2 3 4 5))) + (should (equal '(1 3 5) (cl-delete-if #'evenp l))) + (should (equal '(1 3 5) (cl-delete-if #'evenp l :start 0 :end 4))) + (should (equal '(1 3 5) (cl-delete-if #'evenp l :from-end t))) + (should (equal '(2 4) (cl-delete-if #'oddp l)))) + (should (equal '() (cl-delete-if #'evenp '()))) + (should (equal '() (cl-delete-if #'evenp (list 2))))) + +(ert-deftest cl-delete-if-not-test () + (should (equal '(2 4) (cl-delete-if-not #'evenp (list 1 2 3 4 5)))) + (should (equal '() (cl-delete-if-not #'evenp '()))) + (should (equal '() (cl-delete-if-not #'evenp (list 1))))) + +(ert-deftest cl-delete-duplicates-test () + (should (equal '(3 2 1) (cl-delete-duplicates (list 1 2 3 2 1)))) + (should (equal '() (cl-delete-duplicates '())))) ;; keywords supported: :test :test-not :key :start :end :from-end (ert-deftest cl-seq-remove-duplicates-test () @@ -147,10 +222,10 @@ Body are forms defining the test." (should (equal list (cl-remove-duplicates list :start 2))) (should (equal list (cl-remove-duplicates list :start 2 :from-end t))) (should (equal list (cl-remove-duplicates list :end 4))) - (should (equal '(6) (cl-remove-duplicates list :test (lambda (a b) (< a b))))) - (should (equal '(1 2 6) (cl-remove-duplicates list :test (lambda (a b) (>= a b))))) - (should (equal (cl-remove-duplicates list :test (lambda (a b) (>= a b))) - (cl-remove-duplicates list :test-not (lambda (a b) (< a b))))) + (should (equal '(6) (cl-remove-duplicates list :test #'<))) + (should (equal '(1 2 6) (cl-remove-duplicates list :test #'>=))) + (should (equal (cl-remove-duplicates list :test #'>=) + (cl-remove-duplicates list :test-not #'<))) (should (equal (cl-remove-duplicates list) (cl-remove-duplicates list :key #'number-to-string :test #'string=))) (should (equal list @@ -168,60 +243,126 @@ Body are forms defining the test." (should (equal '(1 b 3 4 5 2 6) (cl-substitute 'b 2 list :count 1))) (should (equal '(1 2 3 4 5 b 6) (cl-substitute 'b 2 list :count 1 :from-end t))) (should (equal list (cl-substitute 'b 2 list :count -1))) - (should (equal '(1 b 3 4 5 b 6) (cl-substitute 'b "2" list :key #'number-to-string + (should (equal '(1 b 3 4 5 b 6) (cl-substitute 'b "2" list + :key #'number-to-string :test #'string=))) (should (equal (cl-substitute 'b 2 list) (cl-substitute 'b 2 list :test #'eq))) - (should (equal '(1 2 b b b 2 b) (cl-substitute 'b 2 list :test (lambda (a b) (< a b))))) - (should (equal '(b b 3 4 5 b 6) (cl-substitute 'b 2 list :test (lambda (a b) (>= a b))))) - (should (equal list (cl-substitute 'b 99 list :test (lambda (a b) (< a b))))) - (should (equal (cl-substitute 'b 2 list :test (lambda (a b) (>= a b))) - (cl-substitute 'b 2 list :test-not (lambda (a b) (< a b))))) - (should (equal '(1 2 b b b 2 b) (cl-substitute 'b nil list :if (lambda (x) (> (cl-position x list) 1))))) - (should (equal '(1 b b b b b b) (cl-substitute 'b nil list :if (lambda (x) (> (cl-position x list :from-end t) 1))))) + (should (equal '(1 2 b b b 2 b) (cl-substitute 'b 2 list :test #'<))) + (should (equal '(b b 3 4 5 b 6) (cl-substitute 'b 2 list :test #'>=))) + (should (equal list (cl-substitute 'b 99 list :test #'<))) + (should (equal (cl-substitute 'b 2 list :test #'>=) + (cl-substitute 'b 2 list :test-not #'<))) + (let ((pred (lambda (x) (> (cl-position x list) 1)))) + (should (equal '(1 2 b b b 2 b) (cl-substitute 'b nil list :if pred)))) + (let ((pred (lambda (x) (> (cl-position x list :from-end t) 1)))) + (should (equal '(1 b b b b b b) (cl-substitute 'b nil list :if pred)))) + (let ((pred (lambda (x) (> (cl-position x list) 1)))) + (should (equal '(b b 3 4 5 b 6) (cl-substitute 'b nil list :if-not pred)))) + (let ((pred (lambda (x) (> (cl-position x list :from-end t) 1)))) + (should (equal '(b 2 3 4 5 2 6) (cl-substitute 'b nil list :if-not pred)))))) - (should (equal '(b b 3 4 5 b 6) (cl-substitute 'b nil list - :if-not (lambda (x) (> (cl-position x list) 1))))) - (should (equal '(b 2 3 4 5 2 6) (cl-substitute 'b nil list - :if-not (lambda (x) (> (cl-position x list :from-end t) 1))))))) +(ert-deftest cl-seq-substitute-if-test () + (let ((result (cl-substitute-if 'x #'evenp '(1 2 3 4 5)))) + (should (equal result '(1 x 3 x 5)))) + (let ((result (cl-substitute-if 'x #'evenp '(1 3 5)))) + (should (equal result '(1 3 5)))) + (let ((result (cl-substitute-if 'x #'always '(1 2 3 4 5)))) + (should (equal result '(x x x x x)))) + (let ((result (cl-substitute-if 'x #'evenp '(1 2 3 4 5) :start 1 :end 4))) + (should (equal result '(1 x 3 x 5)))) + (let ((result (cl-substitute-if 'x #'oddp '(1 2 3 4 5) :from-end t))) + (should (equal result '(x 2 x 4 x)))) + (let ((result (cl-substitute-if 'x (lambda (n) (= n 3)) '(1 2 3 4 5) + :key #'identity))) + (should (equal result '(1 2 x 4 5))))) +(ert-deftest cl-seq-substitute-if-not-test () + (let ((result (cl-substitute-if-not 'x #'evenp '(1 2 3 4 5)))) + (should (equal result '(x 2 x 4 x)))) + (let ((result (cl-substitute-if-not 'x #'evenp '(2 4 6)))) + (should (equal result '(2 4 6)))) + (let ((result (cl-substitute-if-not 'x (lambda (n) (> n 5)) '(1 2 3 4 5)))) + (should (equal result '(x x x x x)))) + (let ((result (cl-substitute-if-not 'x #'evenp '(1 2 3 4 5) :start 0 :end 4))) + (should (equal result '(x 2 x 4 5)))) + (let ((result (cl-substitute-if-not 'x #'oddp '(1 2 3 4 5) :from-end t))) + (should (equal result '(1 x 3 x 5)))) + (let ((result (cl-substitute-if-not 'x (lambda (n) (= n 3)) '(1 2 3 4 5) + :key #'identity))) + (should (equal result '(x x 3 x x))))) + +(ert-deftest cl-find-if-test () + (let ((result (cl-find-if #'evenp '(1 2 3 4 5)))) + (should (equal result 2))) + (let ((result (cl-find-if (lambda (n) (> n 5)) '(1 2 3 4 5)))) + (should (equal result nil))) + (let ((result (cl-find-if (lambda (n) (> n 3)) '(1 2 3 4 5 6 7)))) + (should (equal result 4))) + (let ((result (cl-find-if #'evenp '(1 2 3 4 5) :start 2))) + (should (equal result 4))) + (let ((result (cl-find-if #'evenp '(1 2 3 4 5) :end 1))) + (should (equal result nil))) + (let ((result (cl-find-if #'oddp '(2 4 5 6 7) :from-end t))) + (should (equal result 7))) + (let ((result (cl-find-if (lambda (n) (= n 4)) '(1 2 3 4 5) :key #'identity))) + (should (equal result 4)))) + +(ert-deftest cl-find-if-not-test () + (let ((result (cl-find-if-not #'evenp '(1 2 3 4 5)))) + (should (equal result 1))) + (let ((result (cl-find-if-not #'oddp '(1 3 5)))) + (should (equal result nil))) + (let ((result (cl-find-if-not (lambda (n) (< n 4)) '(1 2 3 4 5 6 7)))) + (should (equal result 4))) + (let ((result (cl-find-if-not #'evenp '(1 2 3 4 5) :start 2))) + (should (equal result 3))) + (let ((result (cl-find-if-not #'evenp '(1 2 3 4 5) :end 3))) + (should (equal result 1))) + (let ((result (cl-find-if-not #'oddp '(2 4 6 7 8) :from-end t))) + (should (equal result 8))) + (let ((result (cl-find-if-not (lambda (n) (= n 4)) '(1 2 3 4 5) :key #'identity))) + (should (equal result 1)))) ;; keywords supported: :test :test-not :key :count :start :end :from-end (ert-deftest cl-seq-nsubstitute-test () - (let ((cl-seq--test-list '(1 2 3 4 5 2 6)) - (orig (copy-sequence cl-seq--test-list)) - (tests '((should (equal '(1 b 3 4 5 b 6) (cl-nsubstitute 'b 2 _list))) - (should (equal _list (cl-substitute 'b 2 _list :start (length _list)))) - (should (equal _list (cl-substitute 'b 2 _list :end 0))) - (should (equal '(1 2 3 4 5 b 6) (cl-substitute 'b 2 _list :start 2))) - (should (equal '(1 b 3 4 5 2 6) (cl-substitute 'b 2 _list :end 2))) - (should (equal _list (cl-substitute 'b 2 _list :start 2 :end 4))) - (should (equal '(1 b 3 4 5 2 6) (cl-nsubstitute 'b 2 _list :count 1))) - (should (equal '(1 2 3 4 5 b 6) (cl-nsubstitute 'b 2 _list :count 1 :from-end t))) - (should (equal _list (cl-nsubstitute 'b 2 _list :count -1))) - (should (equal '(1 b 3 4 5 b 6) (cl-nsubstitute 'b "2" _list :key #'number-to-string - :test #'string=))) - (should (equal (cl-nsubstitute 'b 2 _list) - (cl-nsubstitute 'b 2 _list :test #'eq))) - (should (equal '(1 2 b b b 2 b) (cl-nsubstitute 'b 2 _list :test (lambda (a b) (< a b))))) - (should (equal '(b b 3 4 5 b 6) (cl-nsubstitute 'b 2 _list :test (lambda (a b) (>= a b))))) - (should (equal _list (cl-nsubstitute 'b 99 _list :test (lambda (a b) (< a b))))) - (should (equal (cl-nsubstitute 'b 2 _list :test (lambda (a b) (>= a b))) - (cl-nsubstitute 'b 2 _list :test-not (lambda (a b) (< a b))))) - (should (equal '(1 2 b b b 2 b) - (cl-nsubstitute 'b nil _list :if (lambda (x) (> (cl-position x _list) 1))))) - (should (equal '(1 b b b b b b) - (cl-nsubstitute 'b nil _list :if (lambda (x) (> (cl-position x _list :from-end t) 1))))) - (should (equal '(b b 3 4 5 b 6) - (cl-nsubstitute 'b nil _list - :if-not (lambda (x) (> (cl-position x _list) 1))))) - (should (equal '(b 2 3 4 5 2 6) - (cl-nsubstitute 'b nil _list - :if-not (lambda (x) (> (cl-position x _list :from-end t) 1)))))))) - (dolist (test tests) - (let ((_list cl-seq--test-list)) - (cl-seq--with-side-effects orig nil - test))))) + (cl-seq-tests--relet* ((l (list 1 2 3 4 5 2 6)) + (orig (copy-sequence l))) + (should (equal '(1 b 3 4 5 b 6) (cl-nsubstitute 'b 2 l))) + (should (equal orig (cl-nsubstitute 'b 2 l :start (length l)))) + (should (equal orig (cl-nsubstitute 'b 2 l :end 0))) + (should (equal '(1 2 3 4 5 b 6) (cl-nsubstitute 'b 2 l :start 2))) + (should (equal '(1 b 3 4 5 2 6) (cl-nsubstitute 'b 2 l :end 2))) + (should (equal orig (cl-nsubstitute 'b 2 l :start 2 :end 4))) + (should (equal '(1 b 3 4 5 2 6) (cl-nsubstitute 'b 2 l :count 1))) + (should (equal '(1 2 3 4 5 b 6) (cl-nsubstitute 'b 2 l :count 1 :from-end t))) + (should (equal orig (cl-nsubstitute 'b 2 l :count -1))) + (should (equal '(1 b 3 4 5 b 6) (cl-nsubstitute 'b "2" l + :key #'number-to-string + :test #'string=))) + (should (equal (cl-nsubstitute 'b 2 orig) + (cl-nsubstitute 'b 2 l :test #'eq))) + (should (equal '(1 2 b b b 2 b) (cl-nsubstitute 'b 2 l :test #'<))) + (should (equal '(b b 3 4 5 b 6) (cl-nsubstitute 'b 2 l :test #'>=))) + (should (equal orig (cl-nsubstitute 'b 99 l :test #'<))) + (should (equal (cl-nsubstitute 'b 2 orig :test #'>=) + (cl-nsubstitute 'b 2 l :test-not #'<))) + (let ((pred (lambda (x) (> (cl-position x orig) 1)))) + (should (equal '(1 2 b b b 2 b) (cl-nsubstitute 'b nil l :if pred)))) + (let ((pred (lambda (x) (> (cl-position x orig :from-end t) 1)))) + (should (equal '(1 b b b b b b) (cl-nsubstitute 'b nil l :if pred)))) + (let ((pred (lambda (x) (> (cl-position x orig) 1)))) + (should (equal '(b b 3 4 5 b 6) (cl-nsubstitute 'b nil l :if-not pred)))) + (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 () @@ -231,16 +372,32 @@ Body are forms defining the test." (should (= 5 (cl-position 2 list :start 5 :end 6))) (should (= 1 (cl-position 2 list :from-end nil))) (should (= 5 (cl-position 2 list :from-end t))) - (should (cl-position 2 list :key #'identity - :test (lambda (a b) (eql a b)))) + (should (cl-position 2 list :key #'identity :test #'eql)) (should (= 1 (cl-position "2" list :key #'number-to-string :test #'string=))) - (should (= 5 (cl-position "2" list :key #'number-to-string :test #'string= :from-end t))) + (should (= 5 (cl-position "2" list :key #'number-to-string + :test #'string= :from-end t))) (should-not (cl-position "2" list :key #'number-to-string)) (should (cl-position 5 list :key (lambda (x) (1+ (* 1.0 x x))) :test #'=)) (should-not (cl-position 5 list :key (lambda (x) (1+ (* 1.0 x x))))) (should (= 1 (cl-position 5 list :key (lambda (x) (1+ (* x x)))))) (should (= 5 (cl-position 5 list :key (lambda (x) (1+ (* x x))) :from-end t))))) +(ert-deftest cl-position-if-test () + (let ((result (cl-position-if #'evenp '(1 2 3 4 5)))) + (should (equal result 1))) + (let ((result (cl-position-if (lambda (n) (> n 5)) '(1 2 3 4 5)))) + (should (equal result nil))) + (let ((result (cl-position-if (lambda (n) (> n 3)) '(1 2 3 4 5 6 7)))) + (should (equal result 3))) + (let ((result (cl-position-if #'evenp '(1 2 3 4 5) :start 2))) + (should (equal result 3))) + (let ((result (cl-position-if #'evenp '(1 2 3 4 5) :end 1))) + (should (equal result nil))) + (let ((result (cl-position-if #'oddp '(2 4 5 6 7) :from-end t))) + (should (equal result 4))) + (let ((result (cl-position-if (lambda (n) (= n 4)) '(1 2 3 4 5) :key #'identity))) + (should (equal result 3)))) + ;; keywords supported: :test :test-not :key :start :end (ert-deftest cl-seq-count-test () (let ((list '(1 2 3 4 5 2 6))) @@ -249,10 +406,63 @@ Body are forms defining the test." (should (= 1 (cl-count 2 list :end 4))) (should (= 0 (cl-count -5 list))) (should (= 0 (cl-count 2 list :start 2 :end 4))) - (should (= 4 (cl-count 'foo list :key (lambda (x) (and (cl-evenp x) 'foo))))) - (should (= 4 (cl-count 'foo list :test (lambda (_a b) (cl-evenp b))))) - (should (equal (cl-count 'foo list :test (lambda (_a b) (cl-oddp b))) - (cl-count 'foo list :test-not (lambda (_a b) (cl-evenp b))))))) + (should (= 4 (cl-count 'foo list :key (lambda (x) (and (evenp x) 'foo))))) + (should (= 4 (cl-count 'foo list :test (lambda (_a b) (evenp b))))) + (should (equal (cl-count 'foo list :test (lambda (_a b) (oddp b))) + (cl-count 'foo list :test-not (lambda (_a b) (evenp b))))))) + +(ert-deftest cl-count-if-test () + (let ((result (cl-count-if #'evenp '(1 2 3 4 5)))) + (should (equal result 2))) + (let ((result (cl-count-if #'oddp '(2 4 6 8)))) + (should (equal result 0))) + (let ((result (cl-count-if #'always '(1 2 3 4)))) + (should (equal result 4))) + (let ((result (cl-count-if #'ignore '(1 2 3 4)))) + (should (equal result 0))) + (let ((result (cl-count-if (lambda (x) (> x 2)) '(1 2 3 4 5) :key #'identity))) + (should (equal result 3))) + (let ((result (cl-count-if #'evenp '(1 2 3 4 5) :start 2))) + (should (equal result 1))) + (let ((result (cl-count-if #'evenp '(1 2 3 4 5) :end 3))) + (should (equal result 1))) + (let ((result (cl-count-if #'evenp '()))) + (should (equal result 0))) + (let ((result (cl-count-if #'numberp '(1 "two" 3 4 "five" 6)))) + (should (equal result 4))) + (let ((result (cl-count-if (lambda (x) (and (numberp x) (> x 2))) '(1 2 3 4 5 6)))) + (should (equal result 4)))) + +(ert-deftest cl-count-if-not-test () + (let ((result (cl-count-if-not #'evenp '(1 2 3 4 5)))) + (should (equal result 3))) + (let ((result (cl-count-if-not #'oddp '(1 3 5)))) + (should (equal result 0))) + (let ((result (cl-count-if-not #'always '(1 2 3 4)))) + (should (equal result 0))) + (let ((result (cl-count-if-not #'ignore '(1 2 3 4)))) + (should (equal result 4))) + (let ((result (cl-count-if-not (lambda (x) (> x 3)) '(1 2 3 4 5) :key #'identity))) + (should (equal result 3))) + (let ((result (cl-count-if-not #'evenp '(1 2 3 4 5) :start 2))) + (should (equal result 2))) + (let ((result (cl-count-if-not #'evenp '(1 2 3 4 5) :end 3))) + (should (equal result 2))) + (let ((result (cl-count-if-not #'evenp '()))) + (should (equal result 0))) + (let ((result (cl-count-if-not #'numberp '(1 "two" 3 4 "five" 6)))) + (should (equal result 2))) + (let ((result (cl-count-if-not (lambda (x) (and (numberp x) (> x 2))) + '(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 () @@ -268,9 +478,9 @@ Body are forms defining the test." (should-not (cl-mismatch list list2 :end1 1 :end2 1)) (should-not (cl-mismatch list list2 :start1 1 :start2 2)) (should (= 1 (cl-mismatch list list2 :start1 1 :end1 2 :start2 4 :end2 4))) - (should (= -1 (cl-mismatch list list2 :key #'number-to-string + (should (= -1 (cl-mismatch list list2 :from-end t :key #'number-to-string :test (lambda (a b) - (and (stringp a) (stringp b))) :from-end t))) + (and (stringp a) (stringp b)))))) (should (= 7 (cl-mismatch list list2 :key #'number-to-string :test (lambda (a b) (and (stringp a) (stringp b)))))))) @@ -286,16 +496,17 @@ Body are forms defining the test." (should (= 0 (cl-search list list2 :end1 1))) (should (= 0 (cl-search nil list2))) (should (= 2 (cl-search list list2 :start1 1 :end1 2 :end2 3))) - (should (= 0 (cl-search list list2 :test (lambda (a b) (and (numberp a) (numberp b)))))) + (should (= 0 (cl-search list list2 :test (lambda (a b) + (and (numberp a) (numberp b)))))) (should (= 0 (cl-search list list2 :key (lambda (x) (and (numberp x) 'foo)) :test (lambda (a b) (and (eq a 'foo) (eq b 'foo)))))) (should (= 1 (cl-search (nthcdr 2 list) (nthcdr 2 list2)))) (should (= 3 (cl-search (nthcdr 2 list) list2))))) (ert-deftest cl-seq-test-bug24264 () - "Test for https://debbugs.gnu.org/24264 ." + "Test for bug#24264." :tags '(:expensive-test) - (let ((list (append (make-list 8000005 1) '(8))) + (let ((list (nconc (make-list 8000005 1) '(8))) (list2 (make-list 8000005 2))) (should (cl-position 8 list)) (should-not (equal '(8) (last (cl-remove 8 list)))) @@ -312,5 +523,638 @@ Body are forms defining the test." (should (eq (cl-assoc x a) (car a))) (should (eq (cl-rassoc x a) (cadr a)))))) +(ert-deftest cl-sort-test () + (let ((result (cl-sort (list 3 1 4 1 5 9 2 6 5 3 5) #'<))) + (should (equal result '(1 1 2 3 3 4 5 5 5 6 9)))) + (let ((result (cl-sort (list 5 3 2 8 1 4) #'>))) + (should (equal result '(8 5 4 3 2 1)))) + (let ((result (cl-sort (list "banana" "apple" "cherry") #'string<))) + (should (equal result '("apple" "banana" "cherry")))) + (let ((result (cl-sort (list "banana" "fig" "apple" "kiwi") + (lambda (x y) (length< x (length y))) + :key #'identity))) + (should (equal result '("fig" "kiwi" "apple" "banana")))) + (let ((result (cl-sort (vector 3 1 4 1 5) #'<))) + (should (equal result [1 1 3 4 5]))) + (let ((result (cl-sort (list 1 2 3 4 5) #'<))) + (should (equal result '(1 2 3 4 5)))) + (let ((result (cl-sort (list -3 1 4 -1 -5 9) #'<))) + (should (equal result '(-5 -3 -1 1 4 9)))) + (let ((result (cl-sort (list 1 2 3 4 5) #'>))) + (should (equal result '(5 4 3 2 1)))) + (let ((result (cl-sort '() #'<))) + (should (equal result '()))) + (let ((result (cl-sort (list "Banana" "apple" "cherry") + #'string< :key #'downcase))) + (should (equal result '("apple" "Banana" "cherry")))) ) + +(ert-deftest cl-stable-sort-test () + (let ((result (cl-stable-sort (list 3 1 4 1 5 9 2 6 5 3 5) #'<))) + (should (equal result '(1 1 2 3 3 4 5 5 5 6 9)))) + (let ((result (cl-stable-sort (list 5 3 2 8 1 4) #'>))) + (should (equal result '(8 5 4 3 2 1)))) + (let ((result (cl-stable-sort (list "banana" "apple" "cherry") #'string<))) + (should (equal result '("apple" "banana" "cherry")))) + (let ((result (cl-stable-sort (list "banana" "fig" "apple" "kiwi") + (lambda (x y) (length< x (length y))) + :key #'identity))) + (should (equal result '("fig" "kiwi" "apple" "banana")))) + (let ((result (cl-stable-sort (vector 3 1 4 1 5) #'<))) + (should (equal result [1 1 3 4 5]))) + (let ((result (cl-stable-sort (list 1 2 3 4 5) #'<))) + (should (equal result '(1 2 3 4 5)))) + (let ((result (cl-stable-sort (list -3 1 4 -1 -5 9) #'<))) + (should (equal result '(-5 -3 -1 1 4 9)))) + (let ((result (cl-stable-sort (list 1 2 3 4 5) #'>))) + (should (equal result '(5 4 3 2 1)))) + (let ((result (cl-stable-sort '() #'<))) + (should (equal result '()))) + (let ((result (cl-stable-sort (list "Banana" "apple" "cherry") + #'string< :key #'downcase))) + (should (equal result '("apple" "Banana" "cherry")))) ) + +(ert-deftest cl-merge-test () + (let ((result (cl-merge 'list (list 1 3 5) (list 2 4 6) #'<))) + (should (equal result '(1 2 3 4 5 6)))) + (let ((result (cl-merge 'list (list 1 3 3 5) (list 2 3 4 6) #'<))) + (should (equal result '(1 2 3 3 3 4 5 6)))) + (let ((result (cl-merge 'list '() (list 2 4 6) #'<))) + (should (equal result '(2 4 6)))) + (let ((result (cl-merge 'list (list 1 3 5) '() #'<))) + (should (equal result '(1 3 5)))) + (let ((result (cl-merge 'list '() '() #'<))) + (should (equal result '()))) + (let ((result (cl-merge 'list (list 1 4 6) (list 2 3 5) #'< :key #'identity))) + (should (equal result '(1 2 3 4 5 6)))) + (let ((result (cl-merge 'vector (vector 1 3 5) (vector 2 4 6) #'<))) + (should (equal result [1 2 3 4 5 6]))) + (let ((result (cl-merge 'list (list 5 3 1) (list 6 4 2) #'>))) + (should (equal result '(6 5 4 3 2 1)))) + (let ((result (cl-merge 'list (list 1 2 3) (list 1 2 3) #'>))) + (should (equal result '(1 2 3 1 2 3)))) + (let ((result (cl-merge 'list (list 1 2) (list 3 4 5) #'<))) + (should (equal result '(1 2 3 4 5)))) + (let ((result (cl-merge 'list (list 4 5 6) (list 1 2 3) #'<))) + (should (equal result '(1 2 3 4 5 6)))) + (let ((result (cl-merge 'list (list 1 2 3) (list 1.5 2.5 3.5) #'<))) + (should (equal result '(1 1.5 2 2.5 3 3.5)))) + (let ((result (cl-merge 'list (list 1 2 3) (list 10 20 30) + #'< :key (lambda (x) (* x 10))))) + (should (equal result '(1 2 3 10 20 30))))) + +(ert-deftest cl-member-test () + (let ((result (cl-member 'b '(a b c d)))) + (should (equal result '(b c d)))) + (let ((result (cl-member 'x '(a b c d)))) + (should (equal result nil))) + (let ((result (cl-member 'a '(a b a c d)))) + (should (equal result '(a b a c d)))) + (let ((result (cl-member "test" '("test" "not-test" "test2") :test #'string=))) + (should (equal result '("test" "not-test" "test2")))) + (let ((result (cl-member 'x '(a b c d) :test-not #'eq))) + (should (equal result '(a b c d)))) + (let ((result (cl-member 3 '(1 2 3 4 5) :key #'identity))) + (should (equal result '(3 4 5)))) + (let ((result (cl-member 2.5 '(1 2 2.5 3) :test #'equal))) + (should (equal result '(2.5 3)))) + (let ((result (cl-member 'a '(a a a a) :test #'eq))) + (should (equal result '(a a a a)))) + (let ((result (cl-member 'a '()))) + (should (equal result nil))) + (let ((result (cl-member 'b '(a c d) :test-not #'eq))) + (should (equal result '(a c d)))) + (let ((result (cl-member 3 '(1 2 3 4 5) :key #'1+))) + (should (equal result '(2 3 4 5))))) + +(ert-deftest cl-member-if-test () + (let ((result (cl-member-if #'evenp '(1 2 3 4 5)))) + (should (equal result '(2 3 4 5)))) + (let ((result (cl-member-if #'ignore '(1 2 3 4 5)))) + (should (equal result nil))) + (let ((result (cl-member-if #'always '(1 2 3 4 5)))) + (should (equal result '(1 2 3 4 5)))) + (let ((result (cl-member-if (lambda (x) (= x 1)) '(1 2 3 4 5)))) + (should (equal result '(1 2 3 4 5)))) + (let ((result (cl-member-if (lambda (x) (and (numberp x) (evenp x))) + '(1 3 5 4 2)))) + (should (equal result '(4 2)))) + (let ((result (cl-member-if (lambda (x) (string= (number-to-string x) "3")) + '(1 2 3 4 5) :key #'identity))) + (should (equal result '(3 4 5)))) + (let ((result (cl-member-if (lambda (x) (eq x 'a)) '(a a a a)))) + (should (equal result '(a a a a)))) + (let ((result (cl-member-if #'evenp '()))) + (should (equal result nil))) + (let ((result (cl-member-if #'minusp '(1 2 3 4 5)))) + (should (equal result nil))) + (let ((result (cl-member-if (lambda (x) (and (numberp x) (<= x 2))) + '(1 "two" 3 0)))) + (should (equal result '(1 "two" 3 0)))) + (let ((result (cl-member-if (lambda (x) (> x 5)) '(1 2 3 6 7 8) + :key #'identity))) + (should (equal result '(6 7 8))))) + +(ert-deftest cl-member-if-not-test () + (let ((result (cl-member-if-not #'evenp '(1 2 3 4 5)))) + (should (equal result '(1 2 3 4 5)))) + (let ((result (cl-member-if-not #'evenp '(2 4 6 8 10 11)))) + (should (equal result '(11)))) + (let ((result (cl-member-if-not (lambda (x) (> x 5)) '(1 2 3 4 5)))) + (should (equal result '(1 2 3 4 5)))) + (let ((result (cl-member-if-not #'always '(1 2 3 4 5)))) + (should (equal result nil))) + (let ((result (cl-member-if-not (lambda (x) (= x 1)) '(1 2 3 4 5)))) + (should (equal result '(2 3 4 5)))) + (let ((result (cl-member-if-not (lambda (x) (string= (number-to-string x) "2")) + '(1 2 3 4 5) :key #'identity))) + (should (equal result '(1 2 3 4 5)))) + (let ((result (cl-member-if-not #'evenp '()))) + (should (equal result nil))) + (let ((result (cl-member-if-not (lambda (x) (eq x 'a)) '(a a a a)))) + (should (equal result nil))) + (let ((result (cl-member-if-not #'minusp '(1 2 3 4 5)))) + (should (equal result '(1 2 3 4 5)))) + (let ((result (cl-member-if-not + (lambda (x) (or (numberp x) (stringp x) (eq x 'b))) + '(a "b" 3 nil)))) + (should (equal result '(a "b" 3 nil)))) + (let ((result (cl-member-if-not #'numberp '(1 "two" 3 "four" 5) + :key #'identity))) + (should (equal result '("two" 3 "four" 5))))) + +(ert-deftest cl-assoc-test () + (let ((result (cl-assoc 'b '((a . 1) (b . 2) (c . 3))))) + (should (equal result '(b . 2)))) + (let ((result (cl-assoc 'x '((a . 1) (b . 2) (c . 3))))) + (should (equal result nil))) + (let ((result (cl-assoc "key" '(("key" . 1) ("not-key" . 2)) :test #'string=))) + (should (equal result '("key" . 1)))) + (let ((result (cl-assoc 'a '((a . 1) (b . 2) (c . 3)) :test-not #'eq))) + (should (equal result '(b . 2)))) + (let ((result (cl-assoc '2 '((1 . 'a) (2 . 'b) (3 . 'c)) :key #'identity))) + (should (equal result '(2 . 'b)))) + (let ((result (cl-assoc 'a '((a . 1) (a . 2) (a . 3)) :test #'eq))) + (should (equal result '(a . 1)))) + (let ((result (cl-assoc 'a '()))) + (should (equal result nil))) + (let ((result (cl-assoc 'b '((a . 1) (b . 2) (b . 3) (c . 4))))) + (should (equal result '(b . 2))))) + +(ert-deftest cl-assoc-if-test () + (let ((result (cl-assoc-if #'evenp + '((1 . "odd") (2 . "even") (3 . "odd") (4 . "even"))))) + (should (equal result '(2 . "even")))) + (let ((result (cl-assoc-if (lambda (x) (= x 5)) + '((1 . "one") (2 . "two") (3 . "three"))))) + (should (equal result nil))) + (let ((result (cl-assoc-if (lambda (x) (= x 1)) + '((1 . "one") (2 . "two") (3 . "three"))))) + (should (equal result '(1 . "one")))) + (let ((result (cl-assoc-if (lambda (x) (string= x "baz")) + '((foo . 1) (bar . 2) (baz . 3))))) + (should (equal result '(baz . 3)))) + (let ((result (cl-assoc-if (lambda (x) (and (numberp x) (> x 2))) + '((1 . "one") (3 . "three") (4 . "four"))))) + (should (equal result '(3 . "three")))) + (let ((result (cl-assoc-if (lambda (x) (> x 1)) + '((0 . "zero") (1 . "one") (2 . "two"))))) + (should (equal result '(2 . "two")))) + (let ((result (cl-assoc-if #'evenp '()))) + (should (equal result nil))) + (let ((result (cl-assoc-if (lambda (x) (eq x 'a)) + '((a . "first") (a . "second") (b . "third"))))) + (should (equal result '(a . "first")))) + (let ((result (cl-assoc-if (lambda (x) (and (symbolp x) (not (eq x 'b)))) + '((b . "b") (c . "c") (d . "d"))))) + (should (equal result '(c . "c")))) + (let ((result (cl-assoc-if #'cdr '(((1 2) . "pair 1") ((1) . "pair 2"))))) + (should (equal result '((1 2) . "pair 1"))))) + +(ert-deftest cl-assoc-if-not-test () + (let* ((alist '((1 . "odd") (2 . "even") (3 . "odd") (4 . "even"))) + (result (cl-assoc-if-not #'evenp alist))) + (should (equal result '(1 . "odd")))) + (let ((result (cl-assoc-if-not #'plusp + '((1 . "one") (2 . "two") (3 . "three"))))) + (should (equal result nil))) + (let ((result (cl-assoc-if-not (lambda (x) (< x 5)) + '((1 . "one") (2 . "two") (3 . "three"))))) + (should (equal result nil))) + (let ((result (cl-assoc-if-not (lambda (x) (= x 1)) + '((1 . "one") (2 . "two") (3 . "three"))))) + (should (equal result '(2 . "two")))) + (let ((result (cl-assoc-if-not + (lambda (x) (string= x "baz")) + '((foo . "first") (bar . "second") (baz . "third"))))) + (should (equal result '(foo . "first")))) + (let ((result (cl-assoc-if-not (lambda (x) (and (numberp x) (> x 2))) + '((1 . "one") (3 . "three") (4 . "four"))))) + (should (equal result '(1 . "one")))) + (let ((result (cl-assoc-if-not #'symbolp + '((1 . "one") (b . "bee") (2 . "two"))))) + (should (equal result '(1 . "one")))) + (let ((result (cl-assoc-if-not #'evenp '()))) + (should (equal result nil))) + (let ((result (cl-assoc-if-not (lambda (x) (eq x 'a)) + '((a . "first") (a . "second") (b . "third"))))) + (should (equal result '(b . "third"))))) + +(ert-deftest cl-rassoc-test () + (let ((result (cl-rassoc 2 '(("one" . 1) ("two" . 2) ("three" . 3))))) + (should (equal result '("two" . 2)))) + (let ((result (cl-rassoc 4 '(("one" . 1) ("two" . 2) ("three" . 3))))) + (should (equal result nil))) + (let ((result (cl-rassoc 2 '(("one" . 1) ("two" . 2) ("baz" . 2)) + :test #'equal))) + (should (equal result '("two" . 2)))) + (let ((result (cl-rassoc 2 '(("one" . 1) ("two" . 2) ("three" . 3)) + :test-not #'equal))) + (should (equal result '("one" . 1)))) + (let ((result (cl-rassoc 1 '()))) + (should (equal result nil))) + (let ((result (cl-rassoc 1 '(("first" . 1) ("second" . 1) ("third" . 1))))) + (should (equal result '("first" . 1)))) + (let ((result (cl-rassoc 3 '(("one" . 1) ("two" . 2) ("three" . 3))))) + (should (equal result '("three" . 3)))) + (let ((result (cl-rassoc 'found + '((("pair 1") . 1) ("pair 2" . 2) ("pair 3" . 3))))) + (should (equal result nil)))) + +(ert-deftest cl-rassoc-if-test () + (let ((result (cl-rassoc-if #'evenp + '(("one" . 1) ("two" . 2) ("three" . 3))))) + (should (equal result '("two" . 2)))) + (let ((result (cl-rassoc-if #'evenp + '(("one" . 1) ("three" . 3) ("five" . 5))))) + (should (equal result nil))) + (let ((result (cl-rassoc-if (lambda (x) (= x 1)) + '(("one" . 1) ("two" . 2) ("three" . 3))))) + (should (equal result '("one" . 1)))) + (let ((result (cl-rassoc-if (lambda (x) (> x 1)) + '(("one" . 1) ("two" . 2) ("three" . 3))))) + (should (equal result '("two" . 2)))) + (let ((result (cl-rassoc-if (lambda (x) (and (numberp x) (< x 3))) + '(("one" . 1) ("two" . 2) ("three" . 3))))) + (should (equal result '("one" . 1)))) + (let ((result (cl-rassoc-if #'evenp '()))) + (should (equal result nil))) + (let ((result (cl-rassoc-if #'plusp + '(("first" . 1) ("second" . 2) ("third" . 3))))) + (should (equal result '("first" . 1)))) + (let ((result (cl-rassoc-if (lambda (x) (string= (number-to-string x) "two")) + '(("one" . 1) ("two" . 2) ("three" . 3))))) + (should (equal result nil))) + (let ((result (cl-rassoc-if #'stringp + '(("one" . 1) ("two" . 2) ("three" . 3))))) + (should (equal result nil)))) + +(ert-deftest cl-rassoc-if-not-test () + (let ((result (cl-rassoc-if-not #'evenp + '(("one" . 1) ("two" . 2) ("three" . 3))))) + (should (equal result '("one" . 1)))) + (let ((result (cl-rassoc-if-not #'plusp + '(("one" . 1) ("two" . 2) ("three" . 3))))) + (should (equal result nil))) + (let ((result (cl-rassoc-if-not (lambda (x) (< x 5)) + '(("one" . 1) ("two" . 2) ("six" . 6))))) + (should (equal result '("six" . 6)))) + (let ((result (cl-rassoc-if-not (lambda (x) (= x 1)) + '(("one" . 1) ("two" . 2) ("three" . 3))))) + (should (equal result '("two" . 2)))) + (let ((result (cl-rassoc-if-not (lambda (x) (> x 2)) + '(("one" . 1) ("two" . 1) ("three" . 3))))) + (should (equal result '("one" . 1)))) + (let ((result (cl-rassoc-if-not (lambda (x) (and (numberp x) (< x 3))) + '(("one" . 1) ("two" . 2) ("three" . 3))))) + (should (equal result '("three" . 3)))) + (let ((result (cl-rassoc-if-not (lambda (x) (equal x 2)) + '(("one" . 1) ("two" . 2) ("three" . 3))))) + (should (equal result '("one" . 1)))) + (let ((result (cl-rassoc-if-not #'evenp '()))) + (should (equal result nil))) + (let ((result (cl-rassoc-if-not #'numberp + '(("one" . 1) ("two" . 2) ("three" . 3))))) + (should (equal result nil))) + (let ((result (cl-rassoc-if-not (lambda (x) (eql (proper-list-p x) 1)) + '(((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)))) + (let ((result (cl-intersection '(1 2) '(3 4)))) + (should (equal result '()))) + (let ((result (cl-intersection '(1 2 3) '(1 2 3)))) + (should (equal result '(1 2 3)))) + (let ((result (cl-intersection '(1 1 2 3) '(1 2 2 3 4)))) + (should (equal result '(3 2 1 1)))) + (let ((result (cl-intersection `(1 ,(copy-sequence "two") 3) '(3 "two" 4)))) + (should (equal result '(3)))) + (let ((result (cl-intersection '(1 2 3) '(3 2 1) :test #'equal))) + (should (equal result '(1 2 3)))) + (let ((result (cl-intersection '(1 2 3) '(3 4 5) :key #'identity))) + (should (equal result '(3)))) + (let ((result (cl-intersection '() '(1 2 3)))) + (should (equal result '()))) + (let ((result (cl-intersection '() '()))) + (should (equal result '()))) + (let ((result (cl-intersection '(1 2 3 4 5) '(3 4 5 6 7 8)))) + (should (equal result '(5 4 3))))) + +(ert-deftest cl-nintersection-test () + (should-not (cl-nintersection () ())) + (should-not (cl-nintersection () '(1 2 3))) + (should-not (cl-nintersection (list 1 2) '(3 4))) + (should (equal (cl-nintersection (list 1 2 3 4) '(3 4 5 6)) + '(4 3))) + (should (equal (cl-nintersection (list 1 2 3) '(1 2 3)) + '(1 2 3))) + (should (equal (cl-nintersection (list 1 1 2 2 3) '(2 2 3 4)) + '(3 2 2))) + (should (equal (cl-nintersection (list 1 (copy-sequence "two") 3) + '(3 "two" 4)) + '(3))) + (should (equal (cl-nintersection (list 1 2 3) '(3 2 1) :test #'equal) + '(1 2 3)))) + +(ert-deftest cl-set-difference-test () + ;; 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)))) + (should (equal result '()))) + (let ((result (cl-set-difference '(1 1 2 3 4) '(3 4 5)))) + (should (equal result '(1 1 2)))) + (let ((result (cl-set-difference '(1 2 3) '(3 2 4)))) + (should (equal result '(1)))) + (let ((result (cl-set-difference '(1 2 3) '(3 2 1) :test #'equal))) + (should (equal result '()))) + (let ((result (cl-set-difference '((1 . "one") (2 . "two") (3 . "three")) + '((1 . "uno") (2 . "dos")) + :key #'car))) + (should (equal result '((3 . "three"))))) + (let ((result (cl-set-difference '() '(1 2 3)))) + (should (equal result '()))) + (let ((result (cl-set-difference '(1 2 3) '()))) + (should (equal result '(1 2 3)))) + (let ((result (cl-set-difference '(1 2 3 4 5) '(3 4 5 6 7)))) + (should (equal result '(1 2)))) + (let ((list1 (list 1 2 3)) + (list2 (list 2 3 4))) + (should (equal (cl-set-difference list1 list2) '(1))) + (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 (list 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 (list "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)) + (should (equal l2 '((c . 3) (d . 4) (e . 5) (f . 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 :test #'string=))) + (should (member '("a" . 1) diff)) + (should (member '("b" . 2) diff)) + (should (length= diff 2)) + (should (equal l2 '(("c" . 3) ("d" . 4) ("e" . 5) ("f" . 6)))))) + +(ert-deftest cl-nset-difference-test () + (should-not (cl-nset-difference () ())) + (should-not (cl-nset-difference () (list 1 2 3))) + (should-not (cl-nset-difference (list 1 2 3) '(1 2 3))) + (should-not (cl-nset-difference (list 1 2 3) '(3 2 1) :test #'equal)) + (should (equal (cl-nset-difference (list 1 2 3) ()) + '(1 2 3))) + (should (equal (cl-nset-difference (list 1 2 3 4) '(3 4 5 6)) + '(1 2))) + (should (equal (cl-nset-difference (list 1 1 2 2 3) '(3 4 5)) + '(1 1 2 2))) + (should (equal (cl-nset-difference (list 1 2 3) '(3 2 4)) + '(1))) + (should (equal (cl-nset-difference (list 1 2 3 4 5) '(3 4 5 6 7)) + '(1 2))) + (should (equal (cl-nset-difference (list 1 (copy-sequence "a")) '(1 "a")) + '("a")))) + +(ert-deftest cl-set-exclusive-or-test () + (let ((result (cl-set-exclusive-or '(1 2 3) '(3 4 5)))) + (should (equal result '(1 2 4 5)))) + (let ((result (cl-set-exclusive-or '(1 2 3) '()))) + (should (equal result '(1 2 3)))) + (let ((result (cl-set-exclusive-or '() '(3 4 5)))) + (should (equal result '(3 4 5)))) + (let ((result (cl-set-exclusive-or '(1 2 3) '(1 2 3)))) + (should (equal result nil))) + (let ((result (cl-set-exclusive-or '(1 1 2 3) '(3 4 5)))) + (should (equal result '(1 1 2 4 5)))) + (let ((result (cl-set-exclusive-or '(1 2 3) '(3 3 4 5)))) + (should (equal result '(1 2 4 5)))) + (let ((result (cl-set-exclusive-or '(1 2 3) '(3 2 4)))) + (should (equal result '(1 4)))) + (let ((result (cl-set-exclusive-or '(1 2 3) '(3 2 1) :test #'equal))) + (should (equal result '()))) + (let ((result (cl-set-exclusive-or '() '()))) + (should (equal result '()))) + (let ((list1 (list 1 2 3 4 5)) + (list2 (list 3 4 5 6 7))) + (should (equal (cl-set-exclusive-or list1 list2) '(1 2 6 7))) + (should (equal list1 '(1 2 3 4 5))) + (should (equal list2 '(3 4 5 6 7))))) + +(ert-deftest cl-nset-exclusive-or-test () + (should-not (cl-nset-exclusive-or () ())) + (should-not (cl-nset-exclusive-or (list 1 2 3) (list 1 2 3))) + (should-not (cl-nset-exclusive-or (list 1 2 3) (list 3 2 1) :test #'equal)) + (should (equal (cl-nset-exclusive-or (list 1 2 3) (list 3 4 5)) + '(1 2 4 5))) + (should (equal (cl-nset-exclusive-or (list 1 2 3) ()) + '(1 2 3))) + (should (equal (cl-nset-exclusive-or (list 1 1 2 2 3) (list 3 4 5)) + '(1 1 2 2 4 5))) + (should (equal (cl-nset-exclusive-or (list 1 2 3) (list 3 3 4 5)) + '(1 2 4 5))) + (should (equal (cl-nset-exclusive-or (list 1 2 3) (list 3 2 4)) + '(1 4))) + (should (equal (cl-nset-exclusive-or () (list 1 2 3)) + '(1 2 3))) + (should (equal (cl-nset-exclusive-or (list 1 2 3 4 5) (list 3 4 5 6 7)) + '(1 2 6 7)))) + +(ert-deftest cl-subsetp-test () + (should (cl-subsetp '(1 2) '(1 2 3 4))) + (should (cl-subsetp () '(1 2 3 4))) + (should-not (cl-subsetp '(1 2) ())) + (should (cl-subsetp '(1 2 3) '(1 2 3))) + (should (cl-subsetp '(1 1 2) '(1 2 3))) + (should (cl-subsetp '(1 2) '(1 1 2 3 4))) + (should-not (cl-subsetp '(1 "two" 3) '(3 "two" 1))) + (should (cl-subsetp '(1 2) '(2 1) :test #'equal)) + (should (cl-subsetp '((1 . "one") (2 . "two")) + '((1 . "uno") (2 . "dos")) + :key #'car)) + (should (cl-subsetp '(1 2) '(3 4 2 1) :test #'eq)) + (should (cl-subsetp '((1 2) (3)) '((1 2 . "found") (3 . "found")) :key #'car)) + (should (cl-subsetp '(1 2) '(1 2 3 2))) + (should (cl-subsetp () ()))) + +(defun cl--oddp-safe (x) + (and (numberp x) (oddp x))) + +(ert-deftest cl-subst-if-test () + (should (equal (cl-subst-if 'X #'cl--oddp-safe '(1 2 (3 4 5) 6)) + '(X 2 (X 4 X) 6))) + (should (equal (cl-subst-if 'X #'cl--oddp-safe '(1 2 (3 4 5) 6) + :key (lambda (x) (and (numberp x) (1+ x)))) + '(1 X (3 X 5) X)))) + +(ert-deftest cl-subst-if-not-test () + (should (equal (cl-subst-if-not 'X (lambda (x) (or (not (numberp x)) (oddp x))) + '(1 2 (3 4 5) 6)) + '(1 X (3 X 5) X))) + (should (equal (cl-subst-if-not 'X (lambda (x) (or (not (numberp x)) (oddp x))) + '(1 2 (3 4 5) 6) + :key (lambda (x) (and (numberp x) (1+ x)))) + '(X 2 (X 4 X) 6)))) + +(ert-deftest cl-nsubst-test () + (should (equal (let ((tree (list 'a 'b (list 'c 'd 'a) 'e))) + (cl-nsubst 'X 'a tree)) + '(X b (c d X) e))) + (should (equal (let ((tree (list 'a 'b (list 'c 'd 'a) 'e))) + (cl-nsubst 'X 'a tree + :test #'eq)) + '(X b (c d X) e))) + (should (equal (let ((tree (list 'a 'b (list 'c 'd 'a) 'e))) + (cl-nsubst 'X 'a tree + :test-not (lambda (a b) (or (consp b) (eq a b))))) + '(a X (X X a . X) X . X))) + (should (equal (let ((tree (list (cons 1 'a) (cons 2 'b) (cons 3 'a)))) + (cl-nsubst 'X 'a tree + :key #'cdr-safe)) + '(X (2 . b) X)))) + +(ert-deftest cl-nsubst-if-test () + (should (equal (let ((tree (list 1 2 (list 3 4 5) 6))) + (cl-nsubst-if 'X #'cl--oddp-safe tree)) + '(X 2 (X 4 X) 6))) + (should (equal (let ((tree (list 1 2 (list 3 4 5) 6))) + (cl-nsubst-if 'X #'cl--oddp-safe tree + :key (lambda (x) (and (numberp x) (1+ x))))) + '(1 X (3 X 5) X)))) + +(ert-deftest cl-nsubst-if-not-test () + (should (equal (let ((tree (list 1 2 (list 3 4 5) 6))) + (cl-nsubst-if-not 'X + (lambda (x) (or (not (numberp x)) (oddp x))) + tree)) + '(1 X (3 X 5) X))) + (should (equal (let ((tree (list 1 2 (list 3 4 5) 6))) + (cl-nsubst-if-not 'X + (lambda (x) (or (not (numberp x)) (oddp x))) + tree + :key (lambda (x) (and (numberp x) (1+ x))))) + '(X 2 (X 4 X) 6)))) + +(ert-deftest cl-sublis-test () + (should (equal (cl-sublis '((a . x) (b . y)) '(a b (a c))) + '(x y (x c)))) + (should (equal (cl-sublis '((1 . x) (2 . y)) '(1 2 (3 4)) + :key (lambda (x) (and (numberp x) (1- x)))) + '(1 x (y 4)))) + (should (equal (cl-sublis '(("a" . x) ("b" . y)) '("a" "b" ("a" "c")) + :test #'equal) + '(x y (x "c")))) + (should (equal (cl-sublis '(("a" . x) ("b" . y)) '("a" "b" ("a" "c")) + :test-not #'equal) + 'x))) + +(ert-deftest cl-nsublis-test () + (should (equal (let ((tree (list 'a 'b '(a c)))) + (cl-nsublis '((a . x) (b . y)) tree)) + '(x y (x c)))) + (should (equal (let ((tree (list '(1 . a) '(2 . b) '(3 . c)))) + (cl-nsublis '((a . x) (b . y)) tree)) + '((1 . x) (2 . y) (3 . c))))) + +(ert-deftest cl-tree-equal-test () + (should (cl-tree-equal '(1 (2 3) 4) '(1 (2 3) 4))) + (should-not (cl-tree-equal '(1 (2 3) 4) '(1 (2 3) 5))) + (should (cl-tree-equal '(("a" . 1) ("b" . 2)) '(("a" . 1) ("b" . 2)) :test #'equal)) + (should-not (cl-tree-equal '(("a" . 1) ("b" . 2)) '(("a" . 1) ("b" . 3)) :test #'equal)) + (should (cl-tree-equal '(1 2 3) '(1 2 3) :key (lambda (x) (and x (1+ x))))) + (should (cl-tree-equal '(a b c) '(a b c) :key #'symbol-name :test #'equal)) + (should-not (cl-tree-equal '(1 2 3) '(1 2 3) :test-not #'eq)) + (should (cl-tree-equal '(1 2 3) '(1 2 3) :key #'identity :test #'eq))) + (provide 'cl-seq-tests) ;;; cl-seq-tests.el ends here |