blob: 69331457c0ee9c9c9648ad024241879b26773d79 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
|
;;; dired-tests.el --- Test suite. -*- lexical-binding: t -*-
;; Copyright (C) 2015-2017 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Code:
(require 'ert)
(require 'dired)
(require 'nadvice)
(require 'ls-lisp)
(ert-deftest dired-autoload ()
"Tests to see whether dired-x has been autoloaded"
(should
(fboundp 'dired-jump))
(should
(autoloadp
(symbol-function
'dired-jump))))
(ert-deftest dired-test-bug22694 ()
"Test for http://debbugs.gnu.org/22694 ."
(let* ((dir (expand-file-name "bug22694" default-directory))
(file "test")
(full-name (expand-file-name file dir))
(regexp "bar")
(dired-always-read-filesystem t) buffers)
(if (file-exists-p dir)
(delete-directory dir 'recursive))
(make-directory dir)
(with-temp-file full-name (insert "foo"))
(push (find-file-noselect full-name) buffers)
(push (dired dir) buffers)
(with-temp-file full-name (insert "bar"))
(dired-mark-files-containing-regexp regexp)
(unwind-protect
(should (equal (dired-get-marked-files nil nil nil 'distinguish-1-mark)
`(t ,full-name)))
;; Clean up
(dolist (buf buffers)
(when (buffer-live-p buf) (kill-buffer buf)))
(delete-directory dir 'recursive))))
(ert-deftest dired-test-bug25609 ()
"Test for http://debbugs.gnu.org/25609 ."
(let* ((from (make-temp-file "foo" 'dir))
(to (make-temp-file "bar" 'dir))
(target (expand-file-name (file-name-nondirectory from) to))
(nested (expand-file-name (file-name-nondirectory from) target))
(dired-dwim-target t)
(dired-recursive-copies 'always) ; Don't prompt me.
buffers)
(advice-add 'dired-query ; Don't ask confirmation to overwrite a file.
:override
(lambda (_sym _prompt &rest _args) (setq dired-query t))
'((name . "advice-dired-query")))
(advice-add 'completing-read ; Just return init.
:override
(lambda (_prompt _coll &optional _pred _match init _hist _def _inherit _keymap)
init)
'((name . "advice-completing-read")))
(push (dired to) buffers)
(push (dired-other-window temporary-file-directory) buffers)
(dired-goto-file from)
(dired-do-copy)
(dired-do-copy); Again.
(unwind-protect
(progn
(should (file-exists-p target))
(should-not (file-exists-p nested)))
(dolist (buf buffers)
(when (buffer-live-p buf) (kill-buffer buf)))
(delete-directory from 'recursive)
(delete-directory to 'recursive)
(advice-remove 'dired-query "advice-dired-query")
(advice-remove 'completing-read "advice-completing-read"))))
(ert-deftest dired-test-bug27243 ()
"Test for http://debbugs.gnu.org/27243 ."
(let ((test-dir (make-temp-file "test-dir-" t))
(dired-auto-revert-buffer t) buffers)
(with-current-buffer (find-file-noselect test-dir)
(make-directory "test-subdir"))
(push (dired test-dir) buffers)
(unwind-protect
(let ((buf (current-buffer))
(pt1 (point))
(test-file (concat (file-name-as-directory "test-subdir")
"test-file")))
(write-region "Test" nil test-file nil 'silent nil 'excl)
;; Sanity check: point should now be on the subdirectory.
(should (equal (dired-file-name-at-point)
(concat (file-name-as-directory test-dir)
(file-name-as-directory "test-subdir"))))
(push (dired-find-file) buffers)
(let ((pt2 (point))) ; Point is on test-file.
(switch-to-buffer buf)
;; Sanity check: point should now be back on the subdirectory.
(should (eq (point) pt1))
;; Case 1: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27243#5
(push (dired-find-file) buffers)
(should (eq (point) pt2))
;; Case 2: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27243#28
(push (dired test-dir) buffers)
(should (eq (point) pt1))))
(dolist (buf buffers)
(when (buffer-live-p buf) (kill-buffer buf)))
(delete-directory test-dir t))))
(ert-deftest dired-test-bug27693 ()
"Test for http://debbugs.gnu.org/27693 ."
(let ((dir (expand-file-name "lisp" source-directory))
(size "")
ls-lisp-use-insert-directory-program buf)
(unwind-protect
(progn
(setq buf (dired (list dir "simple.el" "subr.el"))
size (number-to-string
(file-attribute-size
(file-attributes (dired-get-filename)))))
(search-backward-regexp size nil t)
(should (looking-back "[[:space:]]" (1- (point)))))
(when (buffer-live-p buf) (kill-buffer buf)))))
(ert-deftest dired-test-bug7131 ()
"Test for http://debbugs.gnu.org/7131 ."
(let* ((dir (expand-file-name "lisp" source-directory))
(buf (dired dir)))
(unwind-protect
(progn
(setq buf (dired (list dir "simple.el")))
(dired-toggle-marks)
(should-not (cdr (dired-get-marked-files)))
(kill-buffer buf)
(setq buf (dired (list dir "simple.el"))
buf (dired dir))
(dired-toggle-marks)
(should (cdr (dired-get-marked-files))))
(when (buffer-live-p buf) (kill-buffer buf)))))
(ert-deftest dired-test-bug27762 ()
"Test for http://debbugs.gnu.org/27762 ."
:expected-result :failed
(let* ((dir source-directory)
(default-directory dir)
(files (mapcar (lambda (f) (concat "src/" f))
(directory-files
(expand-file-name "src") nil "\\.*\\.c\\'")))
ls-lisp-use-insert-directory-program buf)
(unwind-protect
(let ((file1 "src/cygw32.c")
(file2 "src/atimer.c"))
(setq buf (dired (nconc (list dir) files)))
(dired-goto-file (expand-file-name file2 default-directory))
(should-not (looking-at "^ -")) ; Must be 2 spaces not 3.
(setq files (cons file1 (delete file1 files)))
(kill-buffer buf)
(setq buf (dired (nconc (list dir) files)))
(should (looking-at "src"))
(next-line) ; File names must be aligned.
(should (looking-at "src")))
(when (buffer-live-p buf) (kill-buffer buf)))))
(provide 'dired-tests)
;; dired-tests.el ends here
|
