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