aboutsummaryrefslogtreecommitdiffstats
path: root/test/lisp
diff options
context:
space:
mode:
Diffstat (limited to 'test/lisp')
-rw-r--r--test/lisp/auth-source-tests.el2
-rw-r--r--test/lisp/dired-tests.el179
-rw-r--r--test/lisp/emacs-lisp/cl-generic-tests.el24
-rw-r--r--test/lisp/emacs-lisp/ert-tests.el2
-rw-r--r--test/lisp/emacs-lisp/rx-tests.el10
-rw-r--r--test/lisp/ls-lisp.el37
-rw-r--r--test/lisp/net/tramp-tests.el137
-rw-r--r--test/lisp/register-tests.el43
-rw-r--r--test/lisp/subr-tests.el25
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'.
2206This tests also `file-readable-p', `file-regular-p' and 2309This 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)