]> code.delx.au - gnu-emacs/blob - test/automated/package-test.el
* lisp/emacs-lisp/package.el (package-buffer-info):
[gnu-emacs] / test / automated / package-test.el
1 ;;; package-test.el --- Tests for the Emacs package system
2
3 ;; Copyright (C) 2013-2015 Free Software Foundation, Inc.
4
5 ;; Author: Daniel Hackney <dan@haxney.org>
6 ;; Version: 1.0
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 ;; 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 (setq package-menu-async nil)
40
41 (defvar package-test-user-dir nil
42 "Directory to use for installing packages during testing.")
43
44 (defvar package-test-file-dir (file-name-directory (or load-file-name
45 buffer-file-name))
46 "Directory of the actual \"package-test.el\" file.")
47
48 (defvar simple-single-desc
49 (package-desc-create :name 'simple-single
50 :version '(1 3)
51 :summary "A single-file package with no dependencies"
52 :kind 'single
53 :extras '((:authors ("J. R. Hacker" . "jrh@example.com"))
54 (:maintainer "J. R. Hacker" . "jrh@example.com")
55 (:url . "http://doodles.au")))
56 "Expected `package-desc' parsed from simple-single-1.3.el.")
57
58 (defvar simple-depend-desc
59 (package-desc-create :name 'simple-depend
60 :version '(1 0)
61 :summary "A single-file package with a dependency."
62 :kind 'single
63 :reqs '((simple-single (1 3)))
64 :extras '((:authors ("J. R. Hacker" . "jrh@example.com"))
65 (:maintainer "J. R. Hacker" . "jrh@example.com")))
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 :extras '((:url . "http://puddles.li")))
74 "Expected `package-desc' from \"multi-file-0.2.3.tar\".")
75
76 (defvar new-pkg-desc
77 (package-desc-create :name 'new-pkg
78 :version '(1 0)
79 :kind 'single)
80 "Expected `package-desc' parsed from new-pkg-1.0.el.")
81
82 (defvar simple-depend-desc-1
83 (package-desc-create :name 'simple-depend-1
84 :version '(1 0)
85 :summary "A single-file package with a dependency."
86 :kind 'single
87 :reqs '((simple-depend (1 0))
88 (multi-file (0 1))))
89 "`package-desc' used for testing dependencies.")
90
91 (defvar simple-depend-desc-2
92 (package-desc-create :name 'simple-depend-2
93 :version '(1 0)
94 :summary "A single-file package with a dependency."
95 :kind 'single
96 :reqs '((simple-depend-1 (1 0))
97 (multi-file (0 1))))
98 "`package-desc' used for testing dependencies.")
99
100 (defvar package-test-data-dir (expand-file-name "data/package" package-test-file-dir)
101 "Base directory of package test files.")
102
103 (defvar package-test-fake-contents-file
104 (expand-file-name "archive-contents" package-test-data-dir)
105 "Path to a static copy of \"archive-contents\".")
106
107 (cl-defmacro with-package-test ((&optional &key file
108 basedir
109 install
110 location
111 update-news
112 upload-base)
113 &rest body)
114 "Set up temporary locations and variables for testing."
115 (declare (indent 1))
116 `(let* ((package-test-user-dir (make-temp-file "pkg-test-user-dir-" t))
117 (process-environment (cons (format "HOME=%s" package-test-user-dir)
118 process-environment))
119 (package-user-dir package-test-user-dir)
120 (package-archives `(("gnu" . ,(or ,location package-test-data-dir))))
121 (default-directory package-test-file-dir)
122 abbreviated-home-dir
123 package--initialized
124 package-alist
125 ,@(if update-news
126 '(package-update-news-on-upload t)
127 (list (cl-gensym)))
128 ,@(if upload-base
129 '((package-test-archive-upload-base (make-temp-file "pkg-archive-base-" t))
130 (package-archive-upload-base package-test-archive-upload-base))
131 (list (cl-gensym)))) ;; Dummy value so `let' doesn't try to bind nil
132 (let ((buf (get-buffer "*Packages*")))
133 (when (buffer-live-p buf)
134 (kill-buffer buf)))
135 (unwind-protect
136 (progn
137 ,(if basedir `(cd ,basedir))
138 (unless (file-directory-p package-user-dir)
139 (mkdir package-user-dir))
140 (cl-letf (((symbol-function 'yes-or-no-p) (lambda (&rest r) t))
141 ((symbol-function 'y-or-n-p) (lambda (&rest r) t)))
142 ,@(when install
143 `((package-initialize)
144 (package-refresh-contents)
145 (mapc 'package-install ,install)))
146 (with-temp-buffer
147 ,(if file
148 `(insert-file-contents ,file))
149 ,@body)))
150
151 (when (file-directory-p package-test-user-dir)
152 (delete-directory package-test-user-dir t))
153
154 (when (and (boundp 'package-test-archive-upload-base)
155 (file-directory-p package-test-archive-upload-base))
156 (delete-directory package-test-archive-upload-base t)))))
157
158 (defmacro with-fake-help-buffer (&rest body)
159 "Execute BODY in a temp buffer which is treated as the \"*Help*\" buffer."
160 `(with-temp-buffer
161 (help-mode)
162 ;; Trick `help-buffer' into using the temp buffer.
163 (let ((help-xref-following t))
164 ,@body)))
165
166 (defun package-test-strip-version (dir)
167 (replace-regexp-in-string "-pkg\\.el\\'" "" (package--description-file dir)))
168
169 (defun package-test-suffix-matches (base suffix-list)
170 "Return file names matching BASE concatenated with each item in SUFFIX-LIST"
171 (cl-mapcan
172 '(lambda (item) (file-expand-wildcards (concat base item)))
173 suffix-list))
174
175 (defvar tar-parse-info)
176 (declare-function tar-header-name "tar-mode" (cl-x) t) ; defstruct
177
178 (defun package-test-search-tar-file (filename)
179 "Search the current buffer's `tar-parse-info' variable for FILENAME.
180
181 Must called from within a `tar-mode' buffer."
182 (cl-dolist (header tar-parse-info)
183 (let ((tar-name (tar-header-name header)))
184 (when (string= tar-name filename)
185 (cl-return t)))))
186
187 (defun package-test-desc-version-string (desc)
188 "Return the package version as a string."
189 (package-version-join (package-desc-version desc)))
190
191 (ert-deftest package-test-desc-from-buffer ()
192 "Parse an elisp buffer to get a `package-desc' object."
193 (with-package-test (:basedir "data/package" :file "simple-single-1.3.el")
194 (should (equal (package-buffer-info) simple-single-desc)))
195 (with-package-test (:basedir "data/package" :file "simple-depend-1.0.el")
196 (should (equal (package-buffer-info) simple-depend-desc)))
197 (with-package-test (:basedir "data/package"
198 :file "multi-file-0.2.3.tar")
199 (tar-mode)
200 (should (equal (package-tar-file-info) multi-file-desc))))
201
202 (ert-deftest package-test-install-single ()
203 "Install a single file without using an archive."
204 (with-package-test (:basedir "data/package" :file "simple-single-1.3.el")
205 (should (package-install-from-buffer))
206 (package-initialize)
207 (should (package-installed-p 'simple-single))
208 (let* ((simple-pkg-dir (file-name-as-directory
209 (expand-file-name
210 "simple-single-1.3"
211 package-test-user-dir)))
212 (autoloads-file (expand-file-name "simple-single-autoloads.el"
213 simple-pkg-dir)))
214 (should (file-directory-p simple-pkg-dir))
215 (with-temp-buffer
216 (insert-file-contents (expand-file-name "simple-single-pkg.el"
217 simple-pkg-dir))
218 (should (string= (buffer-string)
219 (concat ";;; -*- no-byte-compile: t -*-\n"
220 "(define-package \"simple-single\" \"1.3\" "
221 "\"A single-file package "
222 "with no dependencies\" 'nil "
223 ":authors '((\"J. R. Hacker\" . \"jrh@example.com\")) "
224 ":maintainer '(\"J. R. Hacker\" . \"jrh@example.com\") "
225 ":url \"http://doodles.au\""
226 ")\n"))))
227 (should (file-exists-p autoloads-file))
228 (should-not (get-file-buffer autoloads-file)))))
229
230 (ert-deftest package-test-install-dependency ()
231 "Install a package which includes a dependency."
232 (with-package-test ()
233 (package-initialize)
234 (package-refresh-contents)
235 (package-install 'simple-depend)
236 (should (package-installed-p 'simple-single))
237 (should (package-installed-p 'simple-depend))))
238
239 (ert-deftest package-test-install-two-dependencies ()
240 "Install a package which includes a dependency."
241 (with-package-test ()
242 (package-initialize)
243 (package-refresh-contents)
244 (package-install 'simple-two-depend)
245 (should (package-installed-p 'simple-single))
246 (should (package-installed-p 'simple-depend))
247 (should (package-installed-p 'simple-two-depend))))
248
249 (ert-deftest package-test-refresh-contents ()
250 "Parse an \"archive-contents\" file."
251 (with-package-test ()
252 (package-initialize)
253 (package-refresh-contents)
254 (should (eq 4 (length package-archive-contents)))))
255
256 (ert-deftest package-test-install-single-from-archive ()
257 "Install a single package from a package archive."
258 (with-package-test ()
259 (package-initialize)
260 (package-refresh-contents)
261 (package-install 'simple-single)))
262
263 (ert-deftest package-test-install-prioritized ()
264 "Install a lower version from a higher-prioritized archive."
265 (with-package-test ()
266 (let* ((newer-version (expand-file-name "data/package/newer-versions"
267 package-test-file-dir))
268 (package-archives `(("older" . ,package-test-data-dir)
269 ("newer" . ,newer-version)))
270 (package-archive-priorities '(("older" . 100))))
271
272 (package-initialize)
273 (package-refresh-contents)
274 (package-install 'simple-single)
275
276 (let ((installed (cadr (assq 'simple-single package-alist))))
277 (should (version-list-= '(1 3)
278 (package-desc-version installed)))))))
279
280 (ert-deftest package-test-install-multifile ()
281 "Check properties of the installed multi-file package."
282 (with-package-test (:basedir "data/package" :install '(multi-file))
283 (let ((autoload-file
284 (expand-file-name "multi-file-autoloads.el"
285 (expand-file-name
286 "multi-file-0.2.3"
287 package-test-user-dir)))
288 (installed-files '("dir" "multi-file.info" "multi-file-sub.elc"
289 "multi-file-autoloads.el" "multi-file.elc"))
290 (autoload-forms '("^(defvar multi-file-custom-var"
291 "^(custom-autoload 'multi-file-custom-var"
292 "^(autoload 'multi-file-mode"))
293 (pkg-dir (file-name-as-directory
294 (expand-file-name
295 "multi-file-0.2.3"
296 package-test-user-dir))))
297 (package-refresh-contents)
298 (should (package-installed-p 'multi-file))
299 (with-temp-buffer
300 (insert-file-contents-literally autoload-file)
301 (dolist (fn installed-files)
302 (should (file-exists-p (expand-file-name fn pkg-dir))))
303 (dolist (re autoload-forms)
304 (goto-char (point-min))
305 (should (re-search-forward re nil t)))))))
306
307 (ert-deftest package-test-update-listing ()
308 "Ensure installed package status is updated."
309 (with-package-test ()
310 (let ((buf (package-list-packages)))
311 (search-forward-regexp "^ +simple-single")
312 (package-menu-mark-install)
313 (package-menu-execute)
314 (run-hooks 'post-command-hook)
315 (should (package-installed-p 'simple-single))
316 (switch-to-buffer "*Packages*")
317 (goto-char (point-min))
318 (should (re-search-forward "^\\s-+simple-single\\s-+1.3\\s-+installed" nil t))
319 (goto-char (point-min))
320 (should-not (re-search-forward "^\\s-+simple-single\\s-+1.3\\s-+\\(available\\|new\\)" nil t))
321 (kill-buffer buf))))
322
323 (ert-deftest package-test-update-archives ()
324 "Test updating package archives."
325 (with-package-test ()
326 (let ((buf (package-list-packages)))
327 (package-menu-refresh)
328 (search-forward-regexp "^ +simple-single")
329 (package-menu-mark-install)
330 (package-menu-execute)
331 (should (package-installed-p 'simple-single))
332 (let ((package-test-data-dir
333 (expand-file-name "data/package/newer-versions" package-test-file-dir)))
334 (setq package-archives `(("gnu" . ,package-test-data-dir)))
335 (package-menu-refresh)
336
337 ;; New version should be available and old version should be installed
338 (goto-char (point-min))
339 (should (re-search-forward "^\\s-+simple-single\\s-+1.4\\s-+available" nil t))
340 (should (re-search-forward "^\\s-+simple-single\\s-+1.3\\s-+installed" nil t))
341
342 (goto-char (point-min))
343 (should (re-search-forward "^\\s-+new-pkg\\s-+1.0\\s-+\\(available\\|new\\)" nil t))
344
345 (package-menu-mark-upgrades)
346 (package-menu-execute)
347 (package-menu-refresh)
348 (should (package-installed-p 'simple-single '(1 4)))))))
349
350 (ert-deftest package-test-update-archives-async ()
351 "Test updating package archives asynchronously."
352 (skip-unless (executable-find "python2"))
353 ;; For some reason this test doesn't work reliably on hydra.nixos.org.
354 (skip-unless (not (getenv "NIX_STORE")))
355 (with-package-test (:basedir
356 package-test-data-dir
357 :location "http://0.0.0.0:8000/")
358 (let* ((package-menu-async t)
359 (process (start-process
360 "package-server" "package-server-buffer"
361 (executable-find "python2")
362 (expand-file-name "package-test-server.py"))))
363 (unwind-protect
364 (progn
365 (list-packages)
366 (should package--downloads-in-progress)
367 (should mode-line-process)
368 (should-not
369 (with-timeout (10 'timeout)
370 (while package--downloads-in-progress
371 (accept-process-output nil 1))
372 nil))
373 ;; If the server process died, there's some non-Emacs problem.
374 ;; Eg maybe the port was already in use.
375 (skip-unless (process-live-p process))
376 (goto-char (point-min))
377 (should
378 (search-forward-regexp "^ +simple-single" nil t)))
379 (if (process-live-p process) (kill-process process))))))
380
381 (ert-deftest package-test-describe-package ()
382 "Test displaying help for a package."
383
384 (require 'finder-inf)
385 ;; Built-in
386 (with-fake-help-buffer
387 (describe-package '5x5)
388 (goto-char (point-min))
389 (should (search-forward "5x5 is a built-in package." nil t))
390 ;; Don't assume the descriptions are in any particular order.
391 (save-excursion (should (search-forward "Status: Built-in." nil t)))
392 (save-excursion (should (search-forward "Summary: simple little puzzle game" nil t)))
393 (should (search-forward "The aim of 5x5" nil t)))
394
395 ;; Installed
396 (with-package-test ()
397 (package-initialize)
398 (package-refresh-contents)
399 (package-install 'simple-single)
400 (with-fake-help-buffer
401 (describe-package 'simple-single)
402 (goto-char (point-min))
403 (should (search-forward "simple-single is an installed package." nil t))
404 (save-excursion (should (re-search-forward "Status: Installed in ['`‘]simple-single-1.3/['’] (unsigned)." nil t)))
405 (save-excursion (should (search-forward "Version: 1.3" nil t)))
406 (save-excursion (should (search-forward "Summary: A single-file package with no dependencies" nil t)))
407 (save-excursion (should (search-forward "Homepage: http://doodles.au" nil t)))
408 (save-excursion (should (re-search-forward "Keywords: \\[?frobnicate\\]?" nil t)))
409 ;; No description, though. Because at this point we don't know
410 ;; what archive the package originated from, and we don't have
411 ;; its readme file saved.
412 )))
413
414 (ert-deftest package-test-describe-non-installed-package ()
415 "Test displaying of the readme for non-installed package."
416
417 (with-package-test ()
418 (package-initialize)
419 (package-refresh-contents)
420 (with-fake-help-buffer
421 (describe-package 'simple-single)
422 (goto-char (point-min))
423 (should (search-forward "Homepage: http://doodles.au" nil t))
424 (should (search-forward "This package provides a minor mode to frobnicate"
425 nil t)))))
426
427 (ert-deftest package-test-describe-non-installed-multi-file-package ()
428 "Test displaying of the readme for non-installed multi-file package."
429
430 (with-package-test ()
431 (package-initialize)
432 (package-refresh-contents)
433 (with-fake-help-buffer
434 (describe-package 'multi-file)
435 (goto-char (point-min))
436 (should (search-forward "Homepage: http://puddles.li" nil t))
437 (should (search-forward "This is a bare-bones readme file for the multi-file"
438 nil t)))))
439
440 (ert-deftest package-test-signed ()
441 "Test verifying package signature."
442 (skip-unless (ignore-errors
443 (let ((homedir (make-temp-file "package-test" t)))
444 (unwind-protect
445 (let ((process-environment
446 (cons (format "HOME=%s" homedir)
447 process-environment)))
448 (epg-check-configuration (epg-configuration))
449 t)
450 (delete-directory homedir t)))))
451 (let* ((keyring (expand-file-name "key.pub" package-test-data-dir))
452 (package-test-data-dir
453 (expand-file-name "data/package/signed" package-test-file-dir)))
454 (with-package-test ()
455 (package-initialize)
456 (package-import-keyring keyring)
457 (package-refresh-contents)
458 (should (package-install 'signed-good))
459 (should-error (package-install 'signed-bad))
460 ;; Check if the installed package status is updated.
461 (let ((buf (package-list-packages)))
462 (package-menu-refresh)
463 (should (re-search-forward
464 "^\\s-+signed-good\\s-+\\(\\S-+\\)\\s-+\\(\\S-+\\)\\s-"
465 nil t))
466 (should (string-equal (match-string-no-properties 1) "1.0"))
467 (should (string-equal (match-string-no-properties 2) "installed")))
468 ;; Check if the package description is updated.
469 (with-fake-help-buffer
470 (describe-package 'signed-good)
471 (goto-char (point-min))
472 (should (re-search-forward "signed-good is an? \\(\\S-+\\) package." nil t))
473 (should (string-equal (match-string-no-properties 1) "installed"))
474 (should (re-search-forward
475 "Status: Installed in ['`‘]~/signed-good-1.0/['’]."
476 nil t))))))
477
478
479 \f
480 ;;; Tests for package-x features.
481
482 (require 'package-x)
483
484 (defvar package-x-test--single-archive-entry-1-3
485 (cons 'simple-single
486 (package-make-ac-desc '(1 3) nil
487 "A single-file package with no dependencies"
488 'single
489 '((:authors ("J. R. Hacker" . "jrh@example.com"))
490 (:maintainer "J. R. Hacker" . "jrh@example.com")
491 (:url . "http://doodles.au"))))
492 "Expected contents of the archive entry from the \"simple-single\" package.")
493
494 (defvar package-x-test--single-archive-entry-1-4
495 (cons 'simple-single
496 (package-make-ac-desc '(1 4) nil
497 "A single-file package with no dependencies"
498 'single
499 '((:authors ("J. R. Hacker" . "jrh@example.com"))
500 (:maintainer "J. R. Hacker" . "jrh@example.com"))))
501 "Expected contents of the archive entry from the updated \"simple-single\" package.")
502
503 (ert-deftest package-x-test-upload-buffer ()
504 "Test creating an \"archive-contents\" file"
505 (with-package-test (:basedir "data/package"
506 :file "simple-single-1.3.el"
507 :upload-base t)
508 (package-upload-buffer)
509 (should (file-exists-p (expand-file-name "archive-contents"
510 package-archive-upload-base)))
511 (should (file-exists-p (expand-file-name "simple-single-1.3.el"
512 package-archive-upload-base)))
513 (should (file-exists-p (expand-file-name "simple-single-readme.txt"
514 package-archive-upload-base)))
515
516 (let (archive-contents)
517 (with-temp-buffer
518 (insert-file-contents
519 (expand-file-name "archive-contents"
520 package-archive-upload-base))
521 (setq archive-contents
522 (package-read-from-string
523 (buffer-substring (point-min) (point-max)))))
524 (should (equal archive-contents
525 (list 1 package-x-test--single-archive-entry-1-3))))))
526
527 (ert-deftest package-x-test-upload-new-version ()
528 "Test uploading a new version of a package"
529 (with-package-test (:basedir "data/package"
530 :file "simple-single-1.3.el"
531 :upload-base t)
532 (package-upload-buffer)
533 (with-temp-buffer
534 (insert-file-contents "newer-versions/simple-single-1.4.el")
535 (package-upload-buffer))
536
537 (let (archive-contents)
538 (with-temp-buffer
539 (insert-file-contents
540 (expand-file-name "archive-contents"
541 package-archive-upload-base))
542 (setq archive-contents
543 (package-read-from-string
544 (buffer-substring (point-min) (point-max)))))
545 (should (equal archive-contents
546 (list 1 package-x-test--single-archive-entry-1-4))))))
547
548 (ert-deftest package-test-get-deps ()
549 "Test `package--get-deps' with complex structures."
550 (let ((package-alist
551 (mapcar (lambda (p) (list (package-desc-name p) p))
552 (list simple-single-desc
553 simple-depend-desc
554 multi-file-desc
555 new-pkg-desc
556 simple-depend-desc-1
557 simple-depend-desc-2))))
558 (should
559 (equal (package--get-deps 'simple-depend)
560 '(simple-single)))
561 (should
562 (equal (package--get-deps 'simple-depend 'indirect)
563 nil))
564 (should
565 (equal (package--get-deps 'simple-depend 'direct)
566 '(simple-single)))
567 (should
568 (equal (package--get-deps 'simple-depend-2)
569 '(simple-depend-1 multi-file simple-depend simple-single)))
570 (should
571 (equal (package--get-deps 'simple-depend-2 'indirect)
572 '(simple-depend multi-file simple-single)))
573 (should
574 (equal (package--get-deps 'simple-depend-2 'direct)
575 '(simple-depend-1 multi-file)))))
576
577 (ert-deftest package-test-sort-by-dependence ()
578 "Test `package--sort-by-dependence' with complex structures."
579 (let ((package-alist
580 (mapcar (lambda (p) (list (package-desc-name p) p))
581 (list simple-single-desc
582 simple-depend-desc
583 multi-file-desc
584 new-pkg-desc
585 simple-depend-desc-1
586 simple-depend-desc-2)))
587 (delete-list
588 (list simple-single-desc
589 simple-depend-desc
590 multi-file-desc
591 new-pkg-desc
592 simple-depend-desc-1
593 simple-depend-desc-2)))
594 (should
595 (equal (package--sort-by-dependence delete-list)
596 (list simple-depend-desc-2 simple-depend-desc-1 new-pkg-desc
597 multi-file-desc simple-depend-desc simple-single-desc)))
598 (should
599 (equal (package--sort-by-dependence (reverse delete-list))
600 (list new-pkg-desc simple-depend-desc-2 simple-depend-desc-1
601 multi-file-desc simple-depend-desc simple-single-desc)))))
602
603 (provide 'package-test)
604
605 ;;; package-test.el ends here