diff options
Diffstat (limited to 'test/lisp')
| -rw-r--r-- | test/lisp/auth-source-tests.el | 2 | ||||
| -rw-r--r-- | test/lisp/dired-tests.el | 179 | ||||
| -rw-r--r-- | test/lisp/emacs-lisp/cl-generic-tests.el | 24 | ||||
| -rw-r--r-- | test/lisp/emacs-lisp/ert-tests.el | 2 | ||||
| -rw-r--r-- | test/lisp/emacs-lisp/rx-tests.el | 10 | ||||
| -rw-r--r-- | test/lisp/ls-lisp.el | 37 | ||||
| -rw-r--r-- | test/lisp/net/tramp-tests.el | 137 | ||||
| -rw-r--r-- | test/lisp/register-tests.el | 43 | ||||
| -rw-r--r-- | test/lisp/subr-tests.el | 25 |
9 files changed, 409 insertions, 50 deletions
diff --git a/test/lisp/auth-source-tests.el b/test/lisp/auth-source-tests.el index 2634777c7db..9753029f198 100644 --- a/test/lisp/auth-source-tests.el +++ b/test/lisp/auth-source-tests.el | |||
| @@ -215,7 +215,7 @@ | |||
| 215 | 215 | ||
| 216 | (ert-deftest auth-source-test-remembrances-of-things-past () | 216 | (ert-deftest auth-source-test-remembrances-of-things-past () |
| 217 | (let ((password-cache t) | 217 | (let ((password-cache t) |
| 218 | (password-data (make-vector 7 0))) | 218 | (password-data (copy-hash-table password-data))) |
| 219 | (auth-source-remember '(:host "wedd") '(4 5 6)) | 219 | (auth-source-remember '(:host "wedd") '(4 5 6)) |
| 220 | (should (auth-source-remembered-p '(:host "wedd"))) | 220 | (should (auth-source-remembered-p '(:host "wedd"))) |
| 221 | (should-not (auth-source-remembered-p '(:host "xedd"))) | 221 | (should-not (auth-source-remembered-p '(:host "xedd"))) |
diff --git a/test/lisp/dired-tests.el b/test/lisp/dired-tests.el index bd1816172e7..cd58edaa3f8 100644 --- a/test/lisp/dired-tests.el +++ b/test/lisp/dired-tests.el | |||
| @@ -38,19 +38,21 @@ | |||
| 38 | (file "test") | 38 | (file "test") |
| 39 | (full-name (expand-file-name file dir)) | 39 | (full-name (expand-file-name file dir)) |
| 40 | (regexp "bar") | 40 | (regexp "bar") |
| 41 | (dired-always-read-filesystem t)) | 41 | (dired-always-read-filesystem t) buffers) |
| 42 | (if (file-exists-p dir) | 42 | (if (file-exists-p dir) |
| 43 | (delete-directory dir 'recursive)) | 43 | (delete-directory dir 'recursive)) |
| 44 | (make-directory dir) | 44 | (make-directory dir) |
| 45 | (with-temp-file full-name (insert "foo")) | 45 | (with-temp-file full-name (insert "foo")) |
| 46 | (find-file-noselect full-name) | 46 | (push (find-file-noselect full-name) buffers) |
| 47 | (dired dir) | 47 | (push (dired dir) buffers) |
| 48 | (with-temp-file full-name (insert "bar")) | 48 | (with-temp-file full-name (insert "bar")) |
| 49 | (dired-mark-files-containing-regexp regexp) | 49 | (dired-mark-files-containing-regexp regexp) |
| 50 | (unwind-protect | 50 | (unwind-protect |
| 51 | (should (equal (dired-get-marked-files nil nil nil 'distinguish-1-mark) | 51 | (should (equal (dired-get-marked-files nil nil nil 'distinguish-1-mark) |
| 52 | `(t ,full-name))) | 52 | `(t ,full-name))) |
| 53 | ;; Clean up | 53 | ;; Clean up |
| 54 | (dolist (buf buffers) | ||
| 55 | (when (buffer-live-p buf) (kill-buffer buf))) | ||
| 54 | (delete-directory dir 'recursive)))) | 56 | (delete-directory dir 'recursive)))) |
| 55 | 57 | ||
| 56 | (ert-deftest dired-test-bug25609 () | 58 | (ert-deftest dired-test-bug25609 () |
| @@ -60,7 +62,8 @@ | |||
| 60 | (target (expand-file-name (file-name-nondirectory from) to)) | 62 | (target (expand-file-name (file-name-nondirectory from) to)) |
| 61 | (nested (expand-file-name (file-name-nondirectory from) target)) | 63 | (nested (expand-file-name (file-name-nondirectory from) target)) |
| 62 | (dired-dwim-target t) | 64 | (dired-dwim-target t) |
| 63 | (dired-recursive-copies 'always)) ; Don't prompt me. | 65 | (dired-recursive-copies 'always) ; Don't prompt me. |
| 66 | buffers) | ||
| 64 | (advice-add 'dired-query ; Don't ask confirmation to overwrite a file. | 67 | (advice-add 'dired-query ; Don't ask confirmation to overwrite a file. |
| 65 | :override | 68 | :override |
| 66 | (lambda (_sym _prompt &rest _args) (setq dired-query t)) | 69 | (lambda (_sym _prompt &rest _args) (setq dired-query t)) |
| @@ -70,8 +73,8 @@ | |||
| 70 | (lambda (_prompt _coll &optional _pred _match init _hist _def _inherit _keymap) | 73 | (lambda (_prompt _coll &optional _pred _match init _hist _def _inherit _keymap) |
| 71 | init) | 74 | init) |
| 72 | '((name . "advice-completing-read"))) | 75 | '((name . "advice-completing-read"))) |
| 73 | (dired to) | 76 | (push (dired to) buffers) |
| 74 | (dired-other-window temporary-file-directory) | 77 | (push (dired-other-window temporary-file-directory) buffers) |
| 75 | (dired-goto-file from) | 78 | (dired-goto-file from) |
| 76 | (dired-do-copy) | 79 | (dired-do-copy) |
| 77 | (dired-do-copy); Again. | 80 | (dired-do-copy); Again. |
| @@ -79,18 +82,80 @@ | |||
| 79 | (progn | 82 | (progn |
| 80 | (should (file-exists-p target)) | 83 | (should (file-exists-p target)) |
| 81 | (should-not (file-exists-p nested))) | 84 | (should-not (file-exists-p nested))) |
| 85 | (dolist (buf buffers) | ||
| 86 | (when (buffer-live-p buf) (kill-buffer buf))) | ||
| 82 | (delete-directory from 'recursive) | 87 | (delete-directory from 'recursive) |
| 83 | (delete-directory to 'recursive) | 88 | (delete-directory to 'recursive) |
| 84 | (advice-remove 'dired-query "advice-dired-query") | 89 | (advice-remove 'dired-query "advice-dired-query") |
| 85 | (advice-remove 'completing-read "advice-completing-read")))) | 90 | (advice-remove 'completing-read "advice-completing-read")))) |
| 86 | 91 | ||
| 87 | (ert-deftest dired-test-bug27243 () | 92 | ;; (ert-deftest dired-test-bug27243 () |
| 88 | "Test for http://debbugs.gnu.org/27243 ." | 93 | ;; "Test for http://debbugs.gnu.org/27243 ." |
| 94 | ;; (let ((test-dir (make-temp-file "test-dir-" t)) | ||
| 95 | ;; (dired-auto-revert-buffer t) buffers) | ||
| 96 | ;; (with-current-buffer (find-file-noselect test-dir) | ||
| 97 | ;; (make-directory "test-subdir")) | ||
| 98 | ;; (push (dired test-dir) buffers) | ||
| 99 | ;; (unwind-protect | ||
| 100 | ;; (let ((buf (current-buffer)) | ||
| 101 | ;; (pt1 (point)) | ||
| 102 | ;; (test-file (concat (file-name-as-directory "test-subdir") | ||
| 103 | ;; "test-file"))) | ||
| 104 | ;; (write-region "Test" nil test-file nil 'silent nil 'excl) | ||
| 105 | ;; ;; Sanity check: point should now be on the subdirectory. | ||
| 106 | ;; (should (equal (dired-file-name-at-point) | ||
| 107 | ;; (concat (file-name-as-directory test-dir) | ||
| 108 | ;; (file-name-as-directory "test-subdir")))) | ||
| 109 | ;; (push (dired-find-file) buffers) | ||
| 110 | ;; (let ((pt2 (point))) ; Point is on test-file. | ||
| 111 | ;; (switch-to-buffer buf) | ||
| 112 | ;; ;; Sanity check: point should now be back on the subdirectory. | ||
| 113 | ;; (should (eq (point) pt1)) | ||
| 114 | ;; ;; Case 1: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27243#5 | ||
| 115 | ;; (push (dired-find-file) buffers) | ||
| 116 | ;; (should (eq (point) pt2)) | ||
| 117 | ;; ;; Case 2: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27243#28 | ||
| 118 | ;; (push (dired test-dir) buffers) | ||
| 119 | ;; (should (eq (point) pt1)))) | ||
| 120 | ;; (dolist (buf buffers) | ||
| 121 | ;; (when (buffer-live-p buf) (kill-buffer buf))) | ||
| 122 | ;; (delete-directory test-dir t)))) | ||
| 123 | |||
| 124 | (ert-deftest dired-test-bug27243-01 () | ||
| 125 | "Test for https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27243#5 ." | ||
| 126 | (let ((test-dir (make-temp-file "test-dir-" t)) | ||
| 127 | (dired-auto-revert-buffer t) buffers) | ||
| 128 | (with-current-buffer (find-file-noselect test-dir) | ||
| 129 | (make-directory "test-subdir")) | ||
| 130 | (push (dired test-dir) buffers) | ||
| 131 | (unwind-protect | ||
| 132 | (let ((buf (current-buffer)) | ||
| 133 | (pt1 (point)) | ||
| 134 | (test-file (concat (file-name-as-directory "test-subdir") | ||
| 135 | "test-file"))) | ||
| 136 | (write-region "Test" nil test-file nil 'silent nil 'excl) | ||
| 137 | ;; Sanity check: point should now be on the subdirectory. | ||
| 138 | (should (equal (dired-file-name-at-point) | ||
| 139 | (concat (file-name-as-directory test-dir) | ||
| 140 | (file-name-as-directory "test-subdir")))) | ||
| 141 | (push (dired-find-file) buffers) | ||
| 142 | (let ((pt2 (point))) ; Point is on test-file. | ||
| 143 | (switch-to-buffer buf) | ||
| 144 | ;; Sanity check: point should now be back on the subdirectory. | ||
| 145 | (should (eq (point) pt1)) | ||
| 146 | (push (dired-find-file) buffers) | ||
| 147 | (should (eq (point) pt2)))) | ||
| 148 | (dolist (buf buffers) | ||
| 149 | (when (buffer-live-p buf) (kill-buffer buf))) | ||
| 150 | (delete-directory test-dir t)))) | ||
| 151 | |||
| 152 | (ert-deftest dired-test-bug27243-02 () | ||
| 153 | "Test for https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27243#28 ." | ||
| 89 | (let ((test-dir (make-temp-file "test-dir-" t)) | 154 | (let ((test-dir (make-temp-file "test-dir-" t)) |
| 90 | (dired-auto-revert-buffer t)) | 155 | (dired-auto-revert-buffer t) buffers) |
| 91 | (with-current-buffer (find-file-noselect test-dir) | 156 | (with-current-buffer (find-file-noselect test-dir) |
| 92 | (make-directory "test-subdir")) | 157 | (make-directory "test-subdir")) |
| 93 | (dired test-dir) | 158 | (push (dired test-dir) buffers) |
| 94 | (unwind-protect | 159 | (unwind-protect |
| 95 | (let ((buf (current-buffer)) | 160 | (let ((buf (current-buffer)) |
| 96 | (pt1 (point)) | 161 | (pt1 (point)) |
| @@ -101,17 +166,48 @@ | |||
| 101 | (should (equal (dired-file-name-at-point) | 166 | (should (equal (dired-file-name-at-point) |
| 102 | (concat (file-name-as-directory test-dir) | 167 | (concat (file-name-as-directory test-dir) |
| 103 | (file-name-as-directory "test-subdir")))) | 168 | (file-name-as-directory "test-subdir")))) |
| 104 | (dired-find-file) | 169 | (push (dired-find-file) buffers) |
| 105 | (let ((pt2 (point))) ; Point is on test-file. | 170 | (let ((pt2 (point))) ; Point is on test-file. |
| 106 | (switch-to-buffer buf) | 171 | (switch-to-buffer buf) |
| 107 | ;; Sanity check: point should now be back on the subdirectory. | 172 | ;; Sanity check: point should now be back on the subdirectory. |
| 108 | (should (eq (point) pt1)) | 173 | (should (eq (point) pt1)) |
| 109 | ;; Case 1: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27243#5 | 174 | (push (dired test-dir) buffers) |
| 110 | (dired-find-file) | ||
| 111 | (should (eq (point) pt2)) | ||
| 112 | ;; Case 2: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27243#28 | ||
| 113 | (dired test-dir) | ||
| 114 | (should (eq (point) pt1)))) | 175 | (should (eq (point) pt1)))) |
| 176 | (dolist (buf buffers) | ||
| 177 | (when (buffer-live-p buf) (kill-buffer buf))) | ||
| 178 | (delete-directory test-dir t)))) | ||
| 179 | |||
| 180 | (ert-deftest dired-test-bug27243-03 () | ||
| 181 | "Test for https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27243#61 ." | ||
| 182 | (let ((test-dir (make-temp-file "test-dir-" t)) | ||
| 183 | (dired-auto-revert-buffer t) | ||
| 184 | test-subdir1 test-subdir2 allbufs) | ||
| 185 | (unwind-protect | ||
| 186 | (progn | ||
| 187 | (with-current-buffer (find-file-noselect test-dir) | ||
| 188 | (push (current-buffer) allbufs) | ||
| 189 | (make-directory "test-subdir1") | ||
| 190 | (make-directory "test-subdir2") | ||
| 191 | (let ((test-file1 "test-file1") | ||
| 192 | (test-file2 "test-file2")) | ||
| 193 | (with-current-buffer (find-file-noselect "test-subdir1") | ||
| 194 | (push (current-buffer) allbufs) | ||
| 195 | (write-region "Test1" nil test-file1 nil 'silent nil 'excl)) | ||
| 196 | (with-current-buffer (find-file-noselect "test-subdir2") | ||
| 197 | (push (current-buffer) allbufs) | ||
| 198 | (write-region "Test2" nil test-file2 nil 'silent nil 'excl)))) | ||
| 199 | ;; Call find-file with a wild card and test point in each file. | ||
| 200 | (let ((buffers (find-file (concat (file-name-as-directory test-dir) | ||
| 201 | "*") | ||
| 202 | t))) | ||
| 203 | (dolist (buf buffers) | ||
| 204 | (let ((pt (with-current-buffer buf (point)))) | ||
| 205 | (switch-to-buffer (find-file-noselect test-dir)) | ||
| 206 | (find-file (buffer-name buf)) | ||
| 207 | (should (equal (point) pt)))) | ||
| 208 | (append buffers allbufs))) | ||
| 209 | (dolist (buf allbufs) | ||
| 210 | (when (buffer-live-p buf) (kill-buffer buf))) | ||
| 115 | (delete-directory test-dir t)))) | 211 | (delete-directory test-dir t)))) |
| 116 | 212 | ||
| 117 | (ert-deftest dired-test-bug27693 () | 213 | (ert-deftest dired-test-bug27693 () |
| @@ -168,5 +264,56 @@ | |||
| 168 | (should (looking-at "src"))) | 264 | (should (looking-at "src"))) |
| 169 | (when (buffer-live-p buf) (kill-buffer buf))))) | 265 | (when (buffer-live-p buf) (kill-buffer buf))))) |
| 170 | 266 | ||
| 267 | (ert-deftest dired-test-bug27817 () | ||
| 268 | "Test for http://debbugs.gnu.org/27817 ." | ||
| 269 | (require 'em-ls) | ||
| 270 | (let ((orig eshell-ls-use-in-dired) | ||
| 271 | (dired-use-ls-dired 'unspecified) | ||
| 272 | buf insert-directory-program) | ||
| 273 | (unwind-protect | ||
| 274 | (progn | ||
| 275 | (customize-set-variable 'eshell-ls-use-in-dired t) | ||
| 276 | (should (setq buf (dired source-directory)))) | ||
| 277 | (customize-set-variable 'eshell-ls-use-in-dired orig) | ||
| 278 | (and (buffer-live-p buf) (kill-buffer))))) | ||
| 279 | |||
| 280 | (ert-deftest dired-test-bug27631 () | ||
| 281 | "Test for http://debbugs.gnu.org/27631 ." | ||
| 282 | (let* ((dir (make-temp-file "bug27631" 'dir)) | ||
| 283 | (dir1 (expand-file-name "dir1" dir)) | ||
| 284 | (dir2 (expand-file-name "dir2" dir)) | ||
| 285 | (default-directory dir) | ||
| 286 | buf) | ||
| 287 | (unwind-protect | ||
| 288 | (progn | ||
| 289 | (make-directory dir1) | ||
| 290 | (make-directory dir2) | ||
| 291 | (with-temp-file (expand-file-name "a.txt" dir1)) | ||
| 292 | (with-temp-file (expand-file-name "b.txt" dir2)) | ||
| 293 | (setq buf (dired (expand-file-name "dir*/*.txt" dir))) | ||
| 294 | (dired-toggle-marks) | ||
| 295 | (should (cdr (dired-get-marked-files))) | ||
| 296 | ;; Must work with ls-lisp ... | ||
| 297 | (require 'ls-lisp) | ||
| 298 | (kill-buffer buf) | ||
| 299 | (setq default-directory dir) | ||
| 300 | (let (ls-lisp-use-insert-directory-program) | ||
| 301 | (setq buf (dired (expand-file-name "dir*/*.txt" dir))) | ||
| 302 | (dired-toggle-marks) | ||
| 303 | (should (cdr (dired-get-marked-files)))) | ||
| 304 | ;; ... And with em-ls as well. | ||
| 305 | (kill-buffer buf) | ||
| 306 | (setq default-directory dir) | ||
| 307 | (unload-feature 'ls-lisp 'force) | ||
| 308 | (require 'em-ls) | ||
| 309 | (let ((orig eshell-ls-use-in-dired)) | ||
| 310 | (customize-set-value 'eshell-ls-use-in-dired t) | ||
| 311 | (setq buf (dired (expand-file-name "dir*/*.txt" dir))) | ||
| 312 | (dired-toggle-marks) | ||
| 313 | (should (cdr (dired-get-marked-files))))) | ||
| 314 | (delete-directory dir 'recursive) | ||
| 315 | (when (buffer-live-p buf) (kill-buffer buf))))) | ||
| 316 | |||
| 317 | |||
| 171 | (provide 'dired-tests) | 318 | (provide 'dired-tests) |
| 172 | ;; dired-tests.el ends here | 319 | ;; dired-tests.el ends here |
diff --git a/test/lisp/emacs-lisp/cl-generic-tests.el b/test/lisp/emacs-lisp/cl-generic-tests.el index 0768e31f7e6..31f65413c88 100644 --- a/test/lisp/emacs-lisp/cl-generic-tests.el +++ b/test/lisp/emacs-lisp/cl-generic-tests.el | |||
| @@ -219,5 +219,29 @@ | |||
| 219 | (should (equal (cl--generic-1 '(5) nil) '("cinq" (5)))) | 219 | (should (equal (cl--generic-1 '(5) nil) '("cinq" (5)))) |
| 220 | (should (equal (cl--generic-1 '(6) nil) '("six" a)))) | 220 | (should (equal (cl--generic-1 '(6) nil) '("six" a)))) |
| 221 | 221 | ||
| 222 | (cl-defgeneric cl-generic-tests--generic (x)) | ||
| 223 | (cl-defmethod cl-generic-tests--generic ((x string)) | ||
| 224 | (message "%s is a string" x)) | ||
| 225 | (cl-defmethod cl-generic-tests--generic ((x integer)) | ||
| 226 | (message "%s is a number" x)) | ||
| 227 | (cl-defgeneric cl-generic-tests--generic-without-methods (x y)) | ||
| 228 | (defvar cl-generic-tests--this-file | ||
| 229 | (file-truename (or load-file-name buffer-file-name))) | ||
| 230 | |||
| 231 | (ert-deftest cl-generic-tests--method-files--finds-methods () | ||
| 232 | "`method-files' returns a list of files and methods for a generic function." | ||
| 233 | (let ((retval (cl--generic-method-files 'cl-generic-tests--generic))) | ||
| 234 | (should (equal (length retval) 2)) | ||
| 235 | (mapc (lambda (x) | ||
| 236 | (should (equal (car x) cl-generic-tests--this-file)) | ||
| 237 | (should (equal (cadr x) 'cl-generic-tests--generic))) | ||
| 238 | retval) | ||
| 239 | (should-not (equal (nth 0 retval) (nth 1 retval))))) | ||
| 240 | |||
| 241 | (ert-deftest cl-generic-tests--method-files--nonexistent-methods () | ||
| 242 | "`method-files' returns nil if asked to find a method which doesn't exist." | ||
| 243 | (should-not (cl--generic-method-files 'cl-generic-tests--undefined-generic)) | ||
| 244 | (should-not (cl--generic-method-files 'cl-generic-tests--generic-without-methods))) | ||
| 245 | |||
| 222 | (provide 'cl-generic-tests) | 246 | (provide 'cl-generic-tests) |
| 223 | ;;; cl-generic-tests.el ends here | 247 | ;;; cl-generic-tests.el ends here |
diff --git a/test/lisp/emacs-lisp/ert-tests.el b/test/lisp/emacs-lisp/ert-tests.el index 317838b250f..57463ad932d 100644 --- a/test/lisp/emacs-lisp/ert-tests.el +++ b/test/lisp/emacs-lisp/ert-tests.el | |||
| @@ -352,7 +352,7 @@ This macro is used to test if macroexpansion in `should' works." | |||
| 352 | (let ((abc (ert-get-test 'ert-test-abc))) | 352 | (let ((abc (ert-get-test 'ert-test-abc))) |
| 353 | (should (equal (ert-test-tags abc) '(bar))) | 353 | (should (equal (ert-test-tags abc) '(bar))) |
| 354 | (should (equal (ert-test-documentation abc) "foo"))) | 354 | (should (equal (ert-test-documentation abc) "foo"))) |
| 355 | (should (equal (symbol-file 'ert-test-deftest 'ert-deftest) | 355 | (should (equal (symbol-file 'ert-test-deftest 'ert--test) |
| 356 | (symbol-file 'ert-test--which-file 'defun))) | 356 | (symbol-file 'ert-test--which-file 'defun))) |
| 357 | 357 | ||
| 358 | (ert-deftest ert-test-def () :expected-result ':passed) | 358 | (ert-deftest ert-test-def () :expected-result ':passed) |
diff --git a/test/lisp/emacs-lisp/rx-tests.el b/test/lisp/emacs-lisp/rx-tests.el index 8b7945c9d27..8f353b7e863 100644 --- a/test/lisp/emacs-lisp/rx-tests.el +++ b/test/lisp/emacs-lisp/rx-tests.el | |||
| @@ -33,5 +33,15 @@ | |||
| 33 | (number-sequence ?< ?\]) | 33 | (number-sequence ?< ?\]) |
| 34 | (number-sequence ?- ?:)))))) | 34 | (number-sequence ?- ?:)))))) |
| 35 | 35 | ||
| 36 | (ert-deftest rx-pcase () | ||
| 37 | (should (equal (pcase "a 1 2 3 1 1 b" | ||
| 38 | ((rx (let u (+ digit)) space | ||
| 39 | (let v (+ digit)) space | ||
| 40 | (let v (+ digit)) space | ||
| 41 | (backref u) space | ||
| 42 | (backref 1)) | ||
| 43 | (list u v))) | ||
| 44 | '("1" "3")))) | ||
| 45 | |||
| 36 | (provide 'rx-tests) | 46 | (provide 'rx-tests) |
| 37 | ;; rx-tests.el ends here. | 47 | ;; rx-tests.el ends here. |
diff --git a/test/lisp/ls-lisp.el b/test/lisp/ls-lisp.el new file mode 100644 index 00000000000..5ef7c78f4df --- /dev/null +++ b/test/lisp/ls-lisp.el | |||
| @@ -0,0 +1,37 @@ | |||
| 1 | ;;; ls-lisp-tests.el --- tests for ls-lisp.el -*- lexical-binding: t-*- | ||
| 2 | |||
| 3 | ;; Copyright (C) 2017 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Author: Tino Calacha <tino.calancha@gmail.com> | ||
| 6 | ;; Keywords: | ||
| 7 | |||
| 8 | ;; This file is part of GNU Emacs. | ||
| 9 | |||
| 10 | ;; GNU Emacs is free software: you can redistribute it and/or modify | ||
| 11 | ;; it under the terms of the GNU General Public License as published by | ||
| 12 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 13 | ;; (at your option) any later version. | ||
| 14 | |||
| 15 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 18 | ;; GNU General Public License for more details. | ||
| 19 | |||
| 20 | ;; You should have received a copy of the GNU General Public License | ||
| 21 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | ||
| 22 | |||
| 23 | ;;; Commentary: | ||
| 24 | |||
| 25 | |||
| 26 | ;;; Code: | ||
| 27 | (require 'ert) | ||
| 28 | |||
| 29 | (ert-deftest ls-lisp-unload () | ||
| 30 | "Test for http://debbugs.gnu.org/xxxxx ." | ||
| 31 | (require 'ls-lisp) | ||
| 32 | (should (advice-member-p 'ls-lisp--insert-directory 'insert-directory)) | ||
| 33 | (unload-feature 'ls-lisp 'force) | ||
| 34 | (should-not (advice-member-p 'ls-lisp--insert-directory 'insert-directory))) | ||
| 35 | |||
| 36 | (provide 'ls-lisp-tests) | ||
| 37 | ;;; ls-lisp-tests.el ends here | ||
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 94e91b79300..979f674f0f1 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el | |||
| @@ -149,6 +149,7 @@ handled properly. BODY shall not contain a timeout." | |||
| 149 | (debug-ignored-errors | 149 | (debug-ignored-errors |
| 150 | (cons "^make-symbolic-link not supported$" debug-ignored-errors)) | 150 | (cons "^make-symbolic-link not supported$" debug-ignored-errors)) |
| 151 | inhibit-message) | 151 | inhibit-message) |
| 152 | (message "tramp--test-instrument-test-case %s" tramp-verbose) | ||
| 152 | (unwind-protect | 153 | (unwind-protect |
| 153 | (let ((tramp--test-instrument-test-case-p t)) ,@body) | 154 | (let ((tramp--test-instrument-test-case-p t)) ,@body) |
| 154 | ;; Unwind forms. | 155 | ;; Unwind forms. |
| @@ -2201,6 +2202,108 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." | |||
| 2201 | ;; Cleanup. | 2202 | ;; Cleanup. |
| 2202 | (ignore-errors (delete-directory tmp-name1 'recursive)))))) | 2203 | (ignore-errors (delete-directory tmp-name1 'recursive)))))) |
| 2203 | 2204 | ||
| 2205 | (ert-deftest tramp-test17-dired-with-wildcards () | ||
| 2206 | "Check `dired' with wildcards." | ||
| 2207 | (skip-unless (tramp--test-enabled)) | ||
| 2208 | (skip-unless (fboundp 'insert-directory-wildcard-in-dir-p)) | ||
| 2209 | |||
| 2210 | (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) | ||
| 2211 | (let* ((tmp-name1 | ||
| 2212 | (expand-file-name (tramp--test-make-temp-name nil quoted))) | ||
| 2213 | (tmp-name2 | ||
| 2214 | (expand-file-name (tramp--test-make-temp-name nil quoted))) | ||
| 2215 | (tmp-name3 (expand-file-name "foo" tmp-name1)) | ||
| 2216 | (tmp-name4 (expand-file-name "bar" tmp-name2)) | ||
| 2217 | (tramp-test-temporary-file-directory | ||
| 2218 | (funcall | ||
| 2219 | (if quoted 'tramp-compat-file-name-quote 'identity) | ||
| 2220 | tramp-test-temporary-file-directory)) | ||
| 2221 | buffer) | ||
| 2222 | (unwind-protect | ||
| 2223 | (progn | ||
| 2224 | (make-directory tmp-name1) | ||
| 2225 | (write-region "foo" nil tmp-name3) | ||
| 2226 | (should (file-directory-p tmp-name1)) | ||
| 2227 | (should (file-exists-p tmp-name3)) | ||
| 2228 | (make-directory tmp-name2) | ||
| 2229 | (write-region "foo" nil tmp-name4) | ||
| 2230 | (should (file-directory-p tmp-name2)) | ||
| 2231 | (should (file-exists-p tmp-name4)) | ||
| 2232 | |||
| 2233 | ;; Check for expanded directory names. | ||
| 2234 | (with-current-buffer | ||
| 2235 | (setq buffer | ||
| 2236 | (dired-noselect | ||
| 2237 | (expand-file-name | ||
| 2238 | "tramp-test*" tramp-test-temporary-file-directory))) | ||
| 2239 | (goto-char (point-min)) | ||
| 2240 | (should | ||
| 2241 | (re-search-forward | ||
| 2242 | (regexp-quote | ||
| 2243 | (file-relative-name | ||
| 2244 | tmp-name1 tramp-test-temporary-file-directory)))) | ||
| 2245 | (goto-char (point-min)) | ||
| 2246 | (should | ||
| 2247 | (re-search-forward | ||
| 2248 | (regexp-quote | ||
| 2249 | (file-relative-name | ||
| 2250 | tmp-name2 tramp-test-temporary-file-directory))))) | ||
| 2251 | (kill-buffer buffer) | ||
| 2252 | |||
| 2253 | ;; Check for expanded directory and file names. | ||
| 2254 | (with-current-buffer | ||
| 2255 | (setq buffer | ||
| 2256 | (dired-noselect | ||
| 2257 | (expand-file-name | ||
| 2258 | "tramp-test*/*" tramp-test-temporary-file-directory))) | ||
| 2259 | (goto-char (point-min)) | ||
| 2260 | (should | ||
| 2261 | (re-search-forward | ||
| 2262 | (regexp-quote | ||
| 2263 | (file-relative-name | ||
| 2264 | tmp-name3 tramp-test-temporary-file-directory)))) | ||
| 2265 | (goto-char (point-min)) | ||
| 2266 | (should | ||
| 2267 | (re-search-forward | ||
| 2268 | (regexp-quote | ||
| 2269 | (file-relative-name | ||
| 2270 | tmp-name4 | ||
| 2271 | tramp-test-temporary-file-directory))))) | ||
| 2272 | (kill-buffer buffer) | ||
| 2273 | |||
| 2274 | ;; Check for special characters. | ||
| 2275 | (setq tmp-name3 (expand-file-name "*?" tmp-name1)) | ||
| 2276 | (setq tmp-name4 (expand-file-name "[a-z0-9]" tmp-name2)) | ||
| 2277 | (write-region "foo" nil tmp-name3) | ||
| 2278 | (should (file-exists-p tmp-name3)) | ||
| 2279 | (write-region "foo" nil tmp-name4) | ||
| 2280 | (should (file-exists-p tmp-name4)) | ||
| 2281 | |||
| 2282 | (with-current-buffer | ||
| 2283 | (setq buffer | ||
| 2284 | (dired-noselect | ||
| 2285 | (expand-file-name | ||
| 2286 | "tramp-test*/*" tramp-test-temporary-file-directory))) | ||
| 2287 | (goto-char (point-min)) | ||
| 2288 | (should | ||
| 2289 | (re-search-forward | ||
| 2290 | (regexp-quote | ||
| 2291 | (file-relative-name | ||
| 2292 | tmp-name3 tramp-test-temporary-file-directory)))) | ||
| 2293 | (goto-char (point-min)) | ||
| 2294 | (should | ||
| 2295 | (re-search-forward | ||
| 2296 | (regexp-quote | ||
| 2297 | (file-relative-name | ||
| 2298 | tmp-name4 | ||
| 2299 | tramp-test-temporary-file-directory))))) | ||
| 2300 | (kill-buffer buffer)) | ||
| 2301 | |||
| 2302 | ;; Cleanup. | ||
| 2303 | (ignore-errors (kill-buffer buffer)) | ||
| 2304 | (ignore-errors (delete-directory tmp-name1 'recursive)) | ||
| 2305 | (ignore-errors (delete-directory tmp-name2 'recursive)))))) | ||
| 2306 | |||
| 2204 | (ert-deftest tramp-test18-file-attributes () | 2307 | (ert-deftest tramp-test18-file-attributes () |
| 2205 | "Check `file-attributes'. | 2308 | "Check `file-attributes'. |
| 2206 | This tests also `file-readable-p', `file-regular-p' and | 2309 | This tests also `file-readable-p', `file-regular-p' and |
| @@ -3680,6 +3783,10 @@ Use the `ls' command." | |||
| 3680 | tramp-connection-properties))) | 3783 | tramp-connection-properties))) |
| 3681 | (tramp--test-utf8))) | 3784 | (tramp--test-utf8))) |
| 3682 | 3785 | ||
| 3786 | (defun tramp--test-timeout-handler () | ||
| 3787 | (interactive) | ||
| 3788 | (ert-fail (format "`%s' timed out" (ert-test-name (ert-running-test))))) | ||
| 3789 | |||
| 3683 | ;; This test is inspired by Bug#16928. | 3790 | ;; This test is inspired by Bug#16928. |
| 3684 | (ert-deftest tramp-test36-asynchronous-requests () | 3791 | (ert-deftest tramp-test36-asynchronous-requests () |
| 3685 | "Check parallel asynchronous requests. | 3792 | "Check parallel asynchronous requests. |
| @@ -3689,10 +3796,15 @@ process sentinels. They shall not disturb each other." | |||
| 3689 | (skip-unless (tramp--test-enabled)) | 3796 | (skip-unless (tramp--test-enabled)) |
| 3690 | (skip-unless (tramp--test-sh-p)) | 3797 | (skip-unless (tramp--test-sh-p)) |
| 3691 | 3798 | ||
| 3692 | ;; This test could be blocked on hydra. | 3799 | ;; This test could be blocked on hydra. So we set a timeout of 300 |
| 3693 | (with-timeout | 3800 | ;; seconds, and we send a SIGUSR1 signal after 300 seconds. |
| 3694 | (300 (ert-fail "`tramp-test36-asynchronous-requests' timed out")) | 3801 | (with-timeout (300 (tramp--test-timeout-handler)) |
| 3695 | (let* ((tmp-name (tramp--test-make-temp-name)) | 3802 | (define-key special-event-map [sigusr1] 'tramp--test-timeout-handler) |
| 3803 | (let* ((watchdog | ||
| 3804 | (start-process | ||
| 3805 | "*watchdog*" nil shell-file-name shell-command-switch | ||
| 3806 | (format "sleep 300; kill -USR1 %d" (emacs-pid)))) | ||
| 3807 | (tmp-name (tramp--test-make-temp-name)) | ||
| 3696 | (default-directory tmp-name) | 3808 | (default-directory tmp-name) |
| 3697 | ;; Do not cache Tramp properties. | 3809 | ;; Do not cache Tramp properties. |
| 3698 | (remote-file-name-inhibit-cache t) | 3810 | (remote-file-name-inhibit-cache t) |
| @@ -3802,9 +3914,11 @@ process sentinels. They shall not disturb each other." | |||
| 3802 | (tramp--test-message | 3914 | (tramp--test-message |
| 3803 | "Trace 2 action %d %s %s" count buf (current-time-string)) | 3915 | "Trace 2 action %d %s %s" count buf (current-time-string)) |
| 3804 | (accept-process-output proc 0.1 nil 0) | 3916 | (accept-process-output proc 0.1 nil 0) |
| 3805 | ;; Regular operation. | ||
| 3806 | (tramp--test-message | 3917 | (tramp--test-message |
| 3807 | "Trace 3 action %d %s %s" count buf (current-time-string)) | 3918 | "Trace 3 action %d %s %s" count buf (current-time-string)) |
| 3919 | ;; Give the watchdog a chance. | ||
| 3920 | (read-event nil nil 0.01) | ||
| 3921 | ;; Regular operation. | ||
| 3808 | (if (= count 2) | 3922 | (if (= count 2) |
| 3809 | (if (= (length buffers) 1) | 3923 | (if (= (length buffers) 1) |
| 3810 | (tramp--test-instrument-test-case 10 | 3924 | (tramp--test-instrument-test-case 10 |
| @@ -3820,8 +3934,7 @@ process sentinels. They shall not disturb each other." | |||
| 3820 | ;; Checks. All process output shall exists in the | 3934 | ;; Checks. All process output shall exists in the |
| 3821 | ;; respective buffers. All created files shall be | 3935 | ;; respective buffers. All created files shall be |
| 3822 | ;; deleted. | 3936 | ;; deleted. |
| 3823 | (tramp--test-message | 3937 | (tramp--test-message "Check %s" (current-time-string)) |
| 3824 | "Check %s" (current-time-string)) | ||
| 3825 | (dolist (buf buffers) | 3938 | (dolist (buf buffers) |
| 3826 | (with-current-buffer buf | 3939 | (with-current-buffer buf |
| 3827 | (should (string-equal (format "%s\n" buf) (buffer-string))))) | 3940 | (should (string-equal (format "%s\n" buf) (buffer-string))))) |
| @@ -3830,6 +3943,8 @@ process sentinels. They shall not disturb each other." | |||
| 3830 | tmp-name nil directory-files-no-dot-files-regexp))) | 3943 | tmp-name nil directory-files-no-dot-files-regexp))) |
| 3831 | 3944 | ||
| 3832 | ;; Cleanup. | 3945 | ;; Cleanup. |
| 3946 | (define-key special-event-map [sigusr1] 'ignore) | ||
| 3947 | (ignore-errors (quit-process watchdog)) | ||
| 3833 | (dolist (buf buffers) | 3948 | (dolist (buf buffers) |
| 3834 | (ignore-errors (delete-process (get-buffer-process buf))) | 3949 | (ignore-errors (delete-process (get-buffer-process buf))) |
| 3835 | (ignore-errors (kill-buffer buf))) | 3950 | (ignore-errors (kill-buffer buf))) |
| @@ -3906,6 +4021,14 @@ Since it unloads Tramp, it shall be the last test to run." | |||
| 3906 | (not (string-match "^tramp--?test" (symbol-name x))) | 4021 | (not (string-match "^tramp--?test" (symbol-name x))) |
| 3907 | (not (string-match "unload-hook$" (symbol-name x))) | 4022 | (not (string-match "unload-hook$" (symbol-name x))) |
| 3908 | (ert-fail (format "`%s' still bound" x))))) | 4023 | (ert-fail (format "`%s' still bound" x))))) |
| 4024 | ;; The defstruct `tramp-file-name' and all its internal functions | ||
| 4025 | ;; shall be purged. | ||
| 4026 | (should-not (cl--find-class 'tramp-file-name)) | ||
| 4027 | (mapatoms | ||
| 4028 | (lambda (x) | ||
| 4029 | (and (functionp x) | ||
| 4030 | (string-match "tramp-file-name" (symbol-name x)) | ||
| 4031 | (ert-fail (format "Structure function `%s' still exists" x))))) | ||
| 3909 | ;; There shouldn't be left a hook function containing a Tramp | 4032 | ;; There shouldn't be left a hook function containing a Tramp |
| 3910 | ;; function. We do not regard the Tramp unload hooks. | 4033 | ;; function. We do not regard the Tramp unload hooks. |
| 3911 | (mapatoms | 4034 | (mapatoms |
diff --git a/test/lisp/register-tests.el b/test/lisp/register-tests.el new file mode 100644 index 00000000000..0425bc0e0f4 --- /dev/null +++ b/test/lisp/register-tests.el | |||
| @@ -0,0 +1,43 @@ | |||
| 1 | ;;; register-tests.el --- tests for register.el -*- lexical-binding: t-*- | ||
| 2 | |||
| 3 | ;; Copyright (C) 2017 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Author: Tino Calacha <tino.calancha@gmail.com> | ||
| 6 | ;; Keywords: | ||
| 7 | |||
| 8 | ;; This file is part of GNU Emacs. | ||
| 9 | |||
| 10 | ;; GNU Emacs is free software: you can redistribute it and/or modify | ||
| 11 | ;; it under the terms of the GNU General Public License as published by | ||
| 12 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 13 | ;; (at your option) any later version. | ||
| 14 | |||
| 15 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 18 | ;; GNU General Public License for more details. | ||
| 19 | |||
| 20 | ;; You should have received a copy of the GNU General Public License | ||
| 21 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | ||
| 22 | |||
| 23 | ;;; Commentary: | ||
| 24 | |||
| 25 | |||
| 26 | ;;; Code: | ||
| 27 | (require 'ert) | ||
| 28 | (require 'cl-lib) | ||
| 29 | |||
| 30 | (ert-deftest register-test-bug27634 () | ||
| 31 | "Test for http://debbugs.gnu.org/27634 ." | ||
| 32 | (dolist (event (list ?\C-g 'escape ?\C-\[)) | ||
| 33 | (cl-letf (((symbol-function 'read-key) #'ignore) | ||
| 34 | (last-input-event event) | ||
| 35 | (register-alist nil)) | ||
| 36 | (should (equal 'quit | ||
| 37 | (condition-case err | ||
| 38 | (call-interactively 'point-to-register) | ||
| 39 | (quit (car err))))) | ||
| 40 | (should-not register-alist)))) | ||
| 41 | |||
| 42 | (provide 'register-tests) | ||
| 43 | ;;; register-tests.el ends here | ||
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index 7e50429a5bf..a59f0ca90e1 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el | |||
| @@ -292,31 +292,6 @@ cf. Bug#25477." | |||
| 292 | (should-error (eval '(dolist "foo") t) | 292 | (should-error (eval '(dolist "foo") t) |
| 293 | :type 'wrong-type-argument)) | 293 | :type 'wrong-type-argument)) |
| 294 | 294 | ||
| 295 | (require 'cl-generic) | ||
| 296 | (cl-defgeneric subr-tests--generic (x)) | ||
| 297 | (cl-defmethod subr-tests--generic ((x string)) | ||
| 298 | (message "%s is a string" x)) | ||
| 299 | (cl-defmethod subr-tests--generic ((x integer)) | ||
| 300 | (message "%s is a number" x)) | ||
| 301 | (cl-defgeneric subr-tests--generic-without-methods (x y)) | ||
| 302 | (defvar subr-tests--this-file | ||
| 303 | (file-truename (or load-file-name buffer-file-name))) | ||
| 304 | |||
| 305 | (ert-deftest subr-tests--method-files--finds-methods () | ||
| 306 | "`method-files' returns a list of files and methods for a generic function." | ||
| 307 | (let ((retval (method-files 'subr-tests--generic))) | ||
| 308 | (should (equal (length retval) 2)) | ||
| 309 | (mapc (lambda (x) | ||
| 310 | (should (equal (car x) subr-tests--this-file)) | ||
| 311 | (should (equal (cadr x) 'subr-tests--generic))) | ||
| 312 | retval) | ||
| 313 | (should-not (equal (nth 0 retval) (nth 1 retval))))) | ||
| 314 | |||
| 315 | (ert-deftest subr-tests--method-files--nonexistent-methods () | ||
| 316 | "`method-files' returns nil if asked to find a method which doesn't exist." | ||
| 317 | (should-not (method-files 'subr-tests--undefined-generic)) | ||
| 318 | (should-not (method-files 'subr-tests--generic-without-methods))) | ||
| 319 | |||
| 320 | (ert-deftest subr-tests-bug22027 () | 295 | (ert-deftest subr-tests-bug22027 () |
| 321 | "Test for http://debbugs.gnu.org/22027 ." | 296 | "Test for http://debbugs.gnu.org/22027 ." |
| 322 | (let ((default "foo") res) | 297 | (let ((default "foo") res) |