diff options
Diffstat (limited to 'test/lisp/subr-tests.el')
| -rw-r--r-- | test/lisp/subr-tests.el | 323 |
1 files changed, 317 insertions, 6 deletions
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index b57982a7055..238c9be1ab0 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -62,19 +62,259 @@ (0 font-lock-keyword-face)))))))) +;;;; List functions. + +(ert-deftest subr-test-caaar () + (should (null (caaar '()))) + (should (null (caaar '(() (2))))) + (should (null (caaar '((() (2)) (a b))))) + (should-error (caaar '(1 2)) :type 'wrong-type-argument) + (should-error (caaar '((1 2))) :type 'wrong-type-argument) + (should (= 1 (caaar '(((1 2) (3 4)))))) + (should (null (caaar '((() (3 4))))))) + +(ert-deftest subr-test-caadr () + (should (null (caadr '()))) + (should (null (caadr '(1)))) + (should-error (caadr '(1 2)) :type 'wrong-type-argument) + (should (= 2 (caadr '(1 (2 3))))) + (should (equal '((2) (3)) (caadr '((1) (((2) (3))) (4)))))) + + ;;;; Keymap support. (ert-deftest subr-test-kbd () + (should (equal (kbd "") "")) (should (equal (kbd "f") "f")) + (should (equal (kbd "X") "X")) + (should (equal (kbd "foobar") "foobar")) ; 6 characters + (should (equal (kbd "return") "return")) ; 6 characters + + (should (equal (kbd "<F2>") [F2])) + (should (equal (kbd "<f1> <f2> TAB") [f1 f2 ?\t])) + (should (equal (kbd "<f1> RET") [f1 ?\r])) + (should (equal (kbd "<f1> SPC") [f1 ? ])) (should (equal (kbd "<f1>") [f1])) - (should (equal (kbd "RET") "\C-m")) + (should (equal (kbd "<f1>") [f1])) + (should (equal (kbd "[f1]") "[f1]")) + (should (equal (kbd "<return>") [return])) + (should (equal (kbd "< right >") "<right>")) ; 7 characters + + ;; Modifiers: + (should (equal (kbd "C-x") "\C-x")) (should (equal (kbd "C-x a") "\C-xa")) - ;; Check that kbd handles both new and old style key descriptions - ;; (bug#45536). + (should (equal (kbd "C-;") [?\C-\;])) + (should (equal (kbd "C-a") "\C-a")) + (should (equal (kbd "C-c SPC") "\C-c ")) + (should (equal (kbd "C-c TAB") "\C-c\t")) + (should (equal (kbd "C-c c") "\C-cc")) + (should (equal (kbd "C-x 4 C-f") "\C-x4\C-f")) + (should (equal (kbd "C-x C-f") "\C-x\C-f")) + (should (equal (kbd "C-M-<down>") [C-M-down])) + (should (equal (kbd "<C-M-down>") [C-M-down])) + (should (equal (kbd "C-RET") [?\C-\C-m])) + (should (equal (kbd "C-SPC") [?\C- ])) + (should (equal (kbd "C-TAB") [?\C-\t])) + (should (equal (kbd "C-<down>") [C-down])) + (should (equal (kbd "C-c C-c C-c") "\C-c\C-c\C-c")) + + (should (equal (kbd "M-a") [?\M-a])) + (should (equal (kbd "M-<DEL>") [?\M-\d])) + (should (equal (kbd "M-C-a") [?\M-\C-a])) + (should (equal (kbd "M-ESC") [?\M-\e])) + (should (equal (kbd "M-RET") [?\M-\r])) + (should (equal (kbd "M-SPC") [?\M- ])) + (should (equal (kbd "M-TAB") [?\M-\t])) + (should (equal (kbd "M-x a") [?\M-x ?a])) + (should (equal (kbd "M-<up>") [M-up])) + (should (equal (kbd "M-c M-c M-c") [?\M-c ?\M-c ?\M-c])) + + (should (equal (kbd "s-SPC") [?\s- ])) + (should (equal (kbd "s-a") [?\s-a])) + (should (equal (kbd "s-x a") [?\s-x ?a])) + (should (equal (kbd "s-c s-c s-c") [?\s-c ?\s-c ?\s-c])) + + (should (equal (kbd "S-H-a") [?\S-\H-a])) + (should (equal (kbd "S-a") [?\S-a])) + (should (equal (kbd "S-x a") [?\S-x ?a])) + (should (equal (kbd "S-c S-c S-c") [?\S-c ?\S-c ?\S-c])) + + (should (equal (kbd "H-<RET>") [?\H-\r])) + (should (equal (kbd "H-DEL") [?\H-\d])) + (should (equal (kbd "H-a") [?\H-a])) + (should (equal (kbd "H-x a") [?\H-x ?a])) + (should (equal (kbd "H-c H-c H-c") [?\H-c ?\H-c ?\H-c])) + + (should (equal (kbd "A-H-a") [?\A-\H-a])) + (should (equal (kbd "A-SPC") [?\A- ])) + (should (equal (kbd "A-TAB") [?\A-\t])) + (should (equal (kbd "A-a") [?\A-a])) + (should (equal (kbd "A-c A-c A-c") [?\A-c ?\A-c ?\A-c])) + + (should (equal (kbd "C-M-a") [?\C-\M-a])) + (should (equal (kbd "C-M-<up>") [C-M-up])) + + ;; Special characters. + (should (equal (kbd "DEL") "\d")) + (should (equal (kbd "ESC C-a") "\e\C-a")) + (should (equal (kbd "ESC") "\e")) + (should (equal (kbd "LFD") "\n")) + (should (equal (kbd "NUL") "\0")) + (should (equal (kbd "RET") "\C-m")) + (should (equal (kbd "SPC") "\s")) + (should (equal (kbd "TAB") "\t")) + (should (equal (kbd "\^i") "")) + (should (equal (kbd "^M") "\^M")) + + ;; With numbers. + (should (equal (kbd "\177") "\^?")) + (should (equal (kbd "\000") "\0")) + (should (equal (kbd "\\177") "\^?")) + (should (equal (kbd "\\000") "\0")) + (should (equal (kbd "C-x \\150") "\C-xh")) + + ;; Multibyte + (should (equal (kbd "ñ") [?ñ])) + (should (equal (kbd "ü") [?ü])) + (should (equal (kbd "ö") [?ö])) + (should (equal (kbd "ğ") [?ğ])) + (should (equal (kbd "ա") [?ա])) + (should (equal (kbd "üüöö") [?ü ?ü ?ö ?ö])) + (should (equal (kbd "C-ü") [?\C-ü])) + (should (equal (kbd "M-ü") [?\M-ü])) + (should (equal (kbd "H-ü") [?\H-ü])) + + ;; Handle both new and old style key descriptions (bug#45536). (should (equal (kbd "s-<return>") [s-return])) (should (equal (kbd "<s-return>") [s-return])) (should (equal (kbd "C-M-<return>") [C-M-return])) - (should (equal (kbd "<C-M-return>") [C-M-return]))) + (should (equal (kbd "<C-M-return>") [C-M-return])) + + ;; Error. + (should-error (kbd "C-xx")) + (should-error (kbd "M-xx")) + (should-error (kbd "M-x<TAB>")) + + ;; These should be equivalent: + (should (equal (kbd "\C-xf") (kbd "C-x f")))) + +(ert-deftest subr-test-kbd-valid-p () + (should (not (kbd-valid-p ""))) + (should (kbd-valid-p "f")) + (should (kbd-valid-p "X")) + (should (not (kbd-valid-p " X"))) + (should (kbd-valid-p "X f")) + (should (not (kbd-valid-p "a b"))) + (should (not (kbd-valid-p "foobar"))) + (should (not (kbd-valid-p "return"))) + + (should (kbd-valid-p "<F2>")) + (should (kbd-valid-p "<f1> <f2> TAB")) + (should (kbd-valid-p "<f1> RET")) + (should (kbd-valid-p "<f1> SPC")) + (should (kbd-valid-p "<f1>")) + (should (not (kbd-valid-p "[f1]"))) + (should (kbd-valid-p "<return>")) + (should (not (kbd-valid-p "< right >"))) + + ;; Modifiers: + (should (kbd-valid-p "C-x")) + (should (kbd-valid-p "C-x a")) + (should (kbd-valid-p "C-;")) + (should (kbd-valid-p "C-a")) + (should (kbd-valid-p "C-c SPC")) + (should (kbd-valid-p "C-c TAB")) + (should (kbd-valid-p "C-c c")) + (should (kbd-valid-p "C-x 4 C-f")) + (should (kbd-valid-p "C-x C-f")) + (should (kbd-valid-p "C-M-<down>")) + (should (not (kbd-valid-p "<C-M-down>"))) + (should (kbd-valid-p "C-RET")) + (should (kbd-valid-p "C-SPC")) + (should (kbd-valid-p "C-TAB")) + (should (kbd-valid-p "C-<down>")) + (should (kbd-valid-p "C-c C-c C-c")) + + (should (kbd-valid-p "M-a")) + (should (kbd-valid-p "M-<DEL>")) + (should (not (kbd-valid-p "M-C-a"))) + (should (kbd-valid-p "C-M-a")) + (should (kbd-valid-p "M-ESC")) + (should (kbd-valid-p "M-RET")) + (should (kbd-valid-p "M-SPC")) + (should (kbd-valid-p "M-TAB")) + (should (kbd-valid-p "M-x a")) + (should (kbd-valid-p "M-<up>")) + (should (kbd-valid-p "M-c M-c M-c")) + + (should (kbd-valid-p "s-SPC")) + (should (kbd-valid-p "s-a")) + (should (kbd-valid-p "s-x a")) + (should (kbd-valid-p "s-c s-c s-c")) + + (should (not (kbd-valid-p "S-H-a"))) + (should (kbd-valid-p "S-a")) + (should (kbd-valid-p "S-x a")) + (should (kbd-valid-p "S-c S-c S-c")) + + (should (kbd-valid-p "H-<RET>")) + (should (kbd-valid-p "H-DEL")) + (should (kbd-valid-p "H-a")) + (should (kbd-valid-p "H-x a")) + (should (kbd-valid-p "H-c H-c H-c")) + + (should (kbd-valid-p "A-H-a")) + (should (kbd-valid-p "A-SPC")) + (should (kbd-valid-p "A-TAB")) + (should (kbd-valid-p "A-a")) + (should (kbd-valid-p "A-c A-c A-c")) + + (should (kbd-valid-p "C-M-a")) + (should (kbd-valid-p "C-M-<up>")) + + ;; Special characters. + (should (kbd-valid-p "DEL")) + (should (kbd-valid-p "ESC C-a")) + (should (kbd-valid-p "ESC")) + (should (kbd-valid-p "LFD")) + (should (kbd-valid-p "NUL")) + (should (kbd-valid-p "RET")) + (should (kbd-valid-p "SPC")) + (should (kbd-valid-p "TAB")) + (should (not (kbd-valid-p "\^i"))) + (should (not (kbd-valid-p "^M"))) + + ;; With numbers. + (should (not (kbd-valid-p "\177"))) + (should (not (kbd-valid-p "\000"))) + (should (not (kbd-valid-p "\\177"))) + (should (not (kbd-valid-p "\\000"))) + (should (not (kbd-valid-p "C-x \\150"))) + + ;; Multibyte + (should (kbd-valid-p "ñ")) + (should (kbd-valid-p "ü")) + (should (kbd-valid-p "ö")) + (should (kbd-valid-p "ğ")) + (should (kbd-valid-p "ա")) + (should (not (kbd-valid-p "üüöö"))) + (should (kbd-valid-p "C-ü")) + (should (kbd-valid-p "M-ü")) + (should (kbd-valid-p "H-ü")) + + ;; Handle both new and old style key descriptions (bug#45536). + (should (kbd-valid-p "s-<return>")) + (should (not (kbd-valid-p "<s-return>"))) + (should (kbd-valid-p "C-M-<return>")) + (should (not (kbd-valid-p "<C-M-return>"))) + + (should (kbd-valid-p "<mouse-1>")) + (should (kbd-valid-p "<Scroll_Lock>")) + + (should (not (kbd-valid-p "c-x"))) + (should (not (kbd-valid-p "C-xx"))) + (should (not (kbd-valid-p "M-xx"))) + (should (not (kbd-valid-p "M-x<TAB>")))) (ert-deftest subr-test-define-prefix-command () (define-prefix-command 'foo-prefix-map) @@ -473,11 +713,11 @@ See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=19350." (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. + ;; 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 sure `nil' is equivalent to 0. + ;; Make sure 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))) @@ -694,5 +934,76 @@ See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=19350." (should-not (buffer-local-boundp 'test-not-boundp buf)) (should (buffer-local-boundp 'test-global-boundp buf)))) +(ert-deftest test-replace-string-in-region () + (with-temp-buffer + (insert "foo bar zot foobar") + (should (= (replace-string-in-region "foo" "new" (point-min) (point-max)) + 2)) + (should (equal (buffer-string) "new bar zot newbar"))) + + (with-temp-buffer + (insert "foo bar zot foobar") + (should (= (replace-string-in-region "foo" "new" (point-min) 14) + 1)) + (should (equal (buffer-string) "new bar zot foobar"))) + + (with-temp-buffer + (insert "foo bar zot foobar") + (should-error (replace-string-in-region "foo" "new" (point-min) 30))) + + (with-temp-buffer + (insert "Foo bar zot foobar") + (should (= (replace-string-in-region "Foo" "new" (point-min)) + 1)) + (should (equal (buffer-string) "new bar zot foobar")))) + +(ert-deftest test-replace-regexp-in-region () + (with-temp-buffer + (insert "foo bar zot foobar") + (should (= (replace-regexp-in-region "fo+" "new" (point-min) (point-max)) + 2)) + (should (equal (buffer-string) "new bar zot newbar"))) + + (with-temp-buffer + (insert "foo bar zot foobar") + (should (= (replace-regexp-in-region "fo+" "new" (point-min) 14) + 1)) + (should (equal (buffer-string) "new bar zot foobar"))) + + (with-temp-buffer + (insert "foo bar zot foobar") + (should-error (replace-regexp-in-region "fo+" "new" (point-min) 30))) + + (with-temp-buffer + (insert "Foo bar zot foobar") + (should (= (replace-regexp-in-region "Fo+" "new" (point-min)) + 1)) + (should (equal (buffer-string) "new bar zot foobar")))) + +(ert-deftest test-with-existing-directory () + (let ((dir (make-temp-name "/tmp/not-exist-"))) + (let ((default-directory dir)) + (should-not (file-exists-p default-directory))) + (with-existing-directory + (should-not (equal dir default-directory)) + (should (file-exists-p default-directory))))) + +(ert-deftest subr-test-internal--format-docstring-line () + (should + (string= (let ((fill-column 70)) + (internal--format-docstring-line + "In addition to any hooks its parent mode might have run, this \ +mode runs the hook ‘foo-bar-baz-very-long-name-indeed-mode-hook’, as the final \ +or penultimate step during initialization.")) + "In addition to any hooks its parent mode might have run, this mode +runs the hook ‘foo-bar-baz-very-long-name-indeed-mode-hook’, as the +final or penultimate step during initialization.")) + (should-error (internal--format-docstring-line "foo\nbar"))) + +(ert-deftest test-ensure-list () + (should (equal (ensure-list nil) nil)) + (should (equal (ensure-list :foo) '(:foo))) + (should (equal (ensure-list '(1 2 3)) '(1 2 3)))) + (provide 'subr-tests) ;;; subr-tests.el ends here |