diff options
Diffstat (limited to 'test/lisp')
| -rw-r--r-- | test/lisp/char-fold-tests.el | 6 | ||||
| -rw-r--r-- | test/lisp/dired-aux-tests.el | 56 | ||||
| -rw-r--r-- | test/lisp/electric-tests.el | 41 | ||||
| -rw-r--r-- | test/lisp/emacs-lisp/testcover-resources/testcases.el | 44 | ||||
| -rw-r--r-- | test/lisp/emacs-lisp/testcover-tests.el | 12 | ||||
| -rw-r--r-- | test/lisp/help-fns-tests.el | 5 | ||||
| -rw-r--r-- | test/lisp/xdg-tests.el | 12 |
7 files changed, 144 insertions, 32 deletions
diff --git a/test/lisp/char-fold-tests.el b/test/lisp/char-fold-tests.el index 83d6fa79b1e..a16f2879809 100644 --- a/test/lisp/char-fold-tests.el +++ b/test/lisp/char-fold-tests.el @@ -117,16 +117,14 @@ (char-fold-to-regexp string))) (with-temp-buffer (save-excursion (insert string)) - (let ((time (time-to-seconds (current-time)))) + (let ((time (time-to-seconds))) ;; Our initial implementation of case-folding in char-folding ;; created a lot of redundant paths in the regexp. Because of ;; that, if a really long string "almost" matches, the regexp ;; engine took a long time to realize that it doesn't match. (should-not (char-fold-search-forward (concat string "c") nil 'noerror)) ;; Ensure it took less than a second. - (should (< (- (time-to-seconds (current-time)) - time) - 1)))))) + (should (< (- (time-to-seconds) time) 1)))))) (provide 'char-fold-tests) ;;; char-fold-tests.el ends here diff --git a/test/lisp/dired-aux-tests.el b/test/lisp/dired-aux-tests.el index d41feb1592f..9316217dd2a 100644 --- a/test/lisp/dired-aux-tests.el +++ b/test/lisp/dired-aux-tests.el @@ -20,7 +20,7 @@ ;;; Code: (require 'ert) (require 'dired-aux) - +(eval-when-compile (require 'cl-lib)) (ert-deftest dired-test-bug27496 () "Test for https://debbugs.gnu.org/27496 ." @@ -40,5 +40,59 @@ (should-not (dired-do-shell-command "ls ? ./`?`" nil files))) (delete-file foo)))) +;; Auxiliar macro for `dired-test-bug28834': it binds +;; `dired-create-destination-dirs' to CREATE-DIRS and execute BODY. +;; If YES-OR-NO is non-nil, it binds `yes-or-no-p' to +;; to avoid the prompt. +(defmacro with-dired-bug28834-test (create-dirs yes-or-no &rest body) + (declare ((debug form symbolp body))) + (let ((foo (make-symbol "foo"))) + `(let* ((,foo (make-temp-file "foo" 'dir)) + (dired-create-destination-dirs ,create-dirs)) + (setq from (make-temp-file "from")) + (setq to-cp + (expand-file-name + "foo-cp" (file-name-as-directory (expand-file-name "bar" ,foo)))) + (setq to-mv + (expand-file-name + "foo-mv" (file-name-as-directory (expand-file-name "qux" ,foo)))) + (unwind-protect + (if ,yes-or-no + (cl-letf (((symbol-function 'yes-or-no-p) + (lambda (prompt) (eq ,yes-or-no 'yes)))) + ,@body) + ,@body) + ;; clean up + (delete-directory ,foo 'recursive) + (delete-file from))))) + +(ert-deftest dired-test-bug28834 () + "test for https://debbugs.gnu.org/28834 ." + (let (from to-cp to-mv) + ;; `dired-create-destination-dirs' set to 'always. + (with-dired-bug28834-test + 'always nil + (dired-copy-file-recursive from to-cp nil) + (should (file-exists-p to-cp)) + (dired-rename-file from to-mv nil) + (should (file-exists-p to-mv))) + ;; `dired-create-destination-dirs' set to nil. + (with-dired-bug28834-test + nil nil + (should-error (dired-copy-file-recursive from to-cp nil)) + (should-error (dired-rename-file from to-mv nil))) + ;; `dired-create-destination-dirs' set to 'ask. + (with-dired-bug28834-test + 'ask 'yes ; Answer `yes' + (dired-copy-file-recursive from to-cp nil) + (should (file-exists-p to-cp)) + (dired-rename-file from to-mv nil) + (should (file-exists-p to-mv))) + (with-dired-bug28834-test + 'ask 'no ; Answer `no' + (should-error (dired-copy-file-recursive from to-cp nil)) + (should-error (dired-rename-file from to-mv nil))))) + + (provide 'dired-aux-tests) ;; dired-aux-tests.el ends here diff --git a/test/lisp/electric-tests.el b/test/lisp/electric-tests.el index fc69919fbe1..7df2449b9eb 100644 --- a/test/lisp/electric-tests.el +++ b/test/lisp/electric-tests.el @@ -617,6 +617,12 @@ baz\"\"" :fixture-fn #'electric-quote-local-mode :test-in-comments nil :test-in-strings nil) +(define-electric-pair-test electric-quote-replace-double-disabled + "" "\"" :expected-string "\"" :expected-point 2 + :modes '(text-mode) + :fixture-fn #'electric-quote-local-mode + :test-in-comments nil :test-in-strings nil) + (define-electric-pair-test electric-quote-context-sensitive-backtick "" "`" :expected-string "`" :expected-point 2 :modes '(text-mode) @@ -638,6 +644,13 @@ baz\"\"" :bindings '((electric-quote-context-sensitive . t)) :test-in-comments nil :test-in-strings nil) +(define-electric-pair-test electric-quote-replace-double-bob + "" "\"" :expected-string "“" :expected-point 2 + :modes '(text-mode) + :fixture-fn #'electric-quote-local-mode + :bindings '((electric-quote-replace-double . t)) + :test-in-comments nil :test-in-strings nil) + (define-electric-pair-test electric-quote-context-sensitive-bol-single "a\n" "--'" :expected-string "a\n‘" :expected-point 4 :modes '(text-mode) @@ -652,6 +665,13 @@ baz\"\"" :bindings '((electric-quote-context-sensitive . t)) :test-in-comments nil :test-in-strings nil) +(define-electric-pair-test electric-quote-replace-double-bol + "a\n" "--\"" :expected-string "a\n“" :expected-point 4 + :modes '(text-mode) + :fixture-fn #'electric-quote-local-mode + :bindings '((electric-quote-replace-double . t)) + :test-in-comments nil :test-in-strings nil) + (define-electric-pair-test electric-quote-context-sensitive-after-space-single " " "-'" :expected-string " ‘" :expected-point 3 :modes '(text-mode) @@ -666,6 +686,13 @@ baz\"\"" :bindings '((electric-quote-context-sensitive . t)) :test-in-comments nil :test-in-strings nil) +(define-electric-pair-test electric-quote-replace-double-after-space + " " "-\"" :expected-string " “" :expected-point 3 + :modes '(text-mode) + :fixture-fn #'electric-quote-local-mode + :bindings '((electric-quote-replace-double . t)) + :test-in-comments nil :test-in-strings nil) + (define-electric-pair-test electric-quote-context-sensitive-after-letter-single "a" "-'" :expected-string "a’" :expected-point 3 :modes '(text-mode) @@ -680,6 +707,13 @@ baz\"\"" :bindings '((electric-quote-context-sensitive . t)) :test-in-comments nil :test-in-strings nil) +(define-electric-pair-test electric-quote-replace-double-after-letter + "a" "-\"" :expected-string "a”" :expected-point 3 + :modes '(text-mode) + :fixture-fn #'electric-quote-local-mode + :bindings '((electric-quote-replace-double . t)) + :test-in-comments nil :test-in-strings nil) + (define-electric-pair-test electric-quote-context-sensitive-after-paren-single "(" "-'" :expected-string "(‘" :expected-point 3 :modes '(text-mode) @@ -694,6 +728,13 @@ baz\"\"" :bindings '((electric-quote-context-sensitive . t)) :test-in-comments nil :test-in-strings nil) +(define-electric-pair-test electric-quote-replace-double-after-paren + "(" "-\"" :expected-string "(“" :expected-point 3 + :modes '(text-mode) + :fixture-fn #'electric-quote-local-mode + :bindings '((electric-quote-replace-double . t)) + :test-in-comments nil :test-in-strings nil) + ;; Simulate ‘markdown-mode’: it sets both ‘comment-start’ and ;; ‘comment-use-syntax’, but derives from ‘text-mode’. (define-electric-pair-test electric-quote-markdown-in-text diff --git a/test/lisp/emacs-lisp/testcover-resources/testcases.el b/test/lisp/emacs-lisp/testcover-resources/testcases.el index edb539f4c27..6a9612db05a 100644 --- a/test/lisp/emacs-lisp/testcover-resources/testcases.el +++ b/test/lisp/emacs-lisp/testcover-resources/testcases.el @@ -53,7 +53,6 @@ ;; ==== constants-bug-25316 ==== "Testcover doesn't splotch constants." -:expected-result :failed ;; ==== (defconst testcover-testcase-const "apples") (defun testcover-testcase-zero () 0) @@ -76,7 +75,6 @@ ;; ==== customize-defcustom-bug-25326 ==== "Testcover doesn't prevent testing of defcustom values." -:expected-result :failed ;; ==== (defgroup testcover-testcase nil "Test case for testcover" @@ -135,7 +133,6 @@ ;; ==== 1-value-symbol-bug-25316 ==== "Wrapping a form with 1value prevents splotching." -:expected-result :failed ;; ==== (defun testcover-testcase-always-zero (num) (- num%%% num%%%)%%%) @@ -230,7 +227,6 @@ ;; ==== quotes-within-backquotes-bug-25316 ==== "Forms to instrument are found within quotes within backquotes." -:expected-result :failed ;; ==== (defun testcover-testcase-make-list () (list 'defun 'defvar)) @@ -296,7 +292,6 @@ ;; ==== backquote-1value-bug-24509 ==== "Commas within backquotes are recognized as non-1value." -:expected-result :failed ;; ==== (defmacro testcover-testcase-lambda (&rest body) `(lambda () ,@body)) @@ -320,7 +315,6 @@ ;; ==== pcase-bug-24688 ==== "Testcover copes with condition-case within backquoted list." -:expected-result :failed ;; ==== (defun testcover-testcase-pcase (form) (pcase form%%% @@ -335,7 +329,6 @@ ;; ==== defun-in-backquote-bug-11307-and-24743 ==== "Testcover handles defun forms within backquoted list." -:expected-result :failed ;; ==== (defmacro testcover-testcase-defun (name &rest body) (declare (debug (symbolp def-body))) @@ -348,7 +341,6 @@ ;; ==== closure-1value-bug ==== "Testcover does not mark closures as 1value." -:expected-result :failed ;; ==== ;; -*- lexical-binding:t -*- (setq testcover-testcase-foo nil) @@ -365,7 +357,6 @@ ;; ==== by-value-vs-by-reference-bug-25351 ==== "An object created by a 1value expression may be modified by other code." -:expected-result :failed ;; ==== (defun testcover-testcase-ab () (list 'a 'b)) @@ -396,9 +387,16 @@ (should (equal '(a b c) (testcover-testcase-dotted-bq nil '(d e)))) (should (equal '(a b c d e) (testcover-testcase-dotted-bq t '(d e)))) +;; ==== quoted-backquote ==== +"Testcover correctly instruments the quoted backquote symbol." +;; ==== +(defun testcover-testcase-special-symbols () + (list '\` '\, '\,@)) + +(should (equal '(\` \, \,@) (testcover-testcase-special-symbols))) + ;; ==== backquoted-vector-bug-25316 ==== "Testcover reinstruments within backquoted vectors." -:expected-result :failed ;; ==== (defun testcover-testcase-vec (a b c) `[,a%%% ,(list b%%% c%%%)%%%]%%%) @@ -415,7 +413,6 @@ ;; ==== vector-in-macro-spec-bug-25316 ==== "Testcover reinstruments within vectors." -:expected-result :failed ;; ==== (defmacro testcover-testcase-nth-case (arg vec) (declare (indent 1) @@ -435,7 +432,6 @@ ;; ==== mapcar-is-not-compose ==== "Mapcar with 1value arguments is not 1value." -:expected-result :failed ;; ==== (defvar testcover-testcase-num 0) (defun testcover-testcase-add-num (n) @@ -450,10 +446,10 @@ ;; ==== function-with-edebug-spec-bug-25316 ==== "Functions can have edebug specs too. -See c-make-font-lock-search-function for an example in the Emacs -sources. The other issue is that it's ok to use quote in an -edebug spec, so testcover needs to cope with that." -:expected-result :failed +See `c-make-font-lock-search-function' for an example in the +Emacs sources. `c-make-font-lock-search-function''s Edebug spec +also contains a quote. See comment in `testcover-analyze-coverage' +regarding the odd-looking coverage result for the quoted form." ;; ==== (defun testcover-testcase-make-function (forms) `(lambda (flag) (if flag 0 ,@forms%%%))%%%) @@ -462,7 +458,7 @@ edebug spec, so testcover needs to cope with that." (("quote" (&rest def-form)))) (defun testcover-testcase-thing () - (testcover-testcase-make-function '((+ 1 (+ 2 (+ 3 (+ 4 5))))))%%%) + (testcover-testcase-make-function '(!!!(+ 1 !!!(+ 2 !!!(+ 3 !!!(+ 4 5)%%%)%%%)%%%)%%%))%%%) (defun testcover-testcase-use-thing () (funcall (testcover-testcase-thing)%%% nil)%%%) @@ -494,10 +490,18 @@ edebug spec, so testcover needs to cope with that." "Testcover captures and ignores circular list errors." ;; ==== (defun testcover-testcase-cyc1 (a) - (let ((ls (make-list 10 a%%%))) - (nconc ls ls) - ls)) + (let ((ls (make-list 10 a%%%)%%%)) + (nconc ls%%% ls%%%) + ls)) ; The lack of a mark here is due to an ignored circular list error. (testcover-testcase-cyc1 1) (testcover-testcase-cyc1 1) +(defun testcover-testcase-cyc2 (a b) + (let ((ls1 (make-list 10 a%%%)%%%) + (ls2 (make-list 10 b))) + (nconc ls2 ls2) + (nconc ls1%%% ls2) + ls1)) +(testcover-testcase-cyc2 1 2) +(testcover-testcase-cyc2 1 4) ;; testcases.el ends here. diff --git a/test/lisp/emacs-lisp/testcover-tests.el b/test/lisp/emacs-lisp/testcover-tests.el index 0f0ee9a5095..2e03488b306 100644 --- a/test/lisp/emacs-lisp/testcover-tests.el +++ b/test/lisp/emacs-lisp/testcover-tests.el @@ -124,14 +124,12 @@ arguments for `testcover-start'." (save-current-buffer (set-buffer (find-file-noselect tempfile)) ;; Fail the test if the debugger tries to become active, - ;; which will happen if Testcover's reinstrumentation - ;; leaves an edebug-enter in the code. This will also - ;; prevent debugging these tests using Edebug. - (cl-letf (((symbol-function #'edebug-enter) + ;; which can happen if Testcover fails to attach itself + ;; correctly. Note that this will prevent debugging + ;; these tests using Edebug. + (cl-letf (((symbol-function #'edebug-default-enter) (lambda (&rest _args) - (ert-fail - (concat "Debugger invoked during test run " - "(possible edebug-enter not replaced)"))))) + (ert-fail "Debugger invoked during test run")))) (dolist (byte-compile '(t nil)) (testcover-tests-unmarkup-region (point-min) (point-max)) (unwind-protect diff --git a/test/lisp/help-fns-tests.el b/test/lisp/help-fns-tests.el index 98e6b335b90..6dc5299ef3c 100644 --- a/test/lisp/help-fns-tests.el +++ b/test/lisp/help-fns-tests.el @@ -81,6 +81,11 @@ Return first line of the output of (describe-function-1 FUNC)." (result (help-fns-tests--describe-function 'search-forward-regexp))) (should (string-match regexp result)))) +(ert-deftest help-fns-test-dangling-alias () + "Make sure we don't burp on bogus aliases." + (let ((f (make-symbol "bogus-alias"))) + (define-obsolete-function-alias f 'help-fns-test--undefined-function "past") + (describe-symbol f))) ;;; Test describe-function over functions with funny names (defun abc\\\[universal-argument\]b\`c\'d\\e\"f (x) diff --git a/test/lisp/xdg-tests.el b/test/lisp/xdg-tests.el index b80f5e85524..eaf03ab9a03 100644 --- a/test/lisp/xdg-tests.el +++ b/test/lisp/xdg-tests.el @@ -65,4 +65,16 @@ (should (equal (xdg-desktop-strings " ") nil)) (should (equal (xdg-desktop-strings "a; ;") '("a" " ")))) +(ert-deftest xdg-mime-associations () + "Test reading MIME associations from files." + (let* ((apps (expand-file-name "mimeapps.list" xdg-tests-data-dir)) + (cache (expand-file-name "mimeinfo.cache" xdg-tests-data-dir)) + (fs (list apps cache))) + (should (equal (xdg-mime-collect-associations "x-test/foo" fs) + '("a.desktop" "b.desktop"))) + (should (equal (xdg-mime-collect-associations "x-test/bar" fs) + '("a.desktop" "c.desktop"))) + (should (equal (xdg-mime-collect-associations "x-test/baz" fs) + '("a.desktop" "b.desktop" "d.desktop"))))) + ;;; xdg-tests.el ends here |