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 | ||
88 | (defvar package-test-built-file-suffixes '(".tar" "/dir" "/*.info") | |
89 | "Remove these files when cleaning up a built package.") | |
90 | ||
91 | (cl-defmacro with-package-test ((&optional &key file | |
92 | basedir | |
93 | install | |
94 | update-news | |
95 | upload-base) | |
96 | &rest body) | |
97 | "Set up temporary locations and variables for testing." | |
98 | (declare (indent 1)) | |
99 | `(let* ((package-test-user-dir (make-temp-file "pkg-test-user-dir-" t)) | |
100 | (package-user-dir package-test-user-dir) | |
101 | (package-archives `(("gnu" . ,package-test-data-dir))) | |
102 | (old-yes-no-defn (symbol-function 'yes-or-no-p)) | |
103 | (old-pwd default-directory) | |
104 | package--initialized | |
105 | package-alist | |
106 | ,@(if update-news | |
107 | '(package-update-news-on-upload t) | |
108 | (list (cl-gensym))) | |
109 | ,@(if upload-base | |
110 | '((package-test-archive-upload-base (make-temp-file "pkg-archive-base-" t)) | |
111 | (package-archive-upload-base package-test-archive-upload-base)) | |
112 | (list (cl-gensym)))) ;; Dummy value so `let' doesn't try to bind `nil' | |
113 | (unwind-protect | |
114 | (progn | |
115 | ,(if basedir `(cd ,basedir)) | |
116 | (setf (symbol-function 'yes-or-no-p) #'(lambda (&rest r) t)) | |
117 | (unless (file-directory-p package-user-dir) | |
118 | (mkdir package-user-dir)) | |
119 | ,@(when install | |
120 | `((package-initialize) | |
121 | (package-refresh-contents) | |
122 | (mapc 'package-install ,install))) | |
123 | (with-temp-buffer | |
124 | ,(if file | |
125 | `(insert-file-contents ,file)) | |
126 | ,@body)) | |
127 | ||
128 | (when (file-directory-p package-test-user-dir) | |
129 | (delete-directory package-test-user-dir t)) | |
130 | ||
131 | (when (and (boundp 'package-test-archive-upload-base) | |
132 | (file-directory-p package-test-archive-upload-base)) | |
133 | (delete-directory package-test-archive-upload-base t)) | |
134 | (setf (symbol-function 'yes-or-no-p) old-yes-no-defn) | |
135 | (cd old-pwd)))) | |
136 | ||
137 | (defmacro with-fake-help-buffer (&rest body) | |
138 | "Execute BODY in a temp buffer which is treated as the \"*Help*\" buffer." | |
139 | `(with-temp-buffer | |
140 | (help-mode) | |
141 | ;; Trick `help-buffer' into using the temp buffer. | |
142 | (let ((help-xref-following t)) | |
143 | ,@body))) | |
144 | ||
145 | (defun package-test-install-texinfo (file) | |
146 | "Install from texinfo FILE. | |
147 | ||
148 | FILE should be a .texinfo file relative to the current | |
149 | `default-directory'" | |
150 | (require 'info) | |
151 | (let* ((full-file (expand-file-name file)) | |
152 | (info-file (replace-regexp-in-string "\\.texi\\'" ".info" full-file)) | |
153 | (old-info-defn (symbol-function 'Info-revert-find-node))) | |
154 | (require 'info) | |
155 | (setf (symbol-function 'Info-revert-find-node) #'ignore) | |
156 | (with-current-buffer (find-file-literally full-file) | |
157 | (unwind-protect | |
158 | (progn | |
159 | (require 'makeinfo) | |
160 | (makeinfo-buffer) | |
161 | ;; Give `makeinfo-buffer' a chance to finish | |
162 | (while compilation-in-progress | |
163 | (sit-for 0.1)) | |
164 | (call-process "ginstall-info" nil nil nil | |
165 | (format "--info-dir=%s" default-directory) | |
166 | (format "%s" info-file))) | |
167 | (kill-buffer) | |
168 | (setf (symbol-function 'Info-revert-find-node) old-info-defn))))) | |
169 | ||
170 | (defun package-test-strip-version (dir) | |
171 | (replace-regexp-in-string "-pkg\\.el\\'" "" (package--description-file dir))) | |
172 | ||
173 | (defun package-test-suffix-matches (base suffix-list) | |
174 | "Return file names matching BASE concatenated with each item in SUFFIX-LIST" | |
175 | (cl-mapcan | |
176 | '(lambda (item) (file-expand-wildcards (concat base item))) | |
177 | suffix-list)) | |
178 | ||
179 | (defun package-test-cleanup-built-files (dir) | |
180 | "Remove files which were the result of creating a tar archive. | |
181 | ||
182 | DIR is the base name of the package directory, without the trailing slash" | |
183 | (let* ((pkg-dirname (file-name-nondirectory dir))) | |
184 | (dolist (file (package-test-suffix-matches dir package-test-built-file-suffixes)) | |
185 | (delete-file file)))) | |
186 | ||
187 | (defun package-test-search-tar-file (filename) | |
188 | "Search the current buffer's `tar-parse-info' variable for FILENAME. | |
189 | ||
190 | Must called from within a `tar-mode' buffer." | |
191 | (cl-dolist (header tar-parse-info) | |
192 | (let ((tar-name (tar-header-name header))) | |
193 | (when (string= tar-name filename) | |
194 | (cl-return t))))) | |
195 | ||
196 | (defun package-test-desc-version-string (desc) | |
197 | "Return the package version as a string." | |
198 | (package-version-join (package-desc-version desc))) | |
199 | ||
200 | (ert-deftest package-test-desc-from-buffer () | |
201 | "Parse an elisp buffer to get a `package-desc' object." | |
202 | (with-package-test (:basedir "data/package" :file "simple-single-1.3.el") | |
203 | (should (equal (package-buffer-info) simple-single-desc))) | |
204 | (with-package-test (:basedir "data/package" :file "simple-depend-1.0.el") | |
205 | (should (equal (package-buffer-info) simple-depend-desc))) | |
206 | (with-package-test (:basedir "data/package" | |
207 | :file "multi-file-0.2.3.tar") | |
208 | (tar-mode) | |
209 | (should (equal (package-tar-file-info) multi-file-desc)))) | |
210 | ||
211 | (ert-deftest package-test-install-single () | |
212 | "Install a single file without using an archive." | |
213 | (with-package-test (:basedir "data/package" :file "simple-single-1.3.el") | |
214 | (should (package-install-from-buffer)) | |
215 | (package-initialize) | |
216 | (should (package-installed-p 'simple-single)) | |
217 | (let* ((simple-pkg-dir (file-name-as-directory | |
218 | (expand-file-name | |
219 | "simple-single-1.3" | |
220 | package-test-user-dir))) | |
221 | (autoloads-file (expand-file-name "simple-single-autoloads.el" | |
222 | simple-pkg-dir))) | |
223 | (should (file-directory-p simple-pkg-dir)) | |
224 | (with-temp-buffer | |
225 | (insert-file-contents (expand-file-name "simple-single-pkg.el" | |
226 | simple-pkg-dir)) | |
227 | (should (string= (buffer-string) | |
228 | (concat "(define-package \"simple-single\" \"1.3\" " | |
229 | "\"A single-file package " | |
230 | "with no dependencies\" 'nil)\n")))) | |
231 | (should (file-exists-p autoloads-file)) | |
232 | (should-not (get-file-buffer autoloads-file))))) | |
233 | ||
234 | (ert-deftest package-test-install-dependency () | |
235 | "Install a package which includes a dependency." | |
236 | (with-package-test () | |
237 | (package-initialize) | |
238 | (package-refresh-contents) | |
239 | (package-install 'simple-depend) | |
240 | (should (package-installed-p 'simple-single)) | |
241 | (should (package-installed-p 'simple-depend)))) | |
242 | ||
243 | (ert-deftest package-test-refresh-contents () | |
244 | "Parse an \"archive-contents\" file." | |
245 | (with-package-test () | |
246 | (package-initialize) | |
247 | (package-refresh-contents) | |
248 | (should (eq 3 (length package-archive-contents))))) | |
249 | ||
250 | (ert-deftest package-test-install-single-from-archive () | |
251 | "Install a single package from a package archive." | |
252 | (with-package-test () | |
253 | (package-initialize) | |
254 | (package-refresh-contents) | |
255 | (package-install 'simple-single))) | |
256 | ||
257 | (ert-deftest package-test-install-multifile () | |
258 | "Check properties of the installed multi-file package." | |
259 | (with-package-test (:basedir "data/package" :install '(multi-file)) | |
260 | (let ((autoload-file | |
261 | (expand-file-name "multi-file-autoloads.el" | |
262 | (expand-file-name | |
263 | "multi-file-0.2.3" | |
264 | package-test-user-dir))) | |
265 | (installed-files '("dir" "multi-file.info" "multi-file-sub.elc" | |
266 | "multi-file-autoloads.el" "multi-file.elc")) | |
267 | (autoload-forms '("^(defvar multi-file-custom-var" | |
268 | "^(custom-autoload 'multi-file-custom-var" | |
269 | "^(autoload 'multi-file-mode")) | |
270 | (pkg-dir (file-name-as-directory | |
271 | (expand-file-name | |
272 | "multi-file-0.2.3" | |
273 | package-test-user-dir)))) | |
274 | (package-refresh-contents) | |
275 | (should (package-installed-p 'multi-file)) | |
276 | (with-temp-buffer | |
277 | (insert-file-contents-literally autoload-file) | |
278 | (dolist (fn installed-files) | |
279 | (should (file-exists-p (expand-file-name fn pkg-dir)))) | |
280 | (dolist (re autoload-forms) | |
281 | (goto-char (point-min)) | |
282 | (should (re-search-forward re nil t))))))) | |
283 | ||
284 | (ert-deftest package-test-update-listing () | |
285 | "Ensure installed package status is updated." | |
286 | (with-package-test () | |
287 | (let ((buf (package-list-packages))) | |
288 | (search-forward-regexp "^ +simple-single") | |
289 | (package-menu-mark-install) | |
290 | (package-menu-execute) | |
291 | (should (package-installed-p 'simple-single)) | |
292 | (switch-to-buffer "*Packages*") | |
293 | (goto-char (point-min)) | |
294 | (should (re-search-forward "^\\s-+simple-single\\s-+1.3\\s-+installed" nil t)) | |
295 | (goto-char (point-min)) | |
296 | (should-not (re-search-forward "^\\s-+simple-single\\s-+1.3\\s-+\\(available\\|new\\)" nil t)) | |
297 | (kill-buffer buf)))) | |
298 | ||
299 | (ert-deftest package-test-update-archives () | |
300 | "Test updating package archives." | |
301 | (with-package-test () | |
302 | (let ((buf (package-list-packages))) | |
303 | (package-menu-refresh) | |
304 | (search-forward-regexp "^ +simple-single") | |
305 | (package-menu-mark-install) | |
306 | (package-menu-execute) | |
307 | (should (package-installed-p 'simple-single)) | |
308 | (let ((package-test-data-dir | |
309 | (expand-file-name "data/package/newer-versions" package-test-file-dir))) | |
310 | (setq package-archives `(("gnu" . ,package-test-data-dir))) | |
311 | (package-menu-refresh) | |
312 | ||
313 | ;; New version should be available and old version should be installed | |
314 | (goto-char (point-min)) | |
315 | (should (re-search-forward "^\\s-+simple-single\\s-+1.4\\s-+new" nil t)) | |
316 | (should (re-search-forward "^\\s-+simple-single\\s-+1.3\\s-+installed" nil t)) | |
317 | ||
318 | (goto-char (point-min)) | |
319 | (should (re-search-forward "^\\s-+new-pkg\\s-+1.0\\s-+\\(available\\|new\\)" nil t)) | |
320 | ||
321 | (package-menu-mark-upgrades) | |
322 | (package-menu-execute) | |
323 | (package-menu-refresh) | |
324 | (should (package-installed-p 'simple-single '(1 4))))))) | |
325 | ||
326 | (ert-deftest package-test-describe-package () | |
327 | "Test displaying help for a package." | |
328 | ||
329 | (require 'finder-inf) | |
330 | ;; Built-in | |
331 | (with-fake-help-buffer | |
332 | (describe-package '5x5) | |
333 | (goto-char (point-min)) | |
334 | (should (search-forward "5x5 is a built-in package." nil t)) | |
335 | (should (search-forward "Status: Built-in." nil t)) | |
336 | (should (search-forward "Summary: simple little puzzle game" nil t)) | |
337 | (should (search-forward "The aim of 5x5" nil t))) | |
338 | ||
339 | ;; Installed | |
340 | (with-package-test () | |
341 | (package-initialize) | |
342 | (package-refresh-contents) | |
343 | (package-install 'simple-single) | |
344 | (with-fake-help-buffer | |
345 | (describe-package 'simple-single) | |
346 | (goto-char (point-min)) | |
347 | (should (search-forward "simple-single is an installed package." nil t)) | |
348 | (should (search-forward | |
349 | (format "Status: Installed in `%s/'." | |
350 | (expand-file-name "simple-single-1.3" package-user-dir)) | |
351 | nil t)) | |
352 | (should (search-forward "Version: 1.3" nil t)) | |
353 | (should (search-forward "Summary: A single-file package with no dependencies" | |
354 | nil t)) | |
355 | ;; No description, though. Because at this point we don't know | |
356 | ;; what archive the package originated from, and we don't have | |
357 | ;; its readme file saved. | |
358 | ))) | |
359 | ||
360 | (ert-deftest package-test-describe-not-installed-package () | |
361 | "Test displaying of the readme for not-installed package." | |
362 | ||
363 | (with-package-test () | |
364 | (package-initialize) | |
365 | (package-refresh-contents) | |
366 | (with-fake-help-buffer | |
367 | (describe-package 'simple-single) | |
368 | (goto-char (point-min)) | |
369 | (should (search-forward "This package provides a minor mode to frobnicate" | |
370 | nil t))))) | |
371 | ||
372 | (ert-deftest package-test-describe-non-installed-package () | |
373 | "Test displaying of the readme for non-installed package." | |
374 | ||
375 | (with-package-test () | |
376 | (package-initialize) | |
377 | (package-refresh-contents) | |
378 | (with-fake-help-buffer | |
379 | (describe-package 'simple-single) | |
380 | (goto-char (point-min)) | |
381 | (should (search-forward "This package provides a minor mode to frobnicate" | |
382 | nil t))))) | |
383 | ||
384 | (ert-deftest package-test-describe-non-installed-multi-file-package () | |
385 | "Test displaying of the readme for non-installed multi-file package." | |
386 | ||
387 | (with-package-test () | |
388 | (package-initialize) | |
389 | (package-refresh-contents) | |
390 | (with-fake-help-buffer | |
391 | (describe-package 'multi-file) | |
392 | (goto-char (point-min)) | |
393 | (should (search-forward "This is a bare-bones readme file for the multi-file" | |
394 | nil t))))) | |
395 | ||
396 | (provide 'package-test) | |
397 | ||
398 | ;;; package-test.el ends here |