diff options
Diffstat (limited to 'test/lisp/subr-tests.el')
| -rw-r--r-- | test/lisp/subr-tests.el | 69 |
1 files changed, 68 insertions, 1 deletions
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index aa16a0da34e..7465aac5ea5 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -26,7 +26,6 @@ ;; ;;; Code: - (require 'ert) (eval-when-compile (require 'cl-lib)) @@ -62,6 +61,18 @@ (quote (0 font-lock-keyword-face)))))))) +(ert-deftest provided-mode-derived-p () + ;; base case: `derived-mode' directly derives `prog-mode' + (should (progn + (define-derived-mode derived-mode prog-mode "test") + (provided-mode-derived-p 'derived-mode 'prog-mode))) + ;; edge case: `derived-mode' derives an alias of `prog-mode' + (should (progn + (defalias 'parent-mode + (if (fboundp 'prog-mode) 'prog-mode 'fundamental-mode)) + (define-derived-mode derived-mode parent-mode "test") + (provided-mode-derived-p 'derived-mode 'prog-mode)))) + (ert-deftest number-sequence-test () (should (= (length (number-sequence (1- most-positive-fixnum) most-positive-fixnum)) @@ -307,6 +318,43 @@ cf. Bug#25477." (should (eq (string-to-char (symbol-name (gensym))) ?g)) (should (eq (string-to-char (symbol-name (gensym "X"))) ?X))) +(ert-deftest subr-tests--proper-list-p () + "Test `proper-list-p' behavior." + (dotimes (length 4) + ;; Proper and dotted lists. + (let ((list (make-list length 0))) + (should (= (proper-list-p list) length)) + (should (not (proper-list-p (nconc list 0))))) + ;; Circular lists. + (dotimes (n (1+ length)) + (let ((circle (make-list (1+ length) 0))) + (should (not (proper-list-p (nconc circle (nthcdr n circle)))))))) + ;; Atoms. + (should (not (proper-list-p 0))) + (should (not (proper-list-p ""))) + (should (not (proper-list-p []))) + (should (not (proper-list-p (make-bool-vector 0 nil)))) + (should (not (proper-list-p (make-symbol "a"))))) + +(ert-deftest subr-tests--assq-delete-all () + "Test `assq-delete-all' behavior." + (cl-flet ((new-list-fn + () + (list (cons 'a 1) (cons 'b 2) (cons 'c 3) 'd (cons "foo" "bar")))) + (should (equal (cdr (new-list-fn)) (assq-delete-all 'a (new-list-fn)))) + (should (equal (new-list-fn) (assq-delete-all 'd (new-list-fn)))) + (should (equal (new-list-fn) (assq-delete-all "foo" (new-list-fn)))))) + +(ert-deftest subr-tests--assoc-delete-all () + "Test `assoc-delete-all' behavior." + (cl-flet ((new-list-fn + () + (list (cons 'a 1) (cons 'b 2) (cons 'c 3) 'd (cons "foo" "bar")))) + (should (equal (cdr (new-list-fn)) (assoc-delete-all 'a (new-list-fn)))) + (should (equal (new-list-fn) (assoc-delete-all 'd (new-list-fn)))) + (should (equal (butlast (new-list-fn)) + (assoc-delete-all "foo" (new-list-fn)))))) + (ert-deftest shell-quote-argument-%-on-w32 () "Quoting of `%' in w32 shells isn't perfect. See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=19350." @@ -324,5 +372,24 @@ See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=19350." (shell-quote-argument "%ca%"))) "without-caret %ca%")))) +(ert-deftest subr-tests-flatten-tree () + "Test `flatten-tree' behavior." + (should (equal (flatten-tree '(1 (2 . 3) nil (4 5 (6)) 7)) + '(1 2 3 4 5 6 7))) + (should (equal (flatten-tree '((1 . 2))) + '(1 2))) + (should (equal (flatten-tree '(1 nil 2)) + '(1 2))) + (should (equal (flatten-tree 42) + '(42))) + (should (equal (flatten-tree t) + '(t))) + (should (equal (flatten-tree nil) + nil)) + (should (equal (flatten-tree '((nil) ((((nil)))) nil)) + nil)) + (should (equal (flatten-tree '(1 ("foo" "bar") 2)) + '(1 "foo" "bar" 2)))) + (provide 'subr-tests) ;;; subr-tests.el ends here |