mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-12-24 10:38:38 +00:00
bc511a64f6
Most of this change is to boilerplate commentary such as license URLs. This change was prompted by ftp://ftp.gnu.org's going-away party, planned for November. Change these FTP URLs to https://ftp.gnu.org instead. Make similar changes for URLs to other organizations moving away from FTP. Also, change HTTP to HTTPS for URLs to gnu.org and fsf.org when this works, as this will further help defend against man-in-the-middle attacks (for this part I omitted the MS-DOS and MS-Windows sources and the test tarballs to keep the workload down). HTTPS is not fully working to lists.gnu.org so I left those URLs alone for now.
308 lines
17 KiB
EmacsLisp
308 lines
17 KiB
EmacsLisp
;;; cl-seq-tests.el --- Tests for cl-seq.el functionality -*- lexical-binding: t; -*-
|
|
|
|
;; Copyright (C) 2015-2017 Free Software Foundation, Inc.
|
|
|
|
;; Author: Nicolas Richard <youngfrog@members.fsf.org>
|
|
|
|
;; This file is part of GNU Emacs.
|
|
|
|
;; GNU Emacs is free software: you can redistribute it and/or modify
|
|
;; it under the terms of the GNU General Public License as published by
|
|
;; the Free Software Foundation, either version 3 of the License, or
|
|
;; (at your option) any later version.
|
|
|
|
;; GNU Emacs is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; GNU General Public License for more details.
|
|
|
|
;; 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)
|
|
|
|
(ert-deftest cl-union-test-00 ()
|
|
"Test for https://debbugs.gnu.org/22729 ."
|
|
(let ((str1 "foo")
|
|
(str2 (make-string 3 ?o)))
|
|
;; Emacs may make two string literals eql when reading.
|
|
(aset str2 0 ?f)
|
|
(should (not (eql str1 str2)))
|
|
(should (equal str1 str2))
|
|
(should (equal (cl-union (list str1) (list str2))
|
|
(list str2)))
|
|
(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))))))
|
|
|
|
;; 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)))))
|
|
|
|
;; 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)))))
|
|
|
|
;; 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 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 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)))))
|
|
|
|
;; 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)))))
|
|
|
|
;; keywords supported: :test :test-not :key :start :end :from-end
|
|
(ert-deftest cl-seq-remove-duplicates-test ()
|
|
(let ((list '(1 2 3 4 5 2 6)))
|
|
(should (equal '(1 3 4 5 2 6) (cl-remove-duplicates list)))
|
|
(should (equal '(1 2 3 4 5 6) (cl-remove-duplicates list :from-end t)))
|
|
(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 (cl-remove-duplicates list)
|
|
(cl-remove-duplicates list :key #'number-to-string :test #'string=)))
|
|
(should (equal list
|
|
(cl-remove-duplicates list :key #'number-to-string :test #'eq)))))
|
|
|
|
;; keywords supported: :test :test-not :key :count :start :end :from-end
|
|
(ert-deftest cl-seq-substitute-test ()
|
|
(let ((list '(1 2 3 4 5 2 6)))
|
|
(should (equal '(1 b 3 4 5 b 6) (cl-substitute '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-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
|
|
: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 '(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)))))))
|
|
|
|
|
|
;; 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)))))
|
|
|
|
;; 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)))
|
|
(should-not (cl-position 'foo list))
|
|
(should (= 1 (cl-position 2 list)))
|
|
(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 (= 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-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)))))
|
|
|
|
;; keywords supported: :test :test-not :key :start :end
|
|
(ert-deftest cl-seq-count-test ()
|
|
(let ((list '(1 2 3 4 5 2 6)))
|
|
(should (= 2 (cl-count 2 list)))
|
|
(should (= 1 (cl-count 2 list :start 2)))
|
|
(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)))))))
|
|
|
|
;; 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))
|
|
(list2 '(1 999 2 3 4 5 2 6)))
|
|
(should-not (cl-mismatch list list))
|
|
(should-not (cl-mismatch list (remove 999 list2)))
|
|
(should (= 0 (cl-mismatch list list :key #'number-to-string)))
|
|
(should-not (cl-mismatch list list :key #'number-to-string :test #'string=))
|
|
(should (= 1 (cl-mismatch list list2)))
|
|
(should (= 0 (cl-mismatch list list2 :from-end t)))
|
|
(should (= 3 (cl-mismatch '(1 2 3) list)))
|
|
(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
|
|
:test (lambda (a b)
|
|
(and (stringp a) (stringp b))) :from-end t)))
|
|
(should (= 7 (cl-mismatch list list2 :key #'number-to-string
|
|
:test (lambda (a b)
|
|
(and (stringp a) (stringp b))))))))
|
|
|
|
;; keywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end
|
|
(ert-deftest cl-seq-search-test ()
|
|
(let ((list '(1 2 3 4 5 2 6))
|
|
(list2 '(1 999 2 3 4 5 2 6)))
|
|
(should-not (cl-search list list2))
|
|
(should (= 2 (cl-search list list2 :start1 1 :start2 2)))
|
|
(should (= 4 (cl-search list list2 :start1 3)))
|
|
(should (= 6 (cl-search list list2 :start1 5)))
|
|
(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 :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 ."
|
|
(let ((list (append (make-list 8000005 1) '(8)))
|
|
(list2 (make-list 8000005 2)))
|
|
(should (cl-position 8 list))
|
|
(should-not (equal '(8) (last (cl-remove 8 list))))
|
|
(should (equal '(2 8) (last (cl-substitute 2 1 list) 2)))
|
|
(should (equal '(2 8) (last (cl-replace list list2) 2)))
|
|
(should (equal '(1 1) (last (cl-fill list 1) 2)))))
|
|
|
|
|
|
(provide 'cl-seq-tests)
|
|
;;; cl-seq-tests.el ends here
|