;;; package-test.el --- Tests for the Emacs package system ;; Copyright (C) 2013-2015 Free Software Foundation, Inc. ;; Author: Daniel Hackney ;; Version: 1.0 ;; 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 . ;;; Commentary: ;; You may want to run this from a separate Emacs instance from your ;; main one, because a bug in the code below could mess with your ;; installed packages. ;; Run this in a clean Emacs session using: ;; ;; $ emacs -Q --batch -L . -l package-test.el -l ert -f ert-run-tests-batch-and-exit ;;; Code: (require 'package) (require 'ert) (require 'cl-lib) (defvar package-test-user-dir nil "Directory to use for installing packages during testing.") (defvar package-test-file-dir (file-name-directory (or load-file-name buffer-file-name)) "Directory of the actual \"package-test.el\" file.") (defvar simple-single-desc (package-desc-create :name 'simple-single :version '(1 3) :summary "A single-file package with no dependencies" :kind 'single :extras '((:url . "http://doodles.au"))) "Expected `package-desc' parsed from simple-single-1.3.el.") (defvar simple-depend-desc (package-desc-create :name 'simple-depend :version '(1 0) :summary "A single-file package with a dependency." :kind 'single :reqs '((simple-single (1 3)))) "Expected `package-desc' parsed from simple-depend-1.0.el.") (defvar multi-file-desc (package-desc-create :name 'multi-file :version '(0 2 3) :summary "Example of a multi-file tar package" :kind 'tar :extras '((:url . "http://puddles.li"))) "Expected `package-desc' from \"multi-file-0.2.3.tar\".") (defvar new-pkg-desc (package-desc-create :name 'new-pkg :version '(1 0) :kind 'single) "Expected `package-desc' parsed from new-pkg-1.0.el.") (defvar package-test-data-dir (expand-file-name "data/package" package-test-file-dir) "Base directory of package test files.") (defvar package-test-fake-contents-file (expand-file-name "archive-contents" package-test-data-dir) "Path to a static copy of \"archive-contents\".") (cl-defmacro with-package-test ((&optional &key file basedir install update-news upload-base) &rest body) "Set up temporary locations and variables for testing." (declare (indent 1)) `(let* ((package-test-user-dir (make-temp-file "pkg-test-user-dir-" t)) (process-environment (cons (format "HOME=%s" package-test-user-dir) process-environment)) (package-user-dir package-test-user-dir) (package-archives `(("gnu" . ,package-test-data-dir))) (old-yes-no-defn (symbol-function 'yes-or-no-p)) (default-directory package-test-file-dir) abbreviated-home-dir package--initialized package-alist ,@(if update-news '(package-update-news-on-upload t) (list (cl-gensym))) ,@(if upload-base '((package-test-archive-upload-base (make-temp-file "pkg-archive-base-" t)) (package-archive-upload-base package-test-archive-upload-base)) (list (cl-gensym)))) ;; Dummy value so `let' doesn't try to bind `nil' (unwind-protect (progn ,(if basedir `(cd ,basedir)) (setf (symbol-function 'yes-or-no-p) #'(lambda (&rest r) t)) (unless (file-directory-p package-user-dir) (mkdir package-user-dir)) ,@(when install `((package-initialize) (package-refresh-contents) (mapc 'package-install ,install))) (with-temp-buffer ,(if file `(insert-file-contents ,file)) ,@body)) (when (file-directory-p package-test-user-dir) (delete-directory package-test-user-dir t)) (when (and (boundp 'package-test-archive-upload-base) (file-directory-p package-test-archive-upload-base)) (delete-directory package-test-archive-upload-base t)) (setf (symbol-function 'yes-or-no-p) old-yes-no-defn)))) (defmacro with-fake-help-buffer (&rest body) "Execute BODY in a temp buffer which is treated as the \"*Help*\" buffer." `(with-temp-buffer (help-mode) ;; Trick `help-buffer' into using the temp buffer. (let ((help-xref-following t)) ,@body))) (defun package-test-strip-version (dir) (replace-regexp-in-string "-pkg\\.el\\'" "" (package--description-file dir))) (defun package-test-suffix-matches (base suffix-list) "Return file names matching BASE concatenated with each item in SUFFIX-LIST" (cl-mapcan '(lambda (item) (file-expand-wildcards (concat base item))) suffix-list)) (defvar tar-parse-info) (declare-function tar-header-name "tar-mode" (cl-x) t) ; defstruct (defun package-test-search-tar-file (filename) "Search the current buffer's `tar-parse-info' variable for FILENAME. Must called from within a `tar-mode' buffer." (cl-dolist (header tar-parse-info) (let ((tar-name (tar-header-name header))) (when (string= tar-name filename) (cl-return t))))) (defun package-test-desc-version-string (desc) "Return the package version as a string." (package-version-join (package-desc-version desc))) (ert-deftest package-test-desc-from-buffer () "Parse an elisp buffer to get a `package-desc' object." (with-package-test (:basedir "data/package" :file "simple-single-1.3.el") (should (equal (package-buffer-info) simple-single-desc))) (with-package-test (:basedir "data/package" :file "simple-depend-1.0.el") (should (equal (package-buffer-info) simple-depend-desc))) (with-package-test (:basedir "data/package" :file "multi-file-0.2.3.tar") (tar-mode) (should (equal (package-tar-file-info) multi-file-desc)))) (ert-deftest package-test-install-single () "Install a single file without using an archive." (with-package-test (:basedir "data/package" :file "simple-single-1.3.el") (should (package-install-from-buffer)) (package-initialize) (should (package-installed-p 'simple-single)) (let* ((simple-pkg-dir (file-name-as-directory (expand-file-name "simple-single-1.3" package-test-user-dir))) (autoloads-file (expand-file-name "simple-single-autoloads.el" simple-pkg-dir))) (should (file-directory-p simple-pkg-dir)) (with-temp-buffer (insert-file-contents (expand-file-name "simple-single-pkg.el" simple-pkg-dir)) (should (string= (buffer-string) (concat ";;; -*- no-byte-compile: t -*-\n" "(define-package \"simple-single\" \"1.3\" " "\"A single-file package " "with no dependencies\" 'nil " ":url \"http://doodles.au\"" ")\n")))) (should (file-exists-p autoloads-file)) (should-not (get-file-buffer autoloads-file))))) (ert-deftest package-test-install-dependency () "Install a package which includes a dependency." (with-package-test () (package-initialize) (package-refresh-contents) (package-install 'simple-depend) (should (package-installed-p 'simple-single)) (should (package-installed-p 'simple-depend)))) (ert-deftest package-test-install-two-dependencies () "Install a package which includes a dependency." (with-package-test () (package-initialize) (package-refresh-contents) (package-install 'simple-two-depend) (should (package-installed-p 'simple-single)) (should (package-installed-p 'simple-depend)) (should (package-installed-p 'simple-two-depend)))) (ert-deftest package-test-refresh-contents () "Parse an \"archive-contents\" file." (with-package-test () (package-initialize) (package-refresh-contents) (should (eq 4 (length package-archive-contents))))) (ert-deftest package-test-install-single-from-archive () "Install a single package from a package archive." (with-package-test () (package-initialize) (package-refresh-contents) (package-install 'simple-single))) (ert-deftest package-test-install-prioritized () "Install a lower version from a higher-prioritized archive." (with-package-test () (let* ((newer-version (expand-file-name "data/package/newer-versions" package-test-file-dir)) (package-archives `(("older" . ,package-test-data-dir) ("newer" . ,newer-version))) (package-archive-priorities '(("older" . 100)))) (package-initialize) (package-refresh-contents) (package-install 'simple-single) (let ((installed (cadr (assq 'simple-single package-alist)))) (should (version-list-= '(1 3) (package-desc-version installed))))))) (ert-deftest package-test-install-multifile () "Check properties of the installed multi-file package." (with-package-test (:basedir "data/package" :install '(multi-file)) (let ((autoload-file (expand-file-name "multi-file-autoloads.el" (expand-file-name "multi-file-0.2.3" package-test-user-dir))) (installed-files '("dir" "multi-file.info" "multi-file-sub.elc" "multi-file-autoloads.el" "multi-file.elc")) (autoload-forms '("^(defvar multi-file-custom-var" "^(custom-autoload 'multi-file-custom-var" "^(autoload 'multi-file-mode")) (pkg-dir (file-name-as-directory (expand-file-name "multi-file-0.2.3" package-test-user-dir)))) (package-refresh-contents) (should (package-installed-p 'multi-file)) (with-temp-buffer (insert-file-contents-literally autoload-file) (dolist (fn installed-files) (should (file-exists-p (expand-file-name fn pkg-dir)))) (dolist (re autoload-forms) (goto-char (point-min)) (should (re-search-forward re nil t))))))) (ert-deftest package-test-update-listing () "Ensure installed package status is updated." (with-package-test () (let ((buf (package-list-packages))) (search-forward-regexp "^ +simple-single") (package-menu-mark-install) (package-menu-execute) (should (package-installed-p 'simple-single)) (switch-to-buffer "*Packages*") (goto-char (point-min)) (should (re-search-forward "^\\s-+simple-single\\s-+1.3\\s-+installed" nil t)) (goto-char (point-min)) (should-not (re-search-forward "^\\s-+simple-single\\s-+1.3\\s-+\\(available\\|new\\)" nil t)) (kill-buffer buf)))) (ert-deftest package-test-update-archives () "Test updating package archives." (with-package-test () (let ((buf (package-list-packages))) (package-menu-refresh) (search-forward-regexp "^ +simple-single") (package-menu-mark-install) (package-menu-execute) (should (package-installed-p 'simple-single)) (let ((package-test-data-dir (expand-file-name "data/package/newer-versions" package-test-file-dir))) (setq package-archives `(("gnu" . ,package-test-data-dir))) (package-menu-refresh) ;; New version should be available and old version should be installed (goto-char (point-min)) (should (re-search-forward "^\\s-+simple-single\\s-+1.4\\s-+new" nil t)) (should (re-search-forward "^\\s-+simple-single\\s-+1.3\\s-+installed" nil t)) (goto-char (point-min)) (should (re-search-forward "^\\s-+new-pkg\\s-+1.0\\s-+\\(available\\|new\\)" nil t)) (package-menu-mark-upgrades) (package-menu-execute) (package-menu-refresh) (should (package-installed-p 'simple-single '(1 4))))))) (ert-deftest package-test-describe-package () "Test displaying help for a package." (require 'finder-inf) ;; Built-in (with-fake-help-buffer (describe-package '5x5) (goto-char (point-min)) (should (search-forward "5x5 is a built-in package." nil t)) (should (search-forward "Status: Built-in." nil t)) (should (search-forward "Summary: simple little puzzle game" nil t)) (should (search-forward "The aim of 5x5" nil t))) ;; Installed (with-package-test () (package-initialize) (package-refresh-contents) (package-install 'simple-single) (with-fake-help-buffer (describe-package 'simple-single) (goto-char (point-min)) (should (search-forward "simple-single is an installed package." nil t)) (should (search-forward "Status: Installed in `~/simple-single-1.3/' (unsigned)." nil t)) (should (search-forward "Version: 1.3" nil t)) (should (search-forward "Summary: A single-file package with no dependencies" nil t)) (should (search-forward "Homepage: http://doodles.au" nil t)) (should (re-search-forward "Keywords: \\[?frobnicate\\]?" nil t)) ;; No description, though. Because at this point we don't know ;; what archive the package originated from, and we don't have ;; its readme file saved. ))) (ert-deftest package-test-describe-non-installed-package () "Test displaying of the readme for non-installed package." (with-package-test () (package-initialize) (package-refresh-contents) (with-fake-help-buffer (describe-package 'simple-single) (goto-char (point-min)) (should (search-forward "Homepage: http://doodles.au" nil t)) (should (search-forward "This package provides a minor mode to frobnicate" nil t))))) (ert-deftest package-test-describe-non-installed-multi-file-package () "Test displaying of the readme for non-installed multi-file package." (with-package-test () (package-initialize) (package-refresh-contents) (with-fake-help-buffer (describe-package 'multi-file) (goto-char (point-min)) (should (search-forward "Homepage: http://puddles.li" nil t)) (should (search-forward "This is a bare-bones readme file for the multi-file" nil t))))) (ert-deftest package-test-signed () "Test verifying package signature." (skip-unless (ignore-errors (let ((homedir (make-temp-file "package-test" t))) (unwind-protect (let ((process-environment (cons (format "HOME=%s" homedir) process-environment))) (epg-check-configuration (epg-configuration)) t) (delete-directory homedir t))))) (let* ((keyring (expand-file-name "key.pub" package-test-data-dir)) (package-test-data-dir (expand-file-name "data/package/signed" package-test-file-dir))) (with-package-test () (package-initialize) (package-import-keyring keyring) (package-refresh-contents) (should (package-install 'signed-good)) (should-error (package-install 'signed-bad)) ;; Check if the installed package status is updated. (let ((buf (package-list-packages))) (package-menu-refresh) (should (re-search-forward "^\\s-+signed-good\\s-+1\\.0\\s-+installed" nil t))) ;; Check if the package description is updated. (with-fake-help-buffer (describe-package 'signed-good) (goto-char (point-min)) (should (search-forward "signed-good is an installed package." nil t)) (should (search-forward "Status: Installed in `~/signed-good-1.0/'." nil t)))))) ;;; Tests for package-x features. (require 'package-x) (defvar package-x-test--single-archive-entry-1-3 (cons 'simple-single (package-make-ac-desc '(1 3) nil "A single-file package with no dependencies" 'single '((:url . "http://doodles.au")))) "Expected contents of the archive entry from the \"simple-single\" package.") (defvar package-x-test--single-archive-entry-1-4 (cons 'simple-single (package-make-ac-desc '(1 4) nil "A single-file package with no dependencies" 'single nil)) "Expected contents of the archive entry from the updated \"simple-single\" package.") (ert-deftest package-x-test-upload-buffer () "Test creating an \"archive-contents\" file" (with-package-test (:basedir "data/package" :file "simple-single-1.3.el" :upload-base t) (package-upload-buffer) (should (file-exists-p (expand-file-name "archive-contents" package-archive-upload-base))) (should (file-exists-p (expand-file-name "simple-single-1.3.el" package-archive-upload-base))) (should (file-exists-p (expand-file-name "simple-single-readme.txt" package-archive-upload-base))) (let (archive-contents) (with-temp-buffer (insert-file-contents (expand-file-name "archive-contents" package-archive-upload-base)) (setq archive-contents (package-read-from-string (buffer-substring (point-min) (point-max))))) (should (equal archive-contents (list 1 package-x-test--single-archive-entry-1-3)))))) (ert-deftest package-x-test-upload-new-version () "Test uploading a new version of a package" (with-package-test (:basedir "data/package" :file "simple-single-1.3.el" :upload-base t) (package-upload-buffer) (with-temp-buffer (insert-file-contents "newer-versions/simple-single-1.4.el") (package-upload-buffer)) (let (archive-contents) (with-temp-buffer (insert-file-contents (expand-file-name "archive-contents" package-archive-upload-base)) (setq archive-contents (package-read-from-string (buffer-substring (point-min) (point-max))))) (should (equal archive-contents (list 1 package-x-test--single-archive-entry-1-4)))))) (provide 'package-test) ;;; package-test.el ends here