summaryrefslogtreecommitdiff
path: root/test/lisp/subr-tests.el
diff options
context:
space:
mode:
Diffstat (limited to 'test/lisp/subr-tests.el')
-rw-r--r--test/lisp/subr-tests.el78
1 files changed, 77 insertions, 1 deletions
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index aa16a0da34e..06db8f5c902 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,19 @@
(quote
(0 font-lock-keyword-face))))))))
+(defalias 'subr-tests--parent-mode
+ (if (fboundp 'prog-mode) 'prog-mode 'fundamental-mode))
+
+(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
+ (define-derived-mode derived-mode subr-tests--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 +319,25 @@ 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--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 +355,50 @@ 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))))
+
+(defvar subr-tests--hook nil)
+
+(ert-deftest subr-tests-add-hook-depth ()
+ "Test the `depth' arg of `add-hook'."
+ (setq-default subr-tests--hook nil)
+ (add-hook 'subr-tests--hook 'f1)
+ (add-hook 'subr-tests--hook 'f2)
+ (should (equal subr-tests--hook '(f2 f1)))
+ (add-hook 'subr-tests--hook 'f3 t)
+ (should (equal subr-tests--hook '(f2 f1 f3)))
+ (add-hook 'subr-tests--hook 'f4 50)
+ (should (equal subr-tests--hook '(f2 f1 f4 f3)))
+ (add-hook 'subr-tests--hook 'f5 -50)
+ (should (equal subr-tests--hook '(f5 f2 f1 f4 f3)))
+ (add-hook 'subr-tests--hook 'f6)
+ (should (equal subr-tests--hook '(f5 f6 f2 f1 f4 f3)))
+ ;; Make sure `t' is equivalent to 90.
+ (add-hook 'subr-tests--hook 'f7 90)
+ (add-hook 'subr-tests--hook 'f8 t)
+ (should (equal subr-tests--hook '(f5 f6 f2 f1 f4 f3 f7 f8)))
+ ;; Make sue `nil' is equivalent to 0.
+ (add-hook 'subr-tests--hook 'f9 0)
+ (add-hook 'subr-tests--hook 'f10)
+ (should (equal subr-tests--hook '(f5 f10 f9 f6 f2 f1 f4 f3 f7 f8)))
+ )
+
(provide 'subr-tests)
;;; subr-tests.el ends here