Commit | Line | Data |
---|---|---|
9ea5cf9f DG |
1 | ;;; package-test.el --- Tests for the Emacs package system |
2 | ||
9c8d35d5 GM |
3 | ;; Copyright (C) 2013 Free Software Foundation, Inc. |
4 | ||
9ea5cf9f DG |
5 | ;; Author: Daniel Hackney <dan@haxney.org> |
6 | ;; Version: 1.0 | |
7 | ||
8 | ;; This file is part of GNU Emacs. | |
9 | ||
9c8d35d5 | 10 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
9ea5cf9f | 11 | ;; it under the terms of the GNU General Public License as published by |
9c8d35d5 GM |
12 | ;; the Free Software Foundation, either version 3 of the License, or |
13 | ;; (at your option) any later version. | |
9ea5cf9f DG |
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 | |
9c8d35d5 | 21 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
9ea5cf9f DG |
22 | |
23 | ;;; Commentary: | |
24 | ||
25 | ;; You may want to run this from a separate Emacs instance from your | |
26 | ;; main one, because a bug in the code below could mess with your | |
27 | ;; installed packages. | |
28 | ||
29 | ;; Run this in a clean Emacs session using: | |
30 | ;; | |
31 | ;; $ emacs -Q --batch -L . -l package-test.el -l ert -f ert-run-tests-batch-and-exit | |
32 | ||
33 | ;;; Code: | |
34 | ||
35 | (require 'package) | |
36 | (require 'ert) | |
37 | (require 'cl-lib) | |
38 | ||
39 | (defvar package-test-user-dir nil | |
40 | "Directory to use for installing packages during testing.") | |
41 | ||
42 | (defvar package-test-file-dir (file-name-directory (or load-file-name | |
43 | buffer-file-name)) | |
44 | "Directory of the actual \"package-test.el\" file.") | |
45 | ||
46 | (defvar simple-single-desc | |
47 | (package-desc-create :name 'simple-single | |
48 | :version '(1 3) | |
49 | :summary "A single-file package with no dependencies" | |
50 | :kind 'single) | |
51 | "Expected `package-desc' parsed from simple-single-1.3.el.") | |
52 | ||
53 | (defvar simple-single-desc-1-4 | |
54 | (package-desc-create :name 'simple-single | |
55 | :version '(1 4) | |
56 | :summary "A single-file package with no dependencies" | |
57 | :kind 'single) | |
58 | "Expected `package-desc' parsed from simple-single-1.4.el.") | |
59 | ||
60 | (defvar simple-depend-desc | |
61 | (package-desc-create :name 'simple-depend | |
62 | :version '(1 0) | |
63 | :summary "A single-file package with a dependency." | |
64 | :kind 'single | |
65 | :reqs '((simple-single (1 3)))) | |
66 | "Expected `package-desc' parsed from simple-depend-1.0.el.") | |
67 | ||
68 | (defvar multi-file-desc | |
69 | (package-desc-create :name 'multi-file | |
70 | :version '(0 2 3) | |
71 | :summary "Example of a multi-file tar package" | |
72 | :kind 'tar) | |
73 | "Expected `package-desc' from \"multi-file-0.2.3.tar\".") | |
74 | ||
75 | (defvar new-pkg-desc | |
76 | (package-desc-create :name 'new-pkg | |
77 | :version '(1 0) | |
78 | :kind 'single) | |
79 | "Expected `package-desc' parsed from new-pkg-1.0.el.") | |
80 | ||
81 | (defvar package-test-data-dir (expand-file-name "data/package" package-test-file-dir) | |
82 | "Base directory of package test files.") | |
83 | ||
84 | (defvar package-test-fake-contents-file | |
85 | (expand-file-name "archive-contents" package-test-data-dir) | |
86 | "Path to a static copy of \"archive-contents\".") | |
87 | ||
9ea5cf9f DG |
88 | (cl-defmacro with-package-test ((&optional &key file |
89 | basedir | |
90 | install | |
91 | update-news | |
92 | upload-base) | |
93 | &rest body) | |
94 | "Set up temporary locations and variables for testing." | |
95 | (declare (indent 1)) | |
96 | `(let* ((package-test-user-dir (make-temp-file "pkg-test-user-dir-" t)) | |
97 | (package-user-dir package-test-user-dir) | |
98 | (package-archives `(("gnu" . ,package-test-data-dir))) | |
99 | (old-yes-no-defn (symbol-function 'yes-or-no-p)) | |
100 | (old-pwd default-directory) | |
101 | package--initialized | |
102 | package-alist | |
103 | ,@(if update-news | |
104 | '(package-update-news-on-upload t) | |
105 | (list (cl-gensym))) | |
106 | ,@(if upload-base | |
107 | '((package-test-archive-upload-base (make-temp-file "pkg-archive-base-" t)) | |
108 | (package-archive-upload-base package-test-archive-upload-base)) | |
109 | (list (cl-gensym)))) ;; Dummy value so `let' doesn't try to bind `nil' | |
110 | (unwind-protect | |
111 | (progn | |
112 | ,(if basedir `(cd ,basedir)) | |
113 | (setf (symbol-function 'yes-or-no-p) #'(lambda (&rest r) t)) | |
114 | (unless (file-directory-p package-user-dir) | |
115 | (mkdir package-user-dir)) | |
116 | ,@(when install | |
117 | `((package-initialize) | |
118 | (package-refresh-contents) | |
119 | (mapc 'package-install ,install))) | |
120 | (with-temp-buffer | |
121 | ,(if file | |
122 | `(insert-file-contents ,file)) | |
123 | ,@body)) | |
124 | ||
125 | (when (file-directory-p package-test-user-dir) | |
126 | (delete-directory package-test-user-dir t)) | |
127 | ||
128 | (when (and (boundp 'package-test-archive-upload-base) | |
129 | (file-directory-p package-test-archive-upload-base)) | |
130 | (delete-directory package-test-archive-upload-base t)) | |
131 | (setf (symbol-function 'yes-or-no-p) old-yes-no-defn) | |
132 | (cd old-pwd)))) | |
133 | ||
134 | (defmacro with-fake-help-buffer (&rest body) | |
135 | "Execute BODY in a temp buffer which is treated as the \"*Help*\" buffer." | |
136 | `(with-temp-buffer | |
137 | (help-mode) | |
138 | ;; Trick `help-buffer' into using the temp buffer. | |
139 | (let ((help-xref-following t)) | |
140 | ,@body))) | |
141 | ||
9ea5cf9f DG |
142 | (defun package-test-strip-version (dir) |
143 | (replace-regexp-in-string "-pkg\\.el\\'" "" (package--description-file dir))) | |
144 | ||
145 | (defun package-test-suffix-matches (base suffix-list) | |
146 | "Return file names matching BASE concatenated with each item in SUFFIX-LIST" | |
147 | (cl-mapcan | |
148 | '(lambda (item) (file-expand-wildcards (concat base item))) | |
149 | suffix-list)) | |
150 | ||
03d01981 GM |
151 | (defvar tar-parse-info) |
152 | (declare-function tar-header-name "tar-mode" (cl-x) t) ; defstruct | |
153 | ||
9ea5cf9f DG |
154 | (defun package-test-search-tar-file (filename) |
155 | "Search the current buffer's `tar-parse-info' variable for FILENAME. | |
156 | ||
157 | Must called from within a `tar-mode' buffer." | |
158 | (cl-dolist (header tar-parse-info) | |
159 | (let ((tar-name (tar-header-name header))) | |
160 | (when (string= tar-name filename) | |
161 | (cl-return t))))) | |
162 | ||
163 | (defun package-test-desc-version-string (desc) | |
164 | "Return the package version as a string." | |
165 | (package-version-join (package-desc-version desc))) | |
166 | ||
167 | (ert-deftest package-test-desc-from-buffer () | |
168 | "Parse an elisp buffer to get a `package-desc' object." | |
169 | (with-package-test (:basedir "data/package" :file "simple-single-1.3.el") | |
170 | (should (equal (package-buffer-info) simple-single-desc))) | |
171 | (with-package-test (:basedir "data/package" :file "simple-depend-1.0.el") | |
172 | (should (equal (package-buffer-info) simple-depend-desc))) | |
173 | (with-package-test (:basedir "data/package" | |
174 | :file "multi-file-0.2.3.tar") | |
175 | (tar-mode) | |
176 | (should (equal (package-tar-file-info) multi-file-desc)))) | |
177 | ||
178 | (ert-deftest package-test-install-single () | |
179 | "Install a single file without using an archive." | |
180 | (with-package-test (:basedir "data/package" :file "simple-single-1.3.el") | |
181 | (should (package-install-from-buffer)) | |
182 | (package-initialize) | |
183 | (should (package-installed-p 'simple-single)) | |
184 | (let* ((simple-pkg-dir (file-name-as-directory | |
185 | (expand-file-name | |
186 | "simple-single-1.3" | |
187 | package-test-user-dir))) | |
188 | (autoloads-file (expand-file-name "simple-single-autoloads.el" | |
189 | simple-pkg-dir))) | |
190 | (should (file-directory-p simple-pkg-dir)) | |
191 | (with-temp-buffer | |
192 | (insert-file-contents (expand-file-name "simple-single-pkg.el" | |
193 | simple-pkg-dir)) | |
194 | (should (string= (buffer-string) | |
195 | (concat "(define-package \"simple-single\" \"1.3\" " | |
196 | "\"A single-file package " | |
197 | "with no dependencies\" 'nil)\n")))) | |
198 | (should (file-exists-p autoloads-file)) | |
199 | (should-not (get-file-buffer autoloads-file))))) | |
200 | ||
201 | (ert-deftest package-test-install-dependency () | |
202 | "Install a package which includes a dependency." | |
203 | (with-package-test () | |
204 | (package-initialize) | |
205 | (package-refresh-contents) | |
206 | (package-install 'simple-depend) | |
207 | (should (package-installed-p 'simple-single)) | |
208 | (should (package-installed-p 'simple-depend)))) | |
209 | ||
210 | (ert-deftest package-test-refresh-contents () | |
211 | "Parse an \"archive-contents\" file." | |
212 | (with-package-test () | |
213 | (package-initialize) | |
214 | (package-refresh-contents) | |
215 | (should (eq 3 (length package-archive-contents))))) | |
216 | ||
217 | (ert-deftest package-test-install-single-from-archive () | |
218 | "Install a single package from a package archive." | |
219 | (with-package-test () | |
220 | (package-initialize) | |
221 | (package-refresh-contents) | |
222 | (package-install 'simple-single))) | |
223 | ||
224 | (ert-deftest package-test-install-multifile () | |
225 | "Check properties of the installed multi-file package." | |
226 | (with-package-test (:basedir "data/package" :install '(multi-file)) | |
227 | (let ((autoload-file | |
228 | (expand-file-name "multi-file-autoloads.el" | |
229 | (expand-file-name | |
230 | "multi-file-0.2.3" | |
231 | package-test-user-dir))) | |
232 | (installed-files '("dir" "multi-file.info" "multi-file-sub.elc" | |
233 | "multi-file-autoloads.el" "multi-file.elc")) | |
234 | (autoload-forms '("^(defvar multi-file-custom-var" | |
235 | "^(custom-autoload 'multi-file-custom-var" | |
236 | "^(autoload 'multi-file-mode")) | |
237 | (pkg-dir (file-name-as-directory | |
238 | (expand-file-name | |
239 | "multi-file-0.2.3" | |
240 | package-test-user-dir)))) | |
241 | (package-refresh-contents) | |
242 | (should (package-installed-p 'multi-file)) | |
243 | (with-temp-buffer | |
244 | (insert-file-contents-literally autoload-file) | |
245 | (dolist (fn installed-files) | |
246 | (should (file-exists-p (expand-file-name fn pkg-dir)))) | |
247 | (dolist (re autoload-forms) | |
248 | (goto-char (point-min)) | |
249 | (should (re-search-forward re nil t))))))) | |
250 | ||
251 | (ert-deftest package-test-update-listing () | |
252 | "Ensure installed package status is updated." | |
253 | (with-package-test () | |
254 | (let ((buf (package-list-packages))) | |
255 | (search-forward-regexp "^ +simple-single") | |
256 | (package-menu-mark-install) | |
257 | (package-menu-execute) | |
258 | (should (package-installed-p 'simple-single)) | |
259 | (switch-to-buffer "*Packages*") | |
260 | (goto-char (point-min)) | |
261 | (should (re-search-forward "^\\s-+simple-single\\s-+1.3\\s-+installed" nil t)) | |
262 | (goto-char (point-min)) | |
263 | (should-not (re-search-forward "^\\s-+simple-single\\s-+1.3\\s-+\\(available\\|new\\)" nil t)) | |
264 | (kill-buffer buf)))) | |
265 | ||
266 | (ert-deftest package-test-update-archives () | |
267 | "Test updating package archives." | |
268 | (with-package-test () | |
269 | (let ((buf (package-list-packages))) | |
270 | (package-menu-refresh) | |
271 | (search-forward-regexp "^ +simple-single") | |
272 | (package-menu-mark-install) | |
273 | (package-menu-execute) | |
274 | (should (package-installed-p 'simple-single)) | |
275 | (let ((package-test-data-dir | |
276 | (expand-file-name "data/package/newer-versions" package-test-file-dir))) | |
277 | (setq package-archives `(("gnu" . ,package-test-data-dir))) | |
278 | (package-menu-refresh) | |
279 | ||
280 | ;; New version should be available and old version should be installed | |
281 | (goto-char (point-min)) | |
282 | (should (re-search-forward "^\\s-+simple-single\\s-+1.4\\s-+new" nil t)) | |
283 | (should (re-search-forward "^\\s-+simple-single\\s-+1.3\\s-+installed" nil t)) | |
284 | ||
285 | (goto-char (point-min)) | |
286 | (should (re-search-forward "^\\s-+new-pkg\\s-+1.0\\s-+\\(available\\|new\\)" nil t)) | |
287 | ||
288 | (package-menu-mark-upgrades) | |
289 | (package-menu-execute) | |
290 | (package-menu-refresh) | |
291 | (should (package-installed-p 'simple-single '(1 4))))))) | |
292 | ||
293 | (ert-deftest package-test-describe-package () | |
294 | "Test displaying help for a package." | |
295 | ||
296 | (require 'finder-inf) | |
297 | ;; Built-in | |
298 | (with-fake-help-buffer | |
299 | (describe-package '5x5) | |
300 | (goto-char (point-min)) | |
301 | (should (search-forward "5x5 is a built-in package." nil t)) | |
302 | (should (search-forward "Status: Built-in." nil t)) | |
303 | (should (search-forward "Summary: simple little puzzle game" nil t)) | |
304 | (should (search-forward "The aim of 5x5" nil t))) | |
305 | ||
306 | ;; Installed | |
307 | (with-package-test () | |
308 | (package-initialize) | |
309 | (package-refresh-contents) | |
310 | (package-install 'simple-single) | |
311 | (with-fake-help-buffer | |
312 | (describe-package 'simple-single) | |
313 | (goto-char (point-min)) | |
314 | (should (search-forward "simple-single is an installed package." nil t)) | |
315 | (should (search-forward | |
316 | (format "Status: Installed in `%s/'." | |
317 | (expand-file-name "simple-single-1.3" package-user-dir)) | |
318 | nil t)) | |
319 | (should (search-forward "Version: 1.3" nil t)) | |
320 | (should (search-forward "Summary: A single-file package with no dependencies" | |
321 | nil t)) | |
322 | ;; No description, though. Because at this point we don't know | |
323 | ;; what archive the package originated from, and we don't have | |
324 | ;; its readme file saved. | |
325 | ))) | |
326 | ||
327 | (ert-deftest package-test-describe-not-installed-package () | |
328 | "Test displaying of the readme for not-installed package." | |
329 | ||
330 | (with-package-test () | |
331 | (package-initialize) | |
332 | (package-refresh-contents) | |
333 | (with-fake-help-buffer | |
334 | (describe-package 'simple-single) | |
335 | (goto-char (point-min)) | |
336 | (should (search-forward "This package provides a minor mode to frobnicate" | |
337 | nil t))))) | |
338 | ||
339 | (ert-deftest package-test-describe-non-installed-package () | |
340 | "Test displaying of the readme for non-installed package." | |
341 | ||
342 | (with-package-test () | |
343 | (package-initialize) | |
344 | (package-refresh-contents) | |
345 | (with-fake-help-buffer | |
346 | (describe-package 'simple-single) | |
347 | (goto-char (point-min)) | |
348 | (should (search-forward "This package provides a minor mode to frobnicate" | |
349 | nil t))))) | |
350 | ||
351 | (ert-deftest package-test-describe-non-installed-multi-file-package () | |
352 | "Test displaying of the readme for non-installed multi-file package." | |
353 | ||
354 | (with-package-test () | |
355 | (package-initialize) | |
356 | (package-refresh-contents) | |
357 | (with-fake-help-buffer | |
358 | (describe-package 'multi-file) | |
359 | (goto-char (point-min)) | |
360 | (should (search-forward "This is a bare-bones readme file for the multi-file" | |
361 | nil t))))) | |
362 | ||
363 | (provide 'package-test) | |
364 | ||
365 | ;;; package-test.el ends here |